| 1 | table: make rebface [
|
|---|
| 2 | tip: {
|
|---|
| 3 | USAGE:
|
|---|
| 4 | table options ["Name" left .6 "Age" right .4] data ["Bob" 32 "Pete" 45 "Jack" 29]
|
|---|
| 5 |
|
|---|
| 6 | DESCRIPTION:
|
|---|
| 7 | Columns and rows of values formatted according to a header definition block.
|
|---|
| 8 |
|
|---|
| 9 | OPTIONS:
|
|---|
| 10 | 'multi allows multiple rows to be selected at once
|
|---|
| 11 | 'no-dividers hides column dividers
|
|---|
| 12 | ["Title" align width] triplets for each column
|
|---|
| 13 | }
|
|---|
| 14 | size: 50x25
|
|---|
| 15 | pane: []
|
|---|
| 16 | data: []
|
|---|
| 17 | edge: default-edge
|
|---|
| 18 | ; widget facets
|
|---|
| 19 | redraw: make function! [] [] ; place-holder for examine
|
|---|
| 20 | selected: make function! [] [] ; place-holder for examine
|
|---|
| 21 | picked: []
|
|---|
| 22 | widths: []
|
|---|
| 23 | aligns: []
|
|---|
| 24 | cols: none
|
|---|
| 25 | rows: make function! [] [pane/1/rows]
|
|---|
| 26 | ;BEG fixed by Cyphre, sponsored by Robert
|
|---|
| 27 | total-width: none
|
|---|
| 28 |
|
|---|
| 29 | add-row: func [
|
|---|
| 30 | row [block!]
|
|---|
| 31 | /position
|
|---|
| 32 | pos [integer!]
|
|---|
| 33 | ][
|
|---|
| 34 | either pos [
|
|---|
| 35 | pos: (pos - 1) * cols
|
|---|
| 36 | ][
|
|---|
| 37 | pos: 1 + length? data
|
|---|
| 38 | ]
|
|---|
| 39 | insert at data pos row
|
|---|
| 40 | redraw
|
|---|
| 41 | ]
|
|---|
| 42 |
|
|---|
| 43 | remove-row: func [
|
|---|
| 44 | row [integer! block!]
|
|---|
| 45 | /local rows removed
|
|---|
| 46 | ][
|
|---|
| 47 | if integer? row [row: to-block row]
|
|---|
| 48 | rows: sort/reverse copy row
|
|---|
| 49 | repeat n length? rows [
|
|---|
| 50 | row: max 1 min rows/:n (length? data) / cols
|
|---|
| 51 | remove/part skip data (row - 1) * cols cols
|
|---|
| 52 | ]
|
|---|
| 53 | redraw
|
|---|
| 54 | ]
|
|---|
| 55 |
|
|---|
| 56 | alter-row: func [
|
|---|
| 57 | row [integer! block!]
|
|---|
| 58 | values [block!]
|
|---|
| 59 | /local rows last-picked
|
|---|
| 60 | ][
|
|---|
| 61 | last-picked: copy picked
|
|---|
| 62 | if integer? row [row: to-block row]
|
|---|
| 63 | rows: row
|
|---|
| 64 | if (length? rows) <> (length? values) [
|
|---|
| 65 | values: reduce [values]
|
|---|
| 66 | ]
|
|---|
| 67 | if (length? rows) = (length? values) [
|
|---|
| 68 | repeat n length? rows [
|
|---|
| 69 | row: max 1 min rows/:n (length? data) / cols
|
|---|
| 70 | change skip data (row - 1) * cols copy/part values/:n cols
|
|---|
| 71 | ]
|
|---|
| 72 | ]
|
|---|
| 73 | redraw
|
|---|
| 74 | unless empty? last-picked [select-row/no-action last-picked]
|
|---|
| 75 | ]
|
|---|
| 76 |
|
|---|
| 77 | select-row: func [
|
|---|
| 78 | row [integer! none! block!]
|
|---|
| 79 | /no-action
|
|---|
| 80 | /local rows lines
|
|---|
| 81 | ][
|
|---|
| 82 | clear picked
|
|---|
| 83 | ; #45 AGT handle none! case
|
|---|
| 84 | if row [
|
|---|
| 85 | row: either integer? row [to block! row] [sort copy row]
|
|---|
| 86 | rows: pane/1/rows
|
|---|
| 87 | lines: pane/1/lines
|
|---|
| 88 | foreach r row [
|
|---|
| 89 | r: max 1 min rows r
|
|---|
| 90 | insert picked r
|
|---|
| 91 | ]
|
|---|
| 92 | if any [
|
|---|
| 93 | row/1 < (pane/1/scroll + 1)
|
|---|
| 94 | row/1 > (pane/1/scroll + pane/1/lines)
|
|---|
| 95 | ][
|
|---|
| 96 | pane/1/pane/2/data: 1 / (rows - lines) * ((min (rows - lines + 1) row/1) - 1)
|
|---|
| 97 | ]
|
|---|
| 98 | unless no-action [action/on-click self]
|
|---|
| 99 | ]
|
|---|
| 100 | ;activate the table keys control - Cyphre
|
|---|
| 101 | system/view/caret: pane/1/pane/1/text
|
|---|
| 102 | system/view/focal-face: pane/1/pane/1
|
|---|
| 103 | show self
|
|---|
| 104 | ]
|
|---|
| 105 |
|
|---|
| 106 | set-columns: func [
|
|---|
| 107 | options [block!]
|
|---|
| 108 | /no-show
|
|---|
| 109 | /no-dividers
|
|---|
| 110 | /local col-offset p last-col dividers?
|
|---|
| 111 | ] [
|
|---|
| 112 | p: self
|
|---|
| 113 |
|
|---|
| 114 | if (length? pane) > 2 [
|
|---|
| 115 | remove/part next pane 2 * cols - 1
|
|---|
| 116 | ]
|
|---|
| 117 | clear widths
|
|---|
| 118 | clear aligns
|
|---|
| 119 |
|
|---|
| 120 | cols: (length? options) / 3
|
|---|
| 121 | p/pane/1/cols: cols
|
|---|
| 122 | p/pane/1/data: p/data
|
|---|
| 123 |
|
|---|
| 124 | col-offset: total-width: 0
|
|---|
| 125 | foreach [column halign width] options [
|
|---|
| 126 | unless any [string? column word? column] [
|
|---|
| 127 | gui-error "Table expected column name to be a string or word"
|
|---|
| 128 | ]
|
|---|
| 129 | unless find [left center right] halign [
|
|---|
| 130 | gui-error "Table expected column align to be one of left, center or right"
|
|---|
| 131 | ]
|
|---|
| 132 | unless decimal? width [
|
|---|
| 133 | gui-error "Table expected column width to be a decimal"
|
|---|
| 134 | ]
|
|---|
| 135 | insert tail aligns halign
|
|---|
| 136 | insert tail widths width: to integer! p/size/x * width
|
|---|
| 137 | total-width: total-width + width
|
|---|
| 138 |
|
|---|
| 139 | insert back tail pane make subface [
|
|---|
| 140 | offset: as-pair col-offset 0
|
|---|
| 141 | size: as-pair width - sizes/cell sizes/line
|
|---|
| 142 | text: form column
|
|---|
| 143 | color: colors/theme-dark
|
|---|
| 144 | col: length? widths
|
|---|
| 145 | para: make default-para [margin: as-pair sizes/line + 2 2]
|
|---|
| 146 | ;BEG fixed by Cyphre, sponsored by Robert
|
|---|
| 147 | font: make default-font-heading [align: aligns/:col]
|
|---|
| 148 | ;END fixed by Cyphre, sponsored by Robert
|
|---|
| 149 | feel: make default-feel [
|
|---|
| 150 | over: make function! [face act pos] [
|
|---|
| 151 | face/color: either act [colors/theme-light] [colors/theme-dark]
|
|---|
| 152 | show face
|
|---|
| 153 | ]
|
|---|
| 154 | engage: make function! [face act event /local arrow] [
|
|---|
| 155 | if act = 'down [
|
|---|
| 156 | arrow: last parent-face/pane
|
|---|
| 157 | unless arrow/col = col [
|
|---|
| 158 | arrow/col: col
|
|---|
| 159 | arrow/asc: none
|
|---|
| 160 | arrow/offset/x: offset/x + size/x - (sizes/cell * 3)
|
|---|
| 161 | ]
|
|---|
| 162 | arrow/action arrow
|
|---|
| 163 | ]
|
|---|
| 164 | ]
|
|---|
| 165 | ]
|
|---|
| 166 | ]
|
|---|
| 167 | col-offset: col-offset + width
|
|---|
| 168 | ; resize dragger
|
|---|
| 169 | if cols > length? widths [
|
|---|
| 170 | insert back tail pane make subface [
|
|---|
| 171 | offset: as-pair col-offset - sizes/cell 0
|
|---|
| 172 | ;BEG fixed by Cyphre, sponsored by Robert
|
|---|
| 173 | size: as-pair 2 either no-dividers [sizes/line] [p/size/y]
|
|---|
| 174 | ;END fixed by Cyphre, sponsored by Robert
|
|---|
| 175 | color: colors/outline-dark
|
|---|
| 176 | span: unless no-dividers [all [p/span find p/span #H #H]] ; AGT resize bars if needed
|
|---|
| 177 | col-1: length? widths
|
|---|
| 178 | col-2: 1 + length? widths
|
|---|
| 179 | feel: make default-feel [
|
|---|
| 180 | over: make function! [face act pos] [
|
|---|
| 181 | color: either act [colors/state-dark] [colors/outline-dark]
|
|---|
| 182 | show face
|
|---|
| 183 | ]
|
|---|
| 184 | engage: make function! [face act event /local delta arrow] [
|
|---|
| 185 | switch/default act [
|
|---|
| 186 | down [data: event/offset/x]
|
|---|
| 187 | up [data: none feel/over face false 0x0]
|
|---|
| 188 | alt-up [data: none feel/over face false 0x0]
|
|---|
| 189 | ][
|
|---|
| 190 | if all [
|
|---|
| 191 | data
|
|---|
| 192 | event/type = 'move
|
|---|
| 193 | event/offset/x <> data
|
|---|
| 194 | ] [
|
|---|
| 195 | delta: event/offset/x - data
|
|---|
| 196 | delta: either positive? delta [
|
|---|
| 197 | min delta parent-face/pane/(col-2 * 2)/size/x - (sizes/line * 2)
|
|---|
| 198 | ][
|
|---|
| 199 | max delta negate parent-face/pane/(col-1 * 2)/size/x - (sizes/line * 2)
|
|---|
| 200 | ]
|
|---|
| 201 | unless zero? delta [
|
|---|
| 202 | arrow: last parent-face/pane
|
|---|
| 203 | if arrow/col = col-1 [arrow/offset/x: arrow/offset/x + delta]
|
|---|
| 204 | ; move dragger bar
|
|---|
| 205 | offset/x: offset/x + delta
|
|---|
| 206 | ; adjust column widths
|
|---|
| 207 | widths/:col-1: widths/:col-1 + delta
|
|---|
| 208 | widths/:col-2: widths/:col-2 - delta
|
|---|
| 209 | ; adjust heading widths and offset
|
|---|
| 210 | parent-face/pane/(col-1 * 2)/size/x: widths/:col-1 - sizes/cell
|
|---|
| 211 | parent-face/pane/(col-2 * 2)/offset/x: offset/x + sizes/cell
|
|---|
| 212 | either cols = col-2 [
|
|---|
| 213 | parent-face/pane/(col-2 * 2)/size/x: widths/:col-2
|
|---|
| 214 | ][
|
|---|
| 215 | parent-face/pane/(col-2 * 2)/size/x: widths/:col-2 - sizes/cell
|
|---|
| 216 | ]
|
|---|
| 217 | ; show changes
|
|---|
| 218 | show parent-face
|
|---|
| 219 | ]
|
|---|
| 220 | ]
|
|---|
| 221 | ]
|
|---|
| 222 | ]
|
|---|
| 223 | ]
|
|---|
| 224 | ]
|
|---|
| 225 | ]
|
|---|
| 226 | ]
|
|---|
| 227 | ; reassign options
|
|---|
| 228 | p/options: pane/1/options
|
|---|
| 229 | ; is total-width OK
|
|---|
| 230 | last-col: first back back tail pane
|
|---|
| 231 | last-col/size/x: last-col/size/x + sizes/cell + size/x - total-width
|
|---|
| 232 | if negative? last-col/size/x [
|
|---|
| 233 | gui-error "Table column widths are too large"
|
|---|
| 234 | ]
|
|---|
| 235 | widths/:cols: widths/:cols + size/x - total-width
|
|---|
| 236 | ; is last label resizeable?
|
|---|
| 237 | if all [span find span #W] [
|
|---|
| 238 | last-col/span: #W
|
|---|
| 239 | ]
|
|---|
| 240 | ; init iterator *after* we know align
|
|---|
| 241 | pane/1/init
|
|---|
| 242 | unless no-show [
|
|---|
| 243 | show self
|
|---|
| 244 | ]
|
|---|
| 245 | ]
|
|---|
| 246 | ;END fixed by Cyphre, sponsored by Robert
|
|---|
| 247 | init: make function! [/local p opts dividers?] [
|
|---|
| 248 | ; default options
|
|---|
| 249 | opts: [table]
|
|---|
| 250 | if 'multi = first options [remove options insert tail opts 'multi]
|
|---|
| 251 | dividers?: either 'no-dividers = first options [remove options false] [true]
|
|---|
| 252 | if 'multi = first options [remove options insert tail opts 'multi]
|
|---|
| 253 | ; basic options and data validation
|
|---|
| 254 | unless integer? cols: divide length? options 3 [
|
|---|
| 255 | gui-error "Table has an invalid options block"
|
|---|
| 256 | ]
|
|---|
| 257 | if all [not empty? data decimal? divide length? data cols] [
|
|---|
| 258 | gui-error "Table has an invalid data block"
|
|---|
| 259 | ]
|
|---|
| 260 | ; face iterator
|
|---|
| 261 | p: self
|
|---|
| 262 | insert tail pane make face-iterator [
|
|---|
| 263 | offset: as-pair 0 sizes/line
|
|---|
| 264 | size: p/size - as-pair 0 sizes/line
|
|---|
| 265 | span: either p/span [copy p/span] [none]
|
|---|
| 266 | data: p/data
|
|---|
| 267 | cols: p/cols
|
|---|
| 268 | widths: p/widths ; share widths
|
|---|
| 269 | aligns: p/aligns ; share aligns
|
|---|
| 270 | options: opts
|
|---|
| 271 | picked: p/picked ; share picked block
|
|---|
| 272 | action: get in p/action 'on-click ; share action func
|
|---|
| 273 | alt-action: get in p/action 'on-alt-click ; share alt-action func
|
|---|
| 274 | dbl-action: get in p/action 'on-dbl-click ; share dbl-action func
|
|---|
| 275 | ]
|
|---|
| 276 | ;BEG fixed by Cyphre, sponsored by Robert
|
|---|
| 277 | ; arrow
|
|---|
| 278 | insert tail pane make subface [
|
|---|
| 279 | offset: as-pair negate sizes/line sizes/cell
|
|---|
| 280 | size: as-pair sizes/cell * 3 sizes/cell * 3
|
|---|
| 281 | effect: [arrow black rotate 0]
|
|---|
| 282 | cols: p/cols
|
|---|
| 283 | col: none
|
|---|
| 284 | asc: true
|
|---|
| 285 | feel: make default-feel [
|
|---|
| 286 | engage: make function! [face act event] [
|
|---|
| 287 | all [act = 'down face/action face]
|
|---|
| 288 | ]
|
|---|
| 289 | ]
|
|---|
| 290 | action: make function! [face /local last-selected] [
|
|---|
| 291 | asc: either none? asc [true] [complement asc]
|
|---|
| 292 | effect/rotate: either asc [0] [180]
|
|---|
| 293 | ;BEG fixed by Cyphre, sponsored by Robert
|
|---|
| 294 | last-selected: selected
|
|---|
| 295 | ;END fixed by Cyphre, sponsored by Robert
|
|---|
| 296 | either asc [
|
|---|
| 297 | sort/skip/compare parent-face/data cols col
|
|---|
| 298 | ][
|
|---|
| 299 | sort/skip/compare/reverse parent-face/data cols col
|
|---|
| 300 | ]
|
|---|
| 301 | ;BEG fixed by Cyphre, sponsored by Robert
|
|---|
| 302 | all [
|
|---|
| 303 | last-selected
|
|---|
| 304 | select-row/no-action (((index? find parent-face/data last-selected) - 1) / cols) + 1
|
|---|
| 305 | ]
|
|---|
| 306 | ;END fixed by Cyphre, sponsored by Robert
|
|---|
| 307 | show parent-face
|
|---|
| 308 | ]
|
|---|
| 309 | ]
|
|---|
| 310 | ; column headings
|
|---|
| 311 | either dividers? [set-columns/no-show options] [set-columns/no-show/no-dividers options]
|
|---|
| 312 | ;END fixed by Cyphre, sponsored by Robert
|
|---|
| 313 | ; accessors
|
|---|
| 314 | redraw: get in pane/1 'redraw
|
|---|
| 315 | selected: get in pane/1 'selected
|
|---|
| 316 | ; feel
|
|---|
| 317 | feel: make default-feel [
|
|---|
| 318 | redraw: make function! [face act pos /local total arrow] [
|
|---|
| 319 | if act = 'show [
|
|---|
| 320 | total: 0
|
|---|
| 321 | foreach width widths [total: total + width]
|
|---|
| 322 | widths/:cols: widths/:cols + size/x - total
|
|---|
| 323 | ; is arrow on last col
|
|---|
| 324 | arrow: last pane
|
|---|
| 325 | if arrow/col = cols [arrow/offset/x: size/x + sizes/cell - sizes/line]
|
|---|
| 326 | ]
|
|---|
| 327 | ]
|
|---|
| 328 | ]
|
|---|
| 329 | ]
|
|---|
| 330 | ]
|
|---|
