REBOL[version: 117] if system/version < 1.3.2[make error! "RebGUI requires View 1.3.2 or greater"] unless value? 'viewed?[ find-window: make function![ "Find a face's window face." face[object!] ][ while[face/parent-face][face: face/parent-face] face ] viewed?: make function![ "Returns TRUE if face is displayed." face[object!] ][ found? find system/view/screen-face/pane find-window face ] ] system/locale: make system/locale[ colors:[black navy blue violet forest maroon coffee purple reblue coal oldrab red brick crimson leaf brown aqua teal magenta sienna water olive papaya mint gray rebolor green orange pewter base-color khaki cyan tan silver pink sky gold wheat yellow yello beige snow linen ivory white] words:[] language: "English" dictionary: none dict: none ] ctx-rebgui: make object![ build: 117 view*: system/view locale*: system/locale find-face: make function![pnt[pair!]f[object! block!]/local p result][ all[ object? :f f/show? within? pnt win-offset? f f/size return f ] p: either object? :f[get in f 'pane][:f] either block? :p[ result: none foreach face head reverse copy p[ if all[object? :face face/show? face: find-face pnt face][ result: face break ] ] result ][ all[object? :p find-face pnt :p] ] ] subface: make system/standard/face[ color: edge: font: para: feel: none ] all-chars: make string! 256 repeat i 256[insert tail all-chars to char! i - 1] font?: make function![ font-name[string!] ][ all[font-name = font-sans-serif return true] (size-text make subface[text: all-chars font: make view*/screen-face/font[name: font-sans-serif]]) <> (size-text make subface[text: all-chars font: make view*/screen-face/font[name: font-name]]) ] gui-error: make function![ error[string!] /continue ][ write/append/lines %rebgui.log reform[now/date now/time error] unless continue[make error! error] ] span-resize: make function![face[object!]delta[pair!]][ if face/span[ face/old-size: face/size all[find face/span #X face/offset/x: face/offset/x + delta/x] all[find face/span #Y face/offset/y: face/offset/y + delta/y] all[find face/span #W face/size/x: face/size/x + delta/x] all[find face/span #H face/size/y: face/size/y + delta/y] all[face/old-size <> face/size object? get in face 'action face/action/on-resize face] ] any[ if block? get in face 'pane[foreach f face/pane[span-resize f delta]] if object? get in face 'pane[span-resize face/pane delta] ] ] span-size: make function![face[object!]size[pair!]margin[pair!]][ if face/span[ all[ find face/span #L face/size/x: size/x - face/offset/x - margin/x all[find[drop-list edit-list]face/type face/pane/offset/x: face/size/x - sizes/line + 1] ] all[find face/span #V face/size/y: size/y - face/offset/y - margin/y] all[face/old-size <> face/size object? get in face 'action face/action/on-resize face] if find face/span #O[ face/offset/x: either any[zero? face/offset/y size/y = (face/offset/y + face/size/y)][ size/x - face/size/x ][ size/x - face/size/x - margin/x ] ] ] if block? get in face 'pane[ either face/type = 'tab-panel[ foreach f face/pane[span-size f face/size 0x0] ][ foreach f face/pane[span-size f face/size face/pane/1/offset] ] ] if object? get in face 'pane[span-size face/pane face/size face/pane/offset] ] unview-keep: make function![num[integer!]/local pane][ pane: head view*/screen-face/pane while[(length? pane) > num][remove back tail pane] show view*/screen-face ] words:[after at bold button-size data do edge effect feel field-size font indent italic label-size margin on on-alt-click on-away on-click on-dbl-click on-edit on-focus on-key on-over on-resize on-scroll on-unfocus options pad para rate return reverse space text-color text-size tight tip underline] select-face: make function![face][ face/color: colors/state-light face/font/color: colors/page show face ] deselect-face: make function![face /fill][ face/color: either fill[colors/page][none] face/font/color: colors/text show face ] colors: construct/with either exists? %ui.dat[pick load %ui.dat 3][[]]make object![ page: ivory text: coal theme-light: 195.221.127 theme-dark: 136.187.0 state-light: 255.204.127 state-dark: 255.153.0 outline-light: 204.204.204 outline-dark: 136.136.136 ] sizes: construct/with either exists? %ui.dat[pick load %ui.dat 6][[]]make object![ cell: 4 edge: 1 font: 12 font-height: none gap: 2 line: cell * 5 margin: 4 slider: cell * 4 ] behaviors: construct/with either exists? %ui.dat[pick load %ui.dat 9][[]]make object![ action-on-enter:[drop-list edit-list field password spinner] action-on-tab:[field] caret-on-focus:[area] cyclic:[group-box panel sheet tab-panel] hilight-on-focus:[edit-list field password spinner] tabbed:[area button drop-list drop-tree edit-list field grid password spinner] ] effects: construct/with either exists? %ui.dat[pick load %ui.dat 12][[]]make object![ arrows-together: false radius: 5 font: either font? "arial"["verdana"][font-sans-serif] fonts: sort reduce[font-sans-serif font-fixed font-serif "verdana"] splash-delay: 1 tooltip-delay: 0:00:01 webdings: font? "webdings" window: none ] on-fkey: make object![ f1: f2: f3: f4: f5: f6: f7: f8: f9: f10: f11: f12: none ] edit: make object![ siblings: none caret: none letter: make bitset![#"A" - #"Z" #"a" - #"z" #"'"] capital: make bitset![#"A" - #"Z"] other: negate letter edits: make function![ words[block!] /local result ln w ][ result: copy[] foreach word words[ repeat n ln: length? word[ insert tail result head remove at copy word n ] repeat n ln - 1[ insert tail result head change change at copy word n pick word n + 1 pick word n ] foreach ch "abcdefghijklmnopqrstuvwxyz"[ repeat n ln[ poke w: copy word n ch insert tail result w ] repeat n ln + 1[ insert tail result head insert at copy word n ch ] ] ] result ] lookup-word: make function![ word[string!] /local result ][ any[ not empty? result: intersect locale*/dict make hash! word: reduce[word] not empty? result: intersect locale*/dict make hash! edits word result: word ] sort result ] insert?: true keymap:[ #"^H" back-char #"^~" del-char #"^M" enter #"^A" all-text #"^C" copy-text #"^X" cut-text #"^V" paste-text #"^T" clear-tail #"^Z" undo #"^Y" redo #"^[" undo-all #"^S" spellcheck #"^/" ctrl-enter ] hilight-text: make function![start end][ view*/highlight-start: start view*/highlight-end: end ] hilight-all: make function![face][ either empty? face/text[unlight-text][ view*/highlight-start: head face/text view*/highlight-end: tail face/text ] ] unlight-text: make function![][ view*/highlight-start: view*/highlight-end: none ] hilight?: make function![][ all[ object? view*/focal-face string? view*/highlight-start string? view*/highlight-end not zero? offset? view*/highlight-end view*/highlight-start ] ] hilight-range?: make function![/local start end][ start: view*/highlight-start end: view*/highlight-end if negative? offset? start end[start: end end: view*/highlight-start] reduce[start end] ] tabbed?: make function![ face[object!] ][ all[ face/show? find behaviors/tabbed face/type not find face/options 'info face ] ] cyclic?: make function![ face[object!] ][ all[find behaviors/cyclic face/type face] ] unfocus: make function![/local face][ if face: view*/focal-face[ if all[face/type <> 'face get in face/action 'on-unfocus][ unless face/action/on-unfocus face[return false] ] all[ view*/caret in face 'caret face/caret: index? view*/caret ] all[ face/type = 'button face/feel/over face false none ] ] view*/focal-face: view*/caret: none unlight-text all[face show face] true ] copy-selected-text: make function![/local start end][ if hilight?[ set[start end]hilight-range? write clipboard:// copy/part start end true ] ] delete-selected-text: make function![/local start end][ if hilight?[ set[start end]hilight-range? remove/part start end view*/caret: start view*/focal-face/line-list: none unlight-text true ] ] cut-text: make function![][ undo-add face copy-selected-text face delete-selected-text ] paste-text: make function![][ undo-add face delete-selected-text face/line-list: none view*/caret: insert view*/caret read clipboard:// ] undo-max: 20 undo-add: make function![face][ if in face 'undo[ insert clear face/undo at copy face/text index? view*/caret if all[undo-max undo-max < length? head face/undo][remove head face/undo] face/undo: tail face/undo ] ] undo-get: make function![face][ face/text: head view*/caret: first face/undo face/line-list: none remove face/undo ] word-limits: make bitset! { ^-^M/[](){}"} word-limits: reduce[word-limits complement word-limits] current-word: make function![str /local s ns][ unless string? str[gui-error/continue reform["Current word trap" type? str str]exit] set[s]word-limits s: any[all[s: find/reverse str s next s]head str] set[ns]word-limits ns: any[find str ns tail str] hilight-text s ns show view*/focal-face ] next-word: make function![str /local s ns][ set[s ns]word-limits any[all[s: find str s find s ns]tail str] ] back-word: make function![str /local s ns][ set[s ns]word-limits any[all[ns: find/reverse str ns ns: find/reverse ns s next ns]head str] ] end-of-line: make function![str][ any[find str "^/" tail str] ] beg-of-line: make function![str /local nstr][ either nstr: find/reverse str "^/"[next nstr][head str] ] next-field: make function![face /wrap][ unless face/parent-face[return none] unless find[object! block!]type?/word get in face/parent-face 'pane[ return none ] siblings: compose[(face/parent-face/pane)] unless wrap[siblings: find/tail siblings face] foreach sibling siblings[ if target: any[ tabbed? sibling into-widget/forwards sibling ][ return target ] ] all[ not cyclic? face/parent-face target: next-field face/parent-face return target ] all[ target: next-field/wrap face return target ] ] back-field: make function![face /wrap][ unless face/parent-face[return none] unless find[object! block!]type?/word get in face/parent-face 'pane[ return none ] siblings: reverse compose[(face/parent-face/pane)] unless wrap[siblings: find/tail siblings face] foreach sibling siblings[ if target: any[ tabbed? sibling into-widget/backwards sibling ][ return target ] ] all[ not cyclic? face/parent-face target: back-field face/parent-face return target ] all[ target: back-field/wrap face return target ] ] into-widget: make function![ {Recursivly returns the first tabbable face in parent's face pane tree.} face[object!] /forwards /backwards /local target children ][ unless find[object! block!]type?/word get in face 'pane[ return none ] unless face/show?[ return none ] children: compose[(face/pane)] catch[ foreach child either backwards[reverse children][children][ if target: any[ tabbed? child either backwards[ into-widget/backwards child ][ into-widget child ] ][ throw target ] ] ] ] keys-to-insert: make bitset! #{ 01000000FFFFFFFFFFFFFFFFFFFFFF7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF } insert-char: make function![face char][ delete-selected-text unless any[insert? tail? view*/caret "^/" = first view*/caret][remove view*/caret] insert view*/caret char view*/caret: next view*/caret ] move: make function![event ctrl plain][ either event/shift[ any[view*/highlight-start view*/highlight-start: view*/caret] ][unlight-text] view*/caret: either event/control ctrl plain if event/shift[ either view*/caret = view*/highlight-start[unlight-text][view*/highlight-end: view*/caret] ] ] move-y: make function![face delta /local pos tmp tmp2][ tmp: offset-to-caret face 0x2 + delta + pos: caret-to-offset face view*/caret tmp2: caret-to-offset face tmp either tmp2/y <> pos/y[tmp][view*/caret] ] edit-text: make function![ face event /local key edge para caret scroll page-up page-down face-size ][ face-size: face/size - either face/edge[2 * face/edge/size][0] key: event/key if char? key[ either find keys-to-insert key[ undo-add face insert-char face key ][key: select keymap key] ] if word? key[ page-up:[move-y face face-size - sizes/font-height - sizes/font-height * 0x-1] page-down:[move-y face face-size - sizes/font-height * 0x1] do select[ left[move event[back-word view*/caret][back view*/caret]] right[move event[next-word view*/caret][next view*/caret]] up[move event page-up[move-y face sizes/font-height * 0x-1]] down[move event page-down[move-y face sizes/font-height * 0x1]] page-up[move event[head view*/caret]page-up] page-down[move event[tail view*/caret]page-down] home[move event[head view*/caret][beg-of-line view*/caret]] end[move event[tail view*/caret][end-of-line view*/caret]] insert[either event/shift[paste-text][insert?: complement insert?]] back-char[ undo-add face any[ delete-selected-text head? view*/caret either event/control[ tmp: view*/caret remove/part view*/caret: back-word tmp tmp ][remove view*/caret: back view*/caret] ] ] del-char[ undo-add face either event/shift[unless face/type = 'password[cut-text]][ any[ delete-selected-text tail? view*/caret either event/control[ remove/part view*/caret back next-word view*/caret if tail? next view*/caret[remove back tail view*/caret] ][remove view*/caret] ] ] ] enter[ either find behaviors/action-on-enter face/type[ all[face/type = 'spinner face/action/on-unfocus face] set-focus face face/action/on-click face ][ undo-add face insert-char face "^/" ] ] ctrl-enter[undo-add face insert-char face tab] all-text[hilight-all face] copy-text[unless face/type = 'password[copy-selected-text face unlight-text]] cut-text[unless face/type = 'password[cut-text]] paste-text[paste-text] clear-tail[ undo-add face remove/part view*/caret end-of-line view*/caret ] undo[ if all[in face 'undo not head? face/undo][ insert face/undo at copy face/text index? view*/caret face/undo: back face/undo undo-get face ] ] redo[ if all[in face 'undo not tail? face/undo][ face/undo: insert face/undo at copy face/text index? view*/caret undo-get face ] ] undo-all[ if in face 'esc[ clear face/text all[in face 'undo clear face/undo] all[string? face/esc insert face/text face/esc] view*/caret: tail face/text ] ] spellcheck[ request-spellcheck face ] ]key ] edge: face/edge para: face/para scroll: face/para/scroll if error? try[ caret: caret-to-offset face view*/caret if caret/y < (edge/size/y + para/origin/y + para/indent/y)[ scroll/y: round/to scroll/y - caret/y sizes/font-height ] if caret/y > (face-size/y - sizes/font-height)[ scroll/y: round/to (scroll/y + ((face-size/y - sizes/font-height) - caret/y)) sizes/font-height ] unless para/wrap?[ if caret/x < (edge/size/x + para/origin/x + para/indent/x)[ scroll/x: scroll/x - caret/x + (edge/size/x + para/origin/x + para/indent/x) ] if caret/x > (face-size/x - para/margin/x)[ scroll/x: scroll/x + (face-size/x - para/margin/x - caret/x) ] ] if scroll <> face/para/scroll[ face/para/scroll: scroll if face/type = 'area[face/key-scroll?: true] ] ][gui-error/continue reform["Caret trap" face/type face/para]] show face ] feel: make object![ redraw: detect: over: none engage: func[face act event /local txt][ do select[ key[ unless all[get in face/action 'on-key not face/action/on-key face event][ txt: copy face/text edit-text face event all[ get in face/action 'on-edit strict-not-equal? txt face/text face/action/on-edit face ] ] ] down[ either event/double-click[ all[view*/caret not empty? view*/caret current-word view*/caret] ][ either face = view*/focal-face[ unlight-text view*/caret: offset-to-caret face event/offset show face ][ caret: offset-to-caret face event/offset set-focus face ] ] ] over[ unless view*/caret = offset-to-caret face event/offset[ unless view*/highlight-start[view*/highlight-start: view*/caret] view*/highlight-end: view*/caret: offset-to-caret face event/offset show face ] ] alt-up[face/action/on-alt-click face] scroll-line[face/action/on-scroll face event/offset] scroll-page[face/action/on-scroll/page face event/offset] ]act ] ] ] widgets: make object![ rebind: make function![][ default-edge/color: colors/text default-edge/size: as-pair sizes/edge sizes/edge theme-edge/color: colors/theme-dark theme-edge/size: default-edge/size outline-edge/color: colors/outline-light outline-edge/size: default-edge/size default-font/size: sizes/font default-font/name: effects/font default-font-bold: make default-font[style: 'bold] default-font-heading: make default-font[style: 'bold color: colors/page align: 'center shadow: 1x1] default-font-large: make default-font[size: sizes/font * 2] default-font-right: make default-font[align: 'right] default-font-top: make default-font[valign: 'top] default-para-indented/origin/x: sizes/line default-text/text: copy "" sizes/font-height: second size-text default-text foreach w next find first self 'choose[ widgets/:w/rebind ] ] default-edge: make object![ color: colors/text image: none effect: none size: as-pair sizes/edge sizes/edge ] theme-edge: make default-edge[ color: colors/theme-dark ] outline-edge: make default-edge[ color: colors/outline-light ] default-font: make object![ name: effects/font style: none size: sizes/font color: colors/text offset: 0x0 space: 0x0 align: 'left valign: 'middle shadow: none ] default-font-bold: make default-font[ style: 'bold ] default-font-heading: make default-font[ style: 'bold color: colors/page align: 'center shadow: 1x1 ] default-font-large: make default-font[ size: sizes/font * 2 ] default-font-right: make default-font[ align: 'right ] default-font-top: make default-font[ valign: 'top ] default-para: make object![ origin: 2x2 margin: 2x2 indent: 0x0 tabs: 0 wrap?: false scroll: 0x0 ] default-para-wrap: make default-para[ origin: 2x0 indent: 0x0 wrap?: true ] default-para-indented: make default-para[ origin: as-pair sizes/line 2 ] default-feel: make object![ redraw: detect: over: engage: none ] default-action: make object![ on-alt-click: on-away: on-click: on-dbl-click: on-edit: on-focus: on-key: on-over: on-resize: on-scroll: on-unfocus: none ] set 'rebface make subface[ feel: default-feel action: default-action options:[] rebind: init: tip: none ] default-text: make rebface[ size: 10000x10000 text: "" font: default-font para: default-para ] sizes/font-height: second size-text default-text date-spec:[ tight symbol 9x6 data 'rewind[face/parent-face/data/year: face/parent-face/data/year - 1 show face/parent-face] symbol 9x6 data 'left[face/parent-face/data/month: face/parent-face/data/month - 1 show face/parent-face] symbol 34x6[set-data face/parent-face first face/parent-face/options] symbol 9x6 data 'right[face/parent-face/data/month: face/parent-face/data/month + 1 show face/parent-face] symbol 9x6 data 'forward[face/parent-face/data/year: face/parent-face/data/year + 1 show face/parent-face] return ] foreach day locale*/days[ insert tail date-spec compose[label 10 (copy/part day 3) font[align: 'center]] ] insert tail date-spec[return bar] loop 6[ insert tail date-spec 'return loop 7[ insert tail date-spec[ box 10x6 font[align: 'center valign: 'middle]edge[size: 0x0 color: colors/state-dark]feel[ over: make function![face act pos][ either all[act face/text][ face/parent-face/data/day: to integer! face/text set-title face/parent-face form face/parent-face/data select-face face ][deselect-face face] ] engage: make function![face act event][ all[ act = 'down face/text face/parent-face/data/day: to integer! face/text poke face/parent-face/options 1 face/parent-face/data face/parent-face/action/on-click face/parent-face ] all[ find[up alt-up]act face/feel/over face false none ] ] ] ] ] ] face-iterator: make rebface[ type: 'face-iterator pane:[] data:[] timeout: now/time/precise feel: make default-feel[ redraw: make function![face act pos][ if all[act = 'show face/size <> face/old-size][face/resize] ] engage: make function![face act event /local i][ if act = 'time[ if (now/time/precise - face/timeout) > 0:00:00.2[ face/action face face/rate: none show face ] ] if act = 'key[ do select[ #"^A"[ if find face/options 'multi[ clear face/picked repeat i face/rows[insert tail face/picked i] face/action face ] ] down[ i: 1 + last face/picked if i <= face/rows[ i: min face/rows i insert clear face/picked i if find[table text-list]face/parent-face/type[ face/timeout: now/time/precise face/rate: 60 if i > (face/scroll + face/lines)[ face/pane/2/data: 1 / (face/rows - face/lines) * ((min (face/rows - face/lines + 1) (i - face/lines + 1)) - 1) face/scroll: face/scroll + 1 ] ] ] ] up[ i: -1 + last face/picked if i > 0[ i: max 1 i insert clear face/picked i if find[table text-list]face/parent-face/type[ face/timeout: now/time/precise face/rate: 60 if i = face/scroll[ face/pane/2/data: 1 / (face/rows - face/lines) * ((min (face/rows - face/lines + 1) i) - 1) face/scroll: face/scroll - 1 ] ] ] ] #"^M"[ all[find[table text-list]face/parent-face/type face/action face] ] ]event/key show face ] ] ] lines: none rows: none cols: 1 widths: none aligns: none picked:[] scroll: 0 resize: make function![][ lines: to integer! size/y / sizes/line pane/2/show?: either rows > lines[ scroll: max 0 min scroll rows - lines true ][ scroll: 0 false ] ] redraw: make function![][ clear picked rows: either empty? data[0][(length? data) / cols] resize pane/2/ratio: either zero? rows[1][lines / rows] show self ] selected: make function![/local blk][ if empty? picked[return none] either any[find options 'multi parent-face/type = 'table][ all[rows = length? picked return data] blk: copy[] either cols = 1[ foreach row picked[insert tail blk pick data row] ][ foreach row picked[ repeat col cols[ insert tail blk pick data -1 + row * cols + col ] ] ] blk ][ blk: pick data first picked ] ] init: make function![/local p][ attempt[remove find span #X] attempt[remove find span #Y] lines: to integer! size/y / sizes/line rows: (length? data) / cols clear pane p: self insert pane make subface[ size: p/size span: p/span pane: make function![face index /local col-offset clr][ either integer? index[ if index <= min lines rows[ line/offset/y: index - 1 * sizes/line line/size/x: size/x index: index + scroll either p/parent-face/type = 'table[ col-offset: 0 repeat i p/cols[ line/pane/:i/offset/x: col-offset line/pane/:i/size/x: p/widths/:i - sizes/cell all[ p/pane/2/show? i = p/cols line/pane/:i/size/x: line/pane/:i/size/x + (p/size/x - p/pane/2/size/x - (line/pane/:i/offset/x + line/pane/:i/size/x)) ] line/pane/:i/text: replace/all form pick p/data index - 1 * cols + i "^/" "¶" line/pane/:i/font/color: either find p/options 'no-action[ colors/text ][ either find picked index[colors/page][colors/text] ] col-offset: col-offset + pick widths i ] ][ line/text: replace/all form pick face/parent-face/data index "^/" "¶" line/font/color: either find p/options 'no-action[ colors/text ][ either find picked index[colors/page][colors/text] ] ] line/color: either find p/options 'no-action[none][if find picked index[colors/theme-light]] if all[ line/color = colors/theme-light face/parent-face/type = 'choose ][face/parent-face/auto: pick face/parent-face/data index] line/data: index line ] ][to integer! index/y / sizes/line + 1] ] text: "" line: make rebface[ size: as-pair 0 sizes/line font: make default-font[] feel: make default-feel[ over: make function![face into pos][ if find face/parent-face/parent-face/options 'over[ either into[insert clear picked data][clear picked] show face ] ] engage: make function![face act event /local p a b][ p: face/parent-face either event/double-click[ all[act = 'down p/parent-face/dbl-action p/parent-face] ][ if find[up alt-up]act[ view*/focal-face: p view*/caret: tail p/text either find p/parent-face/options 'multi[ unless any[event/control event/shift][clear picked] either all[event/control find picked data][ remove find picked data ][ unless find picked data[insert tail picked data] ] if all[event/shift 1 < length? picked][ clear next picked repeat i (max data first picked) - (a: min data first picked) + 1[ b: i + a - 1 all[b <> first picked insert tail picked b] ] ] ][insert clear picked data] show p unless find p/parent-face/options 'no-action[ either act = 'up[ p/parent-face/action p/parent-face ][ p/parent-face/alt-action p/parent-face ] ] ] ] ] ] ] ] if find options 'table[ pane/1/line/pane: copy[] repeat i cols[ insert tail pane/1/line/pane make subface[ size: as-pair 0 sizes/line font: make default-font[align: aligns/:i] ] ] ] insert tail pane make slider[ tip: none offset: as-pair p/size/x - sizes/slider 0 size: as-pair sizes/slider p/size/y span: case[ none? p/span[none] all[find p/span #H find p/span #W][#XH] find p/span #H[#H] find p/span #W[#X] ] options:[arrows] show?: either rows > lines[true][false] action: make default-action[ on-click: make function![face][ scroll: to integer! rows - lines * data show face/parent-face ] ] ratio: either rows > 0[lines / rows][1] ] pane/2/init ] ] choose: make function![ parent[object!]"Widget to appear in relation to" width[integer!]"Width in pixels" xy[pair!]"Offset of choice box" items[block!]"Block of items to display" /local popup result ][ result: none popup: make face-iterator[ type: 'choose offset: xy size: as-pair width sizes/line * min length? items to-integer parent/parent-face/size/y - xy/y / sizes/line color: colors/page data: items edge: outline-edge feel: system/words/face/feel options:[over] action: make function![face][result: pick data first picked hide-popup] alt-action: none dbl-action: none auto: none ] popup/init show-popup/window/away popup parent/parent-face do-events either parent/type = 'edit-list[popup/auto][result] ] anim: make rebface[ tip:{USAGE: anim data[%images/go-previous.png %images/go-next.png] anim data[img1 img2 img3]rate 2 DESCRIPTION: Cycles a set of images at a specified rate.} size: -1x-1 effect: 'fit feel: make default-feel[ engage: make function![face act event][ all[ act = 'time face/image: first face/data face/data: either tail? next face/data[head face/data][next face/data] show face ] ] ] rate: 1 init: make function![][ repeat i length? data: reduce data[ all[file? pick data i poke data i load pick data i] ] image: first data data: next data all[negative? size/x size/x: image/size/x] all[negative? size/y size/y: image/size/y] ] ] pill: make rebface[ tip:{USAGE: pill red DESCRIPTION: A rectangular area with rounded corners.} size: 10x10 effect:[draw[pen none line-width sizes/edge fill-pen linear 0x0 0 0 90 1 1 none none none box 0x0 0x0 effects/radius]] pen: none fill: make function![][effect/draw/fill-pen] feel: make default-feel[ redraw: make function![face act pos][ if act = 'show[ all[ face/color poke face/effect/draw 13 face/color + 0.0.0.64 poke face/effect/draw 14 face/color + 0.0.0.32 poke face/effect/draw 15 face/color face/color: none ] ] ] ] action: make default-action[ on-resize: make function![face][ poke face/effect/draw 8 to integer! face/size/y * 0.25 poke face/effect/draw 9 to integer! face/size/y * 0.75 poke face/effect/draw 18 face/size - 1x1 poke face/effect/draw 19 either all[face/size/x > sizes/line face/size/y > sizes/line][effects/radius * 2][effects/radius] ] ] init: make function![][ action/on-resize self ] ] area: make rebface[ tip:{USAGE: area area "Text" -1 area "Text" 50x-1 DESCRIPTION: Editable text area with wrapping and scroller. OPTIONS: 'info specifies read-only} size: 50x25 text: "" color: colors/page edge: theme-edge font: default-font-top para: make default-para-wrap[margin: as-pair sizes/slider + 2 2] feel: make edit/feel[ redraw: func[face act pos /local height total visible][ if act = 'show[ if face/size <> face/old-size[ face/pane/offset/x: max 0 face/size/x - face/pane/size/x face/pane/size/y: face/size/y ] if any[ face/text-y <> height: second size-text face face/size <> face/old-size ][ face/text-y: height total: face/text-y visible: face/size/y - (edge/size/y * 2) - para/origin/y - para/indent/y face/pane/ratio: either total > 0[min 1 (visible / total)][1] face/pane/step: either visible < total[min 1 (sizes/font-height / (total - visible))][0] ] if all[face/pane/ratio < 1 face/key-scroll?][ do bind[ total: text-y visible: size/y - (edge/size/y * 2) - para/origin/y - para/indent/y pane/data: - para/scroll/y / (total - visible) ]face face/key-scroll?: false ] ] ] ] esc: none caret: none undo: copy[] text-y: none key-scroll?: false action: make default-action[ on-scroll: make function![face scroll /page /local total visible][ total: second size-text face visible: face/size/y - (face/edge/size/y * 2) - face/para/origin/y - face/para/indent/y face/para/scroll/y: either page[ min max face/para/scroll/y - (visible * sign? scroll/y) (visible - total) 0 ][ min max face/para/scroll/y - (scroll/y * sizes/font-height) (visible - total) 0 ] all[face/pane/data: - face/para/scroll/y / (total - visible)] show face ] ] rebind: make function![][ color: colors/page para/margin/x: sizes/slider + 2 ] init: make function![/local p][ if find options 'info[ feel: make feel[engage: none] all[color = colors/page color: colors/outline-light] ] para: make para[] p: self text-y: second size-text self all[negative? size/x size/x: 10000 size/x: 4 + first size-text self] all[negative? size/y size/y: 10000 size/y: 8 + text-y] pane: make slider[ tip: none offset: as-pair p/size/x - sizes/slider 0 size: as-pair sizes/slider p/size/y span: case[ none? p/span[none] all[find p/span #H find p/span #W][#XH] find p/span #W[#X] find p/span #H[#H] true[none] ] options:[arrows] action: make default-action[ on-click: make function![face /local visible][ unless parent-face/key-scroll?[ visible: (parent-face/size/y - (parent-face/edge/size/y * 2) - parent-face/para/origin/y - parent-face/para/indent/y) parent-face/para/scroll/y: negate parent-face/text-y - visible * data if all[ view*/caret parent-face = view*/focal-face ][ ] show parent-face ] parent-face/key-scroll?: false ] ] ratio: p/size/y - 4 / text-y ] pane/init ] ] arrow: make rebface[ tip:{USAGE: arrow arrow 10 arrow data 'up arrow data 'down arrow data 'left arrow data 'right DESCRIPTION: An arrow (default down) on a square button face with height set to width.} size: 5x-1 data: 'down feel: make default-feel[ redraw: make function![face act pos][ all[act = 'show face/color: either face/data[colors/state-light][colors/theme-light]] ] engage: make function![face act event][ do select[ time[all[face/data face/action/on-click face]] down[face/data: on] up[face/data: off face/action/on-click face] over[face/data: on] away[face/data: off] ]act show face ] ] effect: reduce['arrow colors/page 'rotate 0] rebind: make function![][effect/arrow: colors/page] init: make function![][ all[negative? size/y size/y: size/x] effect/rotate: select[up 0 right 90 down 180 left 270]data data: off ] ] bar: make rebface[ tip:{USAGE: bar 100 DESCRIPTION: A thin 3D bar used to separate widgets. Defaults to maximum display width.} size: -1x1 color: colors/outline-light edge: make outline-edge[effect: 'bevel] rebind: make function![][color: edge/color: colors/outline-light] ] box: make rebface[ tip:{USAGE: box red DESCRIPTION: The most basic of widgets, a rectangular area.} size: 25x25 ] button: make pill[ tip:{USAGE: button "Hello" button -1 "Go!" button "Click me!"[print "click"] DESCRIPTION: Performs action when clicked. OPTIONS: 'info specifies read-only} size: 15x5 text: "" color: colors/theme-dark font: default-font-heading feel: make feel[ over: make function![face act pos][ set-color face either all[act not find face/options 'info][colors/theme-light][colors/theme-dark] ] engage: make function![face act event /local f][ unless find face/options 'info[ do select[ down[set-color face colors/state-light] alt-down[set-color face colors/state-light] up[set-color face colors/theme-dark face/action/on-click face] alt-up[set-color face colors/theme-dark face/action/on-alt-click face] away[set-color face colors/theme-dark] ]act ] ] ] rebind: make function![][ color: colors/theme-dark ] init: make function![][ all[negative? size/x size/x: 10000 size/x: 8 + first size-text self] all[find options 'info color = colors/theme-dark color: colors/outline-light] action/on-resize self ] ] calendar: make rebface[ tip:{USAGE: calendar calendar data 1-Jan-2000 DESCRIPTION: Used to select a date, with face/data set to current selection. Default selection is now/date.} size: 70x48 feel: make default-feel[ redraw: make function![face act pos /local date month][ if act = 'show[ date: face/data month: date/month date/day: 1 date: date - date/weekday + 1 foreach sub-face skip face/pane 13[ sub-face/edge/size: 0x0 sub-face/text: either date/month = month[ all[date = first face/options sub-face/edge/size: 2x2] form date/day ][none] date: date + 1 ] face/pane/3/text: reform[pick locale*/months face/data/month face/data/year] ] ] ] init: make function![][ insert options any[data now/date] data: layout/only date-spec pane: data/pane size: data/size data: first options ] ] chat: make rebface[ tip:{USAGE: chat 120 data["Bob" blue "My comment." yello 14-Apr-2007/10:58] DESCRIPTION: Three column chat display as found in IM apps such as AltME. Messages are appended, with those exceeding 'limit not shown. OPTIONS: [limit n]where n specifies number of messages to show (default 100) [id n]where n specifies id column width (default 10) [user n]where n specifies user column width (default 15) [date n]where n specifies date column width (default 25)} size: 200x100 pane:[] data:[] edge: outline-edge action: make default-action[ on-resize: make function![face][ poke face/pane/2/para/tabs 3 face/pane/1/size/x - (sizes/cell * any[select face/options 'date 25]) face/redraw/no-show ] ] height: 0 rows: 0 limit: none append-message: make function![ user[string!] user-color[tuple! word! none!] msg[string!] msg-color[tuple! word! none!] date[date!] /no-show row /local p y t1 t2 t3 ][ t1: pick pane/2/para/tabs 1 t2: pick pane/2/para/tabs 2 t3: pick pane/2/para/tabs 3 y: max sizes/line 4 + second size-text make subface[ size: as-pair t3 - t2 10000 text: msg font: default-font para: default-para-wrap ] p: self insert tail pane/1/pane reduce[ make subface[ offset: as-pair 0 height size: as-pair t1 y text: form any[row rows: rows + 1] color: colors/theme-dark edge: make outline-edge[size: 0x1] font: default-font-heading ] make subface[ offset: as-pair t1 height size: as-pair t2 - t1 y text: user edge: make outline-edge[size: 0x1] font: make default-font-top[color: either word? user-color[get user-color][user-color]style: 'bold] ] make subface[ offset: as-pair t2 height size: as-pair t3 - t2 y span: all[p/span find p/span #W #W] text: form msg color: either word? msg-color[get msg-color][msg-color] edge: make outline-edge[size: 0x1] font: default-font para: default-para-wrap ] make subface[ offset: as-pair t3 height size: as-pair p/size/x - t3 - sizes/slider y span: all[p/span find p/span #W #X] text: form either now/date = date/date[date/time][date/date] edge: make outline-edge[size: 0x1] font: default-font-top ] ] height: height + y - 1 if ((length? pane/1/pane) / 4) > limit[ y: pane/1/pane/1/size/y - 1 remove/part pane/1/pane 4 foreach[i u m d]pane/1/pane[ i/offset/y: u/offset/y: m/offset/y: d/offset/y: i/offset/y - y ] height: height - y ] unless no-show[ insert tail data reduce[user user-color msg msg-color date] pane/1/size/y: height pane/3/ratio: pane/3/size/y / height show p ] show pane/1 ] set-user-color: make function![id[integer!]color[tuple! word! none!]/local idx][ if any[zero? id id > rows][exit] poke data id * 5 - 3 color if limit > (rows - id)[ idx: either rows > limit[(id + limit - rows) * 4 - 2][id * 4 - 2] pane/1/pane/:idx/font/color: either word? color[get color][color] show pane/1/pane/:idx ] ] set-message-text: make function![id[integer!]string[string!]/local idx][ if any[zero? id id > rows][exit] poke data id * 5 - 2 string if limit > (rows - id)[ idx: either rows > limit[(id + limit - rows) * 4 - 1][id * 4 - 1] insert clear pane/1/pane/:idx/text string redraw ] ] set-message-color: make function![id[integer!]color[tuple! word! none!]/local idx][ if any[zero? id id > rows][exit] poke data id * 5 - 1 color if limit > (rows - id)[ idx: either rows > limit[(id + limit - rows) * 4 - 1][id * 4 - 1] pane/1/pane/:idx/color: either word? color[get color][color] show pane/1/pane/:idx ] ] redraw: make function![/no-show /local row][ clear pane/1/pane height: 0 rows: (length? data) / 5 row: max 0 rows - limit: any[select options 'limit 100] foreach[user user-color msg msg-color date]skip data row * 5[ append-message/no-show user user-color msg msg-color date row: row + 1 ] pane/1/size/y: height pane/3/ratio: either zero? height[1][pane/3/size/y / height] unless no-show[show self] ] init: make function![/local p][ p: self limit: any[select options 'limit 100] insert pane make subface[ offset: as-pair 0 sizes/line size: p/size - as-pair sizes/slider sizes/line span: all[p/span find p/span #W #W] pane:[] ] insert tail pane make subface[ size: as-pair p/size/x sizes/line text: {ID^-User^-Message^-Sent} span: all[p/span find p/span #W #W] color: colors/theme-dark font: make default-font-heading[align: 'left] para: make default-para[tabs:[0 0 0]] ] poke pane/2/para/tabs 1 sizes/cell * any[select options 'id 10] poke pane/2/para/tabs 2 sizes/cell * (any[select options 'user 15]) + pick pane/2/para/tabs 1 poke pane/2/para/tabs 3 size/x - sizes/slider - (sizes/cell * any[select options 'date 25]) insert tail pane make slider[ tip: none offset: as-pair p/size/x - sizes/slider sizes/line size: as-pair sizes/slider p/size/y - sizes/line span: case[ none? p/span[none] all[find p/span #H find p/span #W][#XH] find p/span #H[#H] find p/span #W[#X] ] options:[arrows] action: make default-action[ on-click: make function![face /local p][ p: face/parent-face p/pane/1/offset/y: sizes/line + negate (height - face/size/y) * face/data show p ] ] ] pane/3/init action/on-resize self ] ] check: make rebface[ tip:{USAGE: check "Option" check "Option" data true check "Option" data false DESCRIPTION: Tristate check-box with a green tick for Yes, a red cross for No, and empty being Unknown. Left and right mouse clicks alternate between Yes/No and Unknown respectively. OPTIONS: 'info specifies read-only 'bistate disables right-click state} size: -1x5 text: "" effect:[draw[pen colors/outline-light fill-pen colors/page box 0x0 0x0]] font: default-font para: default-para-indented feel: make default-feel[ p1: as-pair 2 sizes/cell + 2 p2: -4x-4 + p1 + as-pair sizes/cell * 3 sizes/cell * 3 redraw: make function![face act pos][ all[ act = 'show clear skip face/effect/draw 7 unless none? face/data[ insert tail face/effect/draw reduce either face/data[ ['pen colors/state-dark 'line-width sizes/cell / 3 'line as-pair 2 sizes/cell * 3 as-pair sizes/cell * 1.5 p2/y as-pair p2/x p1/y] ][ ['pen colors/state-dark 'line-width sizes/cell / 3 'line p1 p2 'line as-pair p2/x p1/y as-pair p1/x p2/y] ] ] ] ] over: make function![face act pos][ face/effect/draw/pen: either act[colors/state-dark][colors/outline-light] show face ] engage: make function![face act event][ do select[ down[face/data: either none? face/data[true][none]face/action/on-click face] alt-down[ unless find face/options 'bistate[ face/data: either none? face/data[false][none]face/action/on-click face ] ] away[face/feel/over face false 0x0] ]act ] ] rebind: make function![][ feel/p1: as-pair 2 sizes/cell + 2 feel/p2: -4x-4 + feel/p1 + as-pair sizes/cell * 3 sizes/cell * 3 ] init: make function![][ all[negative? size/x size/x: 10000 size/x: 4 + para/origin/x + first size-text self] effect/draw/6/y: sizes/cell effect/draw/7: as-pair sizes/cell * 3 sizes/cell * 4 if find options 'info[ feel/redraw self 'show none effect/draw/4: colors/outline-light feel: make default-feel[] ] ] ] check-group: make rebface[ tip:{USAGE: check-group data["Option-1" true "Option-2" false "Option-3" none] DESCRIPTION: Group of check boxes. Alignment is vertical unless height is specified as line height. At runtime face/data is a block of logic (or none) indicating state of each check box. OPTIONS: 'info specifies read-only 'bistate disables right-click state} size: 50x-1 pane:[] init: make function![/local off siz pos last-pane][ data: reduce data all[negative? size/y size/y: 0.5 * sizes/line * length? data] off: either size/y > sizes/line[ siz: as-pair size/x sizes/line as-pair 0 sizes/line ][ siz: as-pair 2 * size/x / length? data sizes/line as-pair siz/x 0 ] pos: 0x0 foreach[label state]data[ insert tail pane make check[ tip: none offset: pos size: siz text: label data: state ] pos: pos + off last-pane: last pane last-pane/options: options last-pane/init last-pane/init: none ] data: make function![/local states][ states: copy[] foreach check pane[insert tail states check/data] states ] ] ] drop-list: make rebface[ tip:{USAGE: drop-list "1" data[1 2 3] drop-list data["One" "Two" "Three"] drop-list data ctx-rebgui/locale*/colors DESCRIPTION: Single column modal selection list. At runtime face/text contains current selection.} size: 25x5 text: "" color: colors/outline-light data:[] edge: outline-edge font: default-font para: make default-para[margin: as-pair sizes/slider + 2 2] feel: make default-feel[ engage: make function![face action event][ face/pane/feel/engage face/pane action event ] ] action: make default-action[ on-unfocus: make function![face][ hide-popup face/hidden-text: face/hidden-caret: none true ] ] options:[info] hidden-caret: hidden-text: none picked: make function![][ index? find data text ] rebind: make function![][ color: colors/outline-light para/margin/x: sizes/line + 2 ] init: make function![/local p][ unless block? data[gui-error "drop-list expected data block"] para: make para[] p: self pane: make arrow[ tip: none offset: as-pair p/size/x - p/size/y + 1 1 size: as-pair p/size/y - 4 p/size/y - 4 span: if all[p/span find p/span #W][#X] edge: none action: make default-action[ on-click: make function![face /filter-data fd[block!]/local data p v lines oft][ unless filter-data[edit/unfocus] p: face/parent-face all[find p/options 'no-click exit] data: either fd[fd][p/data] unless zero? lines: length? data[ oft: either (lines * sizes/line) < (p/parent-face/size/y - p/offset/y - p/size/y)[ p/offset + as-pair 0 p/size/y - 1 ][ either (lines * sizes/line) <= (p/parent-face/size/y - 4)[ as-pair p/offset/x p/parent-face/size/y - 2 - (lines * sizes/line) ][ as-pair p/offset/x p/parent-face/size/y - 2 - (sizes/line * to integer! p/parent-face/size/y / sizes/line) ] ] if v: choose p p/size/x oft data[ p/text: form v p/hidden-text: p/hidden-caret: none p/action/on-click p either p/type = 'drop-list[show p edit/unfocus][set-focus p] ] ] ] ] ] pane/init ] ] edit-list: make drop-list[ tip:{USAGE: edit-list "1" data[1 2 3] edit-list data["One" "Two" "Three"] edit-list data ctx-rebgui/locale*/colors DESCRIPTION: Editable single column modal selection list. At runtime face/text contains current selection.} color: colors/page edge: theme-edge feel: make edit/feel bind[ engage: make function![face action event /local start end total visible fd pf][ switch action[ key[ if event/key = #"^M"[ edit-text face event hide-popup edit/unfocus exit ] if event/key = 'down[ either view*/pop-face[set-focus view*/pop-face][face/pane/action/on-click face/pane] exit ] prev-caret: index? view*/caret face/text: any[face/hidden-text head view*/caret] view*/caret: any[face/hidden-caret view*/caret] all[view*/highlight-start view*/highlight-start: at face/text index? view*/highlight-start] all[view*/highlight-end view*/highlight-end: at face/text index? view*/highlight-end] edit-text face event face/hidden-text: copy face/text face/hidden-caret: at face/hidden-text index? view*/caret fd: copy[] if find face/text edit/letter[ foreach ln sort face/data[ if find/match ln face/text[ face/text: copy ln view*/caret: at face/text index? view*/caret unless char? event/key[ view*/caret: at face/text prev-caret edit-text face event face/hidden-text: copy face/text face/hidden-caret: at face/hidden-text index? view*/caret ] ] if find/match ln face/hidden-text[ insert tail fd ln ] ] ] either not empty? fd[ either none? view*/pop-face[ face/pane/action/on-click/filter-data face/pane fd ][ pf: view*/pop-face pf/data: copy fd pf/pane/1/size/y: pf/size/y: sizes/line * (length? fd) pf/lines: to integer! pf/size/y / sizes/line pf/rows: length? fd show pf ] ][ hide-popup ] show face ] down[ either event/double-click[ all[view*/caret not empty? view*/caret current-word view*/caret] ][ either face <> view*/focal-face[set-focus face][unlight-text] view*/caret: offset-to-caret face event/offset show face ] ] over[ unless equal? view*/caret offset-to-caret face event/offset[ unless view*/highlight-start[view*/highlight-start: view*/caret] view*/highlight-end: view*/caret: offset-to-caret face event/offset show face ] ] ] ] ]in edit 'self options:[] caret: none rebind: make function![][color: colors/page] ] field: make rebface[ tip:{USAGE: field field -1 "String" DESCRIPTION: Editable text field with no text wrapping. OPTIONS: 'info specifies read-only} size: 50x5 text: "" color: colors/page edge: theme-edge font: default-font para: default-para feel: edit/feel rebind: make function![][color: colors/page] init: make function![][ if find options 'info[ feel: none all[color = colors/page color: colors/outline-light] ] para: make para[] all[negative? size/x size/x: 10000 size/x: 4 + first size-text self] ] esc: none caret: none undo: copy[] ] group-box: make rebface[ tip:{USAGE: group-box "Title" data[field field] DESCRIPTION: A static widget used to group widgets within a bounded container.} size: -1x-1 text: "Untitled" effect:[draw[pen colors/outline-dark line-width sizes/edge fill-pen none box 0x0 0x0 effects/radius pen colors/page line 0x0 0x0]] font: make default-font-top[color: colors/outline-dark] para: make default-para[origin: as-pair sizes/cell * 4 0] feel: make default-feel[ redraw: make function![face act pos][ if act = 'show[ all[ face/color face/effect/draw/fill-pen: face/color poke face/effect/draw 12 colors/page face/color: none ] face/effect/draw/15/x: sizes/cell * 5 + first size-text face ] ] ] action: make default-action[ on-resize: make function![face][poke face/effect/draw 9 face/size - 1x1] ] rebind: make function![][ font/name: effects/font font/size: sizes/font font/color: colors/outline-dark para/origin/x: sizes/cell * 4 ] init: make function![][ data: layout/only data pane: data/pane foreach face pane[face/offset: face/offset + as-pair 0 sizes/cell * sizes/gap] all[negative? size/x size/x: max 16 + first size-text self data/size/x] all[negative? size/y size/y: sizes/cell * sizes/gap + data/size/y] effect/draw/box/y: effect/draw/14/y: effect/draw/15/y: sizes/cell * 2 effect/draw/14/x: sizes/cell * 3 data: none action/on-resize self ] ] heading: make rebface[ tip:{USAGE: heading "A text heading." DESCRIPTION: Large text.} size: -1x-1 text: "" font: default-font-large para: default-para-wrap init: make function![][ all[negative? size/x negative? size/y size: 10000x10000 size: 4x4 + size-text self] all[negative? size/x size/x: 10000 size/x: 4 + first size-text self] all[negative? size/y size/y: 10000 size/y: 4 + second size-text self] all[size/y > sizes/line font/align <> 'center font: make font[valign: 'top]] size/y: max size/y sizes/line ] ] image: make rebface[ tip:{USAGE: image %images/logo.png image logo image logo effect[crop 10x10 50x50] DESCRIPTION: An image.} size: -1x-1 effect: 'fit init: make function![][ all[negative? size/x size/x: image/size/x] all[negative? size/y size/y: image/size/y] ] ] label: make heading[ tip:{USAGE: label "A text label." DESCRIPTION: Bold text.} font: default-font-bold ] led: make rebface[ tip:{USAGE: led "Option" led "Option" data true led "Option" data false led "Option" data none DESCRIPTION: Tristate indicator box with colors representing Yes & No, and empty being Unknown.} size: -1x5 effect:[draw[pen colors/outline-light fill-pen none box 0x0 0x0]] font: default-font para: default-para-indented feel: make default-feel[ redraw: make function![face act pos][ all[ act = 'show face/effect/draw/4: select reduce[true colors/state-dark false colors/state-light]face/data ] ] ] init: make function![][ if negative? size/x[size/x: 10000 size/x: 4 + para/origin/x + first size-text self] effect/draw/6/y: sizes/cell effect/draw/7: as-pair sizes/cell * 3 sizes/cell * 2.5 ] ] led-group: make rebface[ tip:{USAGE: led-group data["Option-1" true "Option-2" false "Option-3" none] DESCRIPTION: Group of LED indicators. Alignment is vertical unless height is specified as line height. At runtime face/data is a block of logic (or none) indicating state of each LED indicator.} size: 50x-1 pane:[] feel: make default-feel[ redraw: make function![face act pos][ if act = 'show[ face/data: reduce face/data repeat i length? face/pane[ face/pane/:i/data: pick face/data i ] ] ] ] init: make function![/local off siz pos last-pane][ data: reduce data all[negative? size/y size/y: 0.5 * sizes/line * length? data] off: either size/y > sizes/line[ siz: as-pair size/x sizes/line as-pair 0 sizes/line ][ siz: as-pair 2 * size/x / length? data sizes/line as-pair siz/x 0 ] pos: 0x0 foreach[label state]data[ insert tail pane make led[ tip: none offset: pos size: siz text: label data: state ] pos: pos + off last-pane: last pane last-pane/init last-pane/init: none ] clear data foreach led pane[insert tail data led/data] ] ] link: make rebface[ tip:{USAGE: link link http://www.dobeash.com link "RebGUI" http://www.dobeash.com/rebgui DESCRIPTION: Hypertext link.} size: -1x5 font: make default-font[color: blue style: 'underline] para: default-para feel: make default-feel[ over: make function![face act pos][ face/font/color: either act[colors/state-light][blue] show face ] engage: make function![face act event][ all[ act = 'up browse face/data ] ] ] rebind: make function![][ font/name: effects/font font/size: sizes/font ] init: make function![][ unless text[text: either data[form data]["http://www.rebol.com"]] unless data[data: to url! text] all[negative? size/x size/x: 10000 size/x: 4 + first size-text self] ] ] menu: make rebface[ tip:{USAGE: menu data["Item-1"["Choice 1"[alert "1"]"Choice 2"[alert "2"]]"Item-2"[]] DESCRIPTION: Simple one-level text-only menu system.} size: 100x5 pane:[] color: colors/outline-light rebind: make function![][color: colors/outline-light] init: make function![/local item item-offset][ item-offset: 2x0 foreach[label block]data[ insert tail pane make subface[ offset: item-offset size: as-pair 1 sizes/line text: label data: block font: make default-font[align: 'center] para: default-para feel: make default-feel[ over: make function![face act pos][ either act[select-face face][deselect-face face] ] engage: make function![face act event][ if act = 'up[ do select face/data choose face/parent-face face/options face/parent-face/offset + face/offset + as-pair 0 face/size/y extract face/data 2 deselect-face face ] ] ] ] item: last pane item/options: item/size/x: sizes/line + first size-text item item-offset/x: item-offset/x + item/size/x foreach i extract item/data 2[ default-text/text: i item/options: max item/options sizes/cell + first size-text default-text ] ] data: first pane ] ] panel: make pill[ tip:{USAGE: panel sky data[after 1 field field] DESCRIPTION: A static widget used to group widgets within a container.} size: -1x-1 color: colors/outline-light + 32.32.32 rebind: make function![][color: colors/outline-light + 32.32.32] init: make function![][ data: layout/only data pane: data/pane all[negative? size/x size/x: data/size/x] all[negative? size/y size/y: data/size/y] data: none action/on-resize self ] ] password: make field[ tip:{USAGE: password password "Secret" DESCRIPTION: Editable password field with text displayed as a series of large dots.} size: 50x5 color: colors/page font: make default-font[size: to integer! sizes/font * 1.5 name: font-fixed] rebind: make function![][ color: colors/page font/size: to integer! sizes/font * 1.5 ] init: make function![/local p char-width radius][ p: self para: make para[] pane: make subface[ color: colors/page effect:[draw[pen colors/text fill-pen colors/text]] feel: make default-feel[] span: all[p/span find p/span #W #W] ] char-width: first size-text make rebface[ text: "M" font: make default-font[ size: to integer! sizes/font * 1.5 name: font-fixed ] ] radius: to integer! char-width + 1 / 3 pane/size: size pane/feel/redraw: make function![face act pos /local offset]compose/deep[ if act = 'show[ clear skip face/effect/draw 4 either all[view*/focal-face = face/parent-face face/parent-face/text = head view*/caret][ repeat i length? head view*/caret[ insert tail face/effect/draw reduce['circle i * (as-pair char-width 0) + (as-pair 1 - radius sizes/line / 2) (radius)] ] offset: (as-pair char-width 0) * index? view*/caret offset/x: offset/x - (char-width) insert tail face/effect/draw reduce[ 'box offset + (as-pair 2 2) offset + (as-pair 3 sizes/line - 4) ] ][ repeat i length? face/parent-face/text[ insert tail face/effect/draw reduce['circle i * (as-pair char-width 0) + (as-pair 1 - radius sizes/line / 2) (radius)] ] ] ] ] ] ] pie-chart: make rebface[ tip:{USAGE: pie-chart data["Red" red 60 "Green" green 30 "Blue" blue 10] DESCRIPTION: A pie-chart. OPTIONS: 'no-label to turn labels off [start n]where n is the degrees value [explode n]when n is the number of pixels} size: 50x50 feel: make default-feel[ redraw: make function![face act pos /local plot total angle pie-size label-offset label-distance label-size][ if act = 'show[ clear plot: skip last face/effect 4 total: face/degrees pie-size: face/size / 2 - 1x1 - as-pair face/explode face/explode label-distance: pie-size * 0.75 foreach[label color val]face/data[ angle: 360 * val / face/sum insert plot reduce[ 'fill-pen color 'arc face/size / 2 + as-pair face/explode * (cosine (total + (angle / 2))) - 1 face/explode * (sine (total + (angle / 2))) - 1 pie-size total angle 'closed ] unless find face/options 'no-label[ default-text/text: label label-size: size-text default-text label-offset: as-pair label-distance/x * (cosine (total + (angle / 2))) face/explode + label-distance/y * (sine (total + (angle / 2))) label-offset/x: label-offset/x - (label-size/x / 2) label-offset/y: label-offset/y - (label-size/y / 2) insert tail plot reduce['text 'anti-aliased form label face/size / 2 + label-offset] ] total: total + angle if total >= 360[total: total - 360] ] ] ] ] effect:[draw[pen colors/text font default-font]] sum: 0 explode: 0 degrees: 270 init: make function![][ data: reduce data explode: any[select options 'explode 0] if select options 'start[ degrees: 270 + select options 'start if degrees >= 360[degrees: degrees - 360] if degrees < 0[degrees: degrees + 360] ] foreach[label color val]data[sum: sum + val] ] ] progress: make rebface[ tip:{USAGE: progress progress data .5 DESCRIPTION: A horizontal progress indicator. At runtime face/data ranges from 0 to 1 indicating percentage.} size: 50x5 effect:[draw[pen colors/state-dark fill-pen colors/state-dark box 1x1 1x1]] data: 0 edge: default-edge feel: make default-feel[ redraw: make function![face act pos][ all[ act = 'show face/effect/draw/7/x: max 1 face/size/x - 2 - sizes/edge - sizes/edge * face/data: min 1 max 0 face/data ] ] ] action: make default-action[ on-resize: make function![face][face/effect/draw/6/y: face/size/y - 2 - sizes/edge - sizes/edge] ] init: make function![][action/on-resize self] ] radio-group: make rebface[ tip:{USAGE: radio-group data["Option A" "Option B"] radio-group data[2 "On" "Off"] DESCRIPTION: Group of mutually exclusive radio buttons. Alignment is vertical unless height is specified as line height. An integer provided as the first entry in the block indicates the default selection.} size: 50x-1 pane:[] picked: none selected: make function![][ all[picked pick data picked] ] select-item: make function![item[integer! none!]][ either any[none? item zero? item][ item: either picked = 1[2][1] pane/:item/feel/engage/reset pane/:item 'down none ][ all[item <> picked pane/:item/feel/engage pane/:item 'down none] ] ] init: make function![/local off siz pos index][ unless string? first data: reduce data[ picked: first data remove data ] all[negative? size/y size/y: sizes/line * length? data] off: either size/y > sizes/line[ siz: as-pair size/x sizes/line as-pair 0 sizes/line ][ siz: as-pair size/x / length? data sizes/line as-pair siz/x 0 ] pos: 0x0 index: 1 foreach label data[ insert tail pane make subface[ offset: pos size: siz text: label effect: compose/deep[draw[pen (colors/outline-light) fill-pen (colors/page) circle (as-pair sizes/cell * 1.5 sizes/cell * 2.5) (sizes/cell * 1.5)]] data: index font: default-font para: default-para-indented feel: make default-feel[ over: make function![face act pos][ face/effect/draw/pen: either act[colors/outline-dark][colors/outline-light] show face ] engage: make function![face act event /reset /local pf][ do select[ down[ if all[pf: face/parent-face pf/picked <> face/data][ all[ pf/picked clear skip pf/pane/(pf/picked)/effect/draw 7 show pf/pane/(pf/picked) ] either reset[pf/picked: none][ pf/picked: face/data insert tail face/effect/draw reduce[ 'pen colors/state-dark 'fill-pen colors/state-dark 'circle as-pair sizes/cell * 1.5 sizes/cell * 2.5 sizes/cell - 1 ] show face pf/action/on-click pf ] ] ] away[face/feel/over face false 0x0] ]act ] ] ] pos: pos + off index: index + 1 ] all[ integer? picked insert tail pane/:picked/effect/draw reduce[ 'pen colors/state-dark 'fill-pen colors/state-dark 'circle as-pair sizes/cell * 1.5 sizes/cell * 2.5 sizes/cell - 1 ] ] ] ] scroll-panel: make rebface[ tip:{USAGE: scroll-panel data[sheet] DESCRIPTION: A panel used to group widgets within a scrollable container. OPTIONS: 'offset keeps the original offset} size: 50x50 pane:[] edge: outline-edge action: make default-action[ on-click: make function![face][system/view/focal-face: face] on-scroll: make function![face scroll /page][ either page[ all[face/pane/3/show? face/pane/3/set-data scroll] ][ all[face/pane/2/show? face/pane/2/set-data scroll] ] ] on-resize: make function![face /child /local p1 p2 p3 p4][ p1: face/pane/1 p2: face/pane/2 p3: face/pane/3 p4: face/pane/4 p2/show?: either p1/size/y <= face/size/y[face/sld-offset/x: 0 false][face/sld-offset/x: sizes/slider true] p3/show?: either p1/size/x <= face/size/x[face/sld-offset/y: 0 false][face/sld-offset/y: sizes/slider true] p4/show?: either any[p2/show? p3/show?][true][false] p2/ratio: min 1 face/size/y - face/sld-offset/y / p1/size/y p3/ratio: min 1 face/size/x - face/sld-offset/x / p1/size/x if child[ all[p2/ratio = 1 p2/data: p1/offset/y: 0] all[p3/ratio = 1 p3/data: p1/offset/x: 0] show face ] ] ] p1: p2: p3: p4: none sld-offset: 0x0 init: make function![/local p][ p: self data: layout/only data insert pane either 1 = length? data/pane[first data/pane][data] all[negative? size/x size/x: data/size/x] all[negative? size/y size/y: data/size/y] data: none p1: first pane color: p1/color unless find options 'offset[p1/offset: 0x0] p1/edge: none if span[ all[find span #H p1/span: #H] all[find span #W p1/span: #W] all[find span #H find span #W p1/span: #HW] ] insert tail pane make slider[ tip: none offset: as-pair p/size/x - sizes/slider 0 size: as-pair sizes/slider p/size/y - sizes/slider span: case[ none? p/span[none] all[find p/span #H find p/span #W][#XH] find p/span #H[#H] find p/span #W[#X] ] options:[arrows] action: make default-action[ on-click: make function![face][ p1/offset/y: negate p1/size/y + sld-offset/y - p/size/y * face/data show p1 ] ] ] p2: second pane p2/init insert tail pane make slider[ tip: none offset: as-pair 0 p/size/y - sizes/slider size: as-pair p/size/x - sizes/slider sizes/slider span: case[ none? p/span[none] all[find p/span #H find p/span #W][#YW] find p/span #H[#Y] find p/span #W[#W] ] options:[arrows] action: make default-action[ on-click: make function![face][ p1/offset/x: negate p1/size/x + sld-offset/x - p/size/x * face/data show p1 ] ] ] p3: third pane p3/init insert tail pane make symbol[ offset: p/size - as-pair sizes/slider sizes/slider size: as-pair sizes/slider sizes/slider span: case[ none? p/span[none] all[find p/span #H find p/span #W][#XY] find p/span #H[#Y] find p/span #W[#X] ] edge: none data: 'record action: make default-action[ on-click: make function![face /local p][ p: face/parent-face either p1/offset = 0x0[ p2/data: p3/data: 1 ][ p2/data: p3/data: 0 ] all[p2/show? show p2] all[p3/show? show p3] ] ] ] p4: fourth pane p4/init action/on-resize self ] ] sheet: make rebface[ tip:{USAGE: sheet sheet options[size 3x3 width 2] sheet options[size 3x3 widths[2 3 4]] sheet data[A1 1 A2 2 A3 "=A1 + A2"] DESCRIPTION: Simple spreadsheet, based on rebocalc.r, with formulas calculated left to right, top to bottom. A cell is either a scalar value, string, or a formula starting with "=". Scalar values are automatically right-justified, series values left-justified. Remember to put spaces between each item in a formula and use () where needed. OPTIONS: 'size specifies number of columns and rows 'width specifies cell width in relation to cell height 'widths specifies n cell widths} size: -1x-1 color: colors/outline-light pane:[] data:[] cells: none load-data: make function![dat /local v][ insert clear data dat foreach cell cells[ cell/text: either v: select data cell/data[form v][copy ""] enter cell ] compute show cells ] save-data: make function![][ clear data foreach cell cells[ unless empty? cell/text[ insert tail data either cell/init[ reduce[cell/data join "=" form cell/init] ][ reduce[cell/data get cell/data] ] ] ] ] enter: make function![face /local v][ face/color: colors/page face/font/align: 'left attempt[unset face/data] face/init: none all[empty? trim face/text exit] v: attempt[load either #"=" = first face/text[next face/text][face/text]] either any[series? v word? v][ either #"=" = first face/text[face/color: colors/outline-light face/init: :v][set face/data face/text] ][ face/font/align: 'right set face/data v ] ] compute: make function![/local v][ foreach cell cells[ if cell/init[ either all[word? cell/init string? get cell/init][v: get cell/init][ unless v: attempt[do cell/init][cell/text: "ERROR!"] ] cell/font/align: either series? v['left]['right] cell/text: form v set cell/data cell/text show cell ] ] ] init: make function![/local cols rows p pos char v widths row-size][ either pair? v: select options 'size[cols: v/x rows: v/y][ either empty? data[cols: 6 rows: 12][ cols: #"A" rows: 1 foreach[cell val]data[ cols: max cols uppercase first form cell rows: max rows to integer! next form cell ] cols: to integer! cols - 64 ] ] widths: copy[] case[ v: select options 'widths[insert widths v] v: select options 'width[insert/dup widths v cols] true[insert/dup widths 4 cols] ] row-size: as-pair sizes/line * 2 sizes/line if negative? size/x[ size/x: row-size/x + cols + 1 foreach w widths[size/x: w * sizes/line + size/x] ] all[negative? size/y size/y: rows * sizes/line + rows + row-size/y + 1] char: #"A" pos: as-pair row-size/x + 1 0 repeat x cols[ insert tail pane make subface[ offset: pos size: as-pair sizes/line * pick widths x sizes/line text: form char color: colors/theme-dark font: default-font-heading ] char: char + 1 pos/x: sizes/line * (pick widths x) + pos/x + 1 ] pos: as-pair 0 sizes/line + 1 repeat y rows[ insert tail pane make subface[ offset: pos size: row-size text: form y color: colors/theme-dark font: default-font-heading ] pos/y: pos/y + sizes/line + 1 ] p: self cells: tail pane pos: row-size + 1x1 repeat y rows[ pos/x: row-size/x + 1 char: #"A" repeat x cols[ v: to word! join char y insert tail pane make rebface[ type: 'field offset: pos size: as-pair sizes/line * pick widths x sizes/line text: form any[select p/data v ""] color: colors/page font: make default-font[] para: make default-para[] feel: edit/feel data: v action: make default-action[ on-focus: make function![face][ all[face/init face/text: join "=" form face/init] face/font/align: 'left select-face face true ] on-unfocus: make function![face][ deselect-face/fill face enter face compute face/para/scroll: 0x0 true ] ] ] char: char + 1 pos/x: sizes/line * (pick widths x) + pos/x + 1 ] pos/y: pos/y + sizes/line + 1 ] unless empty? data[ foreach cell cells[ unless empty? cell/text[enter cell] ] compute ] ] ] slider: make rebface[ tip:{USAGE: slider slider data .5[print face/data] DESCRIPTION: A slider control. Its size determines whether it is vertical or horizontal. At runtime face/data ranges from 0 to 1 indicating percentage. OPTIONS: 'arrows adds an arrow to each end of the slider creating a scroller 'together forces the arrows to appear together [ratio n]where n indicates the initial dragger size} size: 5x50 data: 0 color: colors/outline-light effect:[ draw[ pen colors/outline-dark fill-pen colors/theme-light box 0x0 10x10 fill-pen colors/theme-light box 0x0 0x0 fill-pen colors/theme-light box 0x0 0x0 pen colors/page fill-pen colors/page triangle 0x0 0x0 0x0 fill-pen colors/page triangle 0x0 0x0 0x0 ] ] ratio: 0.1 step: 5E-2 hold: none state: none flags: none set-data: make function![new[integer! decimal! pair!]/local old][ old: data data: min 1 max 0 either pair? new[ data + either negative? new/y[negate step][step] ][new] all[data <> old show self] ] feel: make default-feel[ redraw: make function![ face act pos /local width state-blk freedom axis dragdom arrow-width arrows? together? draw-blk arrow-blk arrow-size ][ if act = 'draw[ if face/state <> compose state-blk:[(face/data) (face/size) (face/ratio) (face/flags)][ width: min face/size/x face/size/y face/ratio: any[face/ratio 0.1] freedom: 1 - face/ratio axis: either face/size/y > face/size/x['y]['x] dragdom: face/size/:axis arrow-width: 0 if all[face/flags arrows?: find face/flags 'arrows][ arrow-width: min face/size/x face/size/y dragdom: dragdom - (2 * arrow-width) together?: find face/flags 'together ] draw-blk: face/effect/draw arrow-blk: at draw-blk 8 either arrows?[ arrow-size: as-pair arrow-width - 1 arrow-width - 1 arrow-blk/4: either together?[dragdom * either axis = 'y[0x1][1x0]][0x0] arrow-blk/5: arrow-blk/4 + arrow-size arrow-blk/9: dragdom + arrow-width * either axis = 'y[0x1][1x0] arrow-blk/10: arrow-blk/9 + arrow-size arrow-blk/16: arrow-blk/4 + (width * 0.1 * either axis = 'y[5x2][2x5]) arrow-blk/17: arrow-blk/4 + (width * 0.1 * either axis = 'y[2x7][7x8]) arrow-blk/18: arrow-blk/4 + (width * 0.1 * either axis = 'y[8x7][7x2]) arrow-blk/22: arrow-blk/9 + (width * 0.1 * either axis = 'y[5x8][8x5]) arrow-blk/23: arrow-blk/9 + (width * 0.1 * either axis = 'y[8x3][3x2]) arrow-blk/24: arrow-blk/9 + (width * 0.1 * either axis = 'y[2x3][3x8]) ][ repeat pos[4 5 9 10 16 17 18 22 23 24][arrow-blk/:pos: 0x0] ] draw-blk/6: 0x0 draw-blk/6/:axis: (dragdom * freedom * min 1 max 0 face/data) + either together?[0][arrow-width] draw-blk/7: draw-blk/6 + width - 1 draw-blk/7/:axis: (freedom * min 1 max 0 face/data) + face/ratio * (dragdom - 1) + either together?[0][arrow-width] draw-blk/7: max draw-blk/7 draw-blk/6 + as-pair sizes/cell * 2 sizes/cell * 2 either none? face/state[ face/state: compose state-blk ][ face/state: compose state-blk face/action/on-click face ] ] ] ] engage: make function![ face act event /local freedom axis dragdom arrows? together? arrow-width offset more? page oft win-face ][ freedom: 1 - face/ratio axis: either face/size/y > face/size/x['y]['x] dragdom: face/size/:axis arrow-width: 0 if all[face/flags arrows?: find face/flags 'arrows][ arrow-width: min face/size/x face/size/y dragdom: dragdom - (2 * arrow-width) together?: find face/flags 'together ] oft: event/offset if all[act = 'time event/face = view*/screen-face/pane/1][ win-face: find-window face oft: oft + (event/face/offset - win-face/offset) ] offset: oft - either act = 'time[win-offset? face][0] offset: offset/:axis - either together?[0][arrow-width] if find[over away]act[ if all[ number? face/hold freedom > 0 ][ face/set-data (offset - face/hold / (dragdom * freedom)) ] exit ] if find[down time]act[ if act = 'down[face/rate: 16] either all[ more?: offset >= (dragdom * (freedom * face/data)) offset < (dragdom * ((freedom * face/data) + face/ratio)) ][ if act = 'down[ face/hold: offset - (dragdom * (freedom * face/data)) face/effect/draw/4: colors/state-light show face ] ][ case[ offset < 0[ if act = 'down[ face/hold: 'top-arrow face/effect/draw/9: colors/state-light show face ] if face/hold = 'top-arrow[ face/set-data (face/data - face/step) ] ] all[together? offset > dragdom offset < (dragdom + arrow-width)][ if act = 'down[ face/hold: 'top-arrow face/effect/draw/9: colors/state-light show face ] if face/hold = 'top-arrow[ face/set-data (face/data - face/step) ] ] offset > (dragdom + either together?[arrow-width][0])[ if act = 'down[ face/hold: 'bottom-arrow face/effect/draw/14: colors/state-light show face ] if face/hold = 'bottom-arrow[ face/set-data (face/data + face/step) ] ] true[ if act = 'down[face/hold: 'page] if face/hold = 'page[ page: any[all[freedom = 0 0]face/ratio / freedom] face/set-data (face/data + either more?[page][negate page]) ] ] ] ] ] if act = 'up[ face/rate: none face/hold: none face/effect/draw/4: face/effect/draw/9: face/effect/draw/14: colors/theme-light show face ] ] ] rebind: make function![][color: colors/outline-light] init: make function![][ all[number? data data: min 1 max 0 data] flags: copy[] all[find options 'arrows insert tail flags 'arrows] if any[effects/arrows-together find options 'together][insert tail flags 'together] all[find options 'ratio ratio: select options 'ratio] ] ] spinner: make rebface[ tip:{USAGE: spinner spinner options[$1 $10 $1]data $5 DESCRIPTION: Similar to a field, with arrows to increment/decrement a value by a nominated step amount. OPTIONS: [min max step]block of minimum, maximum and step amounts} size: 20x5 color: colors/page text: "" edge: theme-edge font: default-font-right para: make default-para[] feel: edit/feel options:[1 10 1] pane: copy[] action: make default-action[ on-scroll: make function![face scroll /page][ face/text: either any[none? face/data page][ form data: either negative? scroll/y[second face/options][first face/options] ][ form face/data + either negative? scroll/y[last face/options][negate last face/options] ] face/action/on-unfocus face ] on-unfocus: make function![face][ either empty? face/text[ face/data: none ][ face/data: any[attempt[to type? first face/options face/text]face/data] face/text: either face/data[form face/data: min max face/data first face/options second face/options][copy ""] show face ] face/action/on-click face true ] ] rebind: make function![][color: colors/page] init: make function![/local p][ all[data text: form data] all[not empty? text data: to type? first options text] para/margin/x: size/y - sizes/cell p: self insert pane make arrow[ tip: none offset: as-pair p/size/x - p/size/y + sizes/cell 0 size: as-pair p/size/y - sizes/cell p/size/y / 2 span: all[ p/span case[ all[find p/span #L find p/span #W][#OX] find p/span #W[#X] find p/span #L[#O] ] ] data: 'up edge: none action: make default-action[ on-click: make function![face /local p][ p: face/parent-face p/data: any[attempt[to type? first p/options p/text]p/data first p/options] p/data: p/data + third p/options if p/data > second p/options[p/data: second p/options] p/text: form p/data edit/unlight-text view*/caret: none show p p/action/on-click p ] ] ] pane/1/init insert tail pane make arrow[ tip: none offset: as-pair p/size/x - p/size/y + sizes/cell p/size/y / 2 size: as-pair p/size/y - sizes/cell p/size/y / 2 span: all[ p/span case[ all[find p/span #L find p/span #W][#OX] find p/span #W[#X] find p/span #L[#O] ] ] edge: none action: make default-action[ on-click: make function![face /local p][ p: face/parent-face p/data: any[attempt[to type? first p/options p/text]p/data first p/options] p/data: p/data - third p/options if p/data < first p/options[p/data: first p/options] p/text: form p/data edit/unlight-text view*/caret: none show p p/action/on-click p ] ] ] pane/2/init ] esc: none caret: none undo: copy[] ] splitter: make rebface[ tip:{USAGE: area splitter area DESCRIPTION: Placed between two widgets on the same row or column. Allows both to be resized by dragging the splitter left/right or up/down respectively. Its size determines whether it is vertical or horizontal.} size: 1x25 color: colors/outline-light feel: make default-feel[ redraw: make function![face act pos /local f p n][ unless face/data[ f: find face/parent-face/pane face p: back f n: next f if face/size/y <= face/size/x[ while[face/offset/x <> p/1/offset/x][ if head? p[gui-error "Splitter failed to find previous widget"] p: back p ] while[face/offset/x <> n/1/offset/x][ if tail? p[gui-error "Splitter failed to find next widget"] n: next n ] ] face/data: reduce[first p first n] ] ] over: make function![face act pos][ face/color: either act[colors/state-dark][colors/outline-light] show face ] engage: make function![face act event /local p n delta][ if event/type = 'move[ p: first face/data n: second face/data either face/size/y > face/size/x[ delta: face/offset/x - face/offset/x: min n/offset/x + n/size/x - face/size/x - 1 max p/offset/x + 1 face/offset/x + event/offset/x p/size/x: p/size/x - delta n/size/x: n/size/x + delta n/offset/x: n/offset/x - delta ][ delta: face/offset/y - face/offset/y: min n/offset/y + n/size/y - face/size/y - 1 max p/offset/y + 1 face/offset/y + event/offset/y p/size/y: p/size/y - delta n/size/y: n/size/y + delta n/offset/y: n/offset/y - delta ] show[p face n] ] all[act = 'away face/feel/over face false 0x0] ] ] rebind: make function![][color: colors/outline-light] ] style: make rebface[ tip:{USAGE: style 20x20 data[btn "VID btn"] style data[btn 20x20]options[size] DESCRIPTION: A container for a VID style. OPTIONS: 'size use VID style size.} size: 5x5 data:[] init: make function![][ unless find options 'size[insert next data size] data: system/words/layout/tight data pane: data/pane/1 size: pane/size data: none ] ] symbol: make rebface[ tip:{USAGE: symbol data 'start symbol data 'rewind symbol data 'left symbol data 'pause symbol data 'stop symbol data 'record symbol data 'right symbol data 'forward symbol data 'end symbol data 'up symbol data 'down symbol -1 "Some text" DESCRIPTION: Basic single-color shapes, such as those found on media players, on an "arrow" type button. Uses "Webdings" if available, otherwise simple ASCII equivalents.} size: 5x-1 text: "" edge: default-edge font: default-font-heading feel: make default-feel[ redraw: make function![face act pos][ if act = 'show[ face/color: either face/data[colors/state-light][colors/theme-light] ] ] engage: make function![face act event][ do select[ time[all[face/data face/action/on-click face]] down[face/data: on] up[face/data: off face/action/on-click face] over[face/data: on] away[face/data: off] ]act show face ] ] action: make default-action[ on-resize: make function![face][ face/font/size: to integer! (min face/size/x face/size/y) * either face/font/style[0.6][0.8] all[odd? face/font/size face/font/size: face/font/size + 1] all[ not effects/webdings negative? face/font/space/x face/font/space/x: face/font/size * -0.2 ] ] ] init: make function![][ either all[data empty? text][ font: make font either effects/webdings[[name: "webdings"]][[space: -1x0 style: 'bold]] all[negative? size/y size/y: size/x] text: pick do select[ start[["9" "|<<"]] rewind[["7" "<<"]] left[["3" "<"]] pause[[";" "| |"]] stop[["<" "[]"]] record[["=" "O"]] right[["4" ">"]] forward[["8" ">>"]] end[[":" ">>|"]] up[["5" "^^"]] down[["6" "v"]] ]data effects/webdings ][ font: make font[style: 'bold] all[negative? size/y size/y: sizes/line] font/size: to integer! size/y * 0.6 all[negative? size/x size/x: 6 + first size-text self] ] data: off action/on-resize self ] ] table: make rebface[ tip:{USAGE: table options["Name" left .6 "Age" right .4]data["Bob" 32 "Pete" 45 "Jack" 29] DESCRIPTION: Columns and rows of values formatted according to a header definition block. OPTIONS: 'multi allows multiple rows to be selected at once 'no-dividers hides column dividers ["Title" align width]triplets for each column} size: 50x25 color: colors/page pane:[] data:[] edge: default-edge redraw: make function![][] selected: make function![][] picked:[] widths:[] aligns:[] cols: none rows: make function![][pane/1/rows] total-width: none add-row: func[ row[block!] /position pos[integer!] ][ either pos[ pos: (pos - 1) * cols ][ pos: 1 + length? data ] insert at data pos row redraw ] remove-row: func[ row[integer! block!] /local rows removed ][ if integer? row[row: to-block row] rows: sort/reverse copy row repeat n length? rows[ row: max 1 min rows/:n (length? data) / cols remove/part skip data (row - 1) * cols cols ] redraw ] alter-row: func[ row[integer! block!] values[block!] /local rows last-picked ][ last-picked: copy picked if integer? row[row: to-block row] rows: row if (length? rows) <> (length? values)[ values: reduce[values] ] if (length? rows) = (length? values)[ repeat n length? rows[ row: max 1 min rows/:n (length? data) / cols change skip data (row - 1) * cols copy/part values/:n cols ] ] redraw unless empty? last-picked[select-row/no-action last-picked] ] select-row: func[ row[integer! none! block!] /no-action /local rows lines ][ clear picked if row[ row: either integer? row[to block! row][sort copy row] rows: pane/1/rows lines: pane/1/lines foreach r row[ r: max 1 min rows r insert picked r ] if any[ row/1 < (pane/1/scroll + 1) row/1 > (pane/1/scroll + pane/1/lines) ][ pane/1/pane/2/data: 1 / (rows - lines) * ((min (rows - lines + 1) row/1) - 1) ] unless no-action[action/on-click self] ] system/view/caret: pane/1/pane/1/text system/view/focal-face: pane/1/pane/1 show self ] set-columns: func[ options[block!] /no-show /no-dividers /local col-offset p last-col dividers? ][ p: self if (length? pane) > 2[ remove/part next pane 2 * cols - 1 ] clear widths clear aligns cols: (length? options) / 3 p/pane/1/cols: cols p/pane/1/data: p/data col-offset: total-width: 0 foreach[column halign width]options[ unless any[string? column word? column][ gui-error "Table expected column name to be a string or word" ] unless find[left center right]halign[ gui-error {Table expected column align to be one of left, center or right} ] unless decimal? width[ gui-error "Table expected column width to be a decimal" ] insert tail aligns halign insert tail widths width: to integer! p/size/x * width total-width: total-width + width insert back tail pane make subface[ offset: as-pair col-offset 0 size: as-pair width - sizes/cell sizes/line text: form column color: colors/theme-dark col: length? widths para: make default-para[margin: as-pair sizes/line + 2 2] font: make default-font-heading[align: aligns/:col] feel: make default-feel[ over: make function![face act pos][ face/color: either act[colors/theme-light][colors/theme-dark] show face ] engage: make function![face act event /local arrow][ if act = 'down[ arrow: last parent-face/pane unless arrow/col = col[ arrow/col: col arrow/asc: none arrow/offset/x: offset/x + size/x - (sizes/cell * 3) ] arrow/action arrow ] ] ] ] col-offset: col-offset + width if cols > length? widths[ insert back tail pane make subface[ offset: as-pair col-offset - sizes/cell 0 size: as-pair 2 either no-dividers[sizes/line][p/size/y] color: colors/outline-dark span: unless no-dividers[all[p/span find p/span #H #H]] col-1: length? widths col-2: 1 + length? widths feel: make default-feel[ over: make function![face act pos][ color: either act[colors/state-dark][colors/outline-dark] show face ] engage: make function![face act event /local delta arrow][ switch/default act[ down[data: event/offset/x] up[data: none feel/over face false 0x0] alt-up[data: none feel/over face false 0x0] ][ if all[ data event/type = 'move event/offset/x <> data ][ delta: event/offset/x - data delta: either positive? delta[ min delta parent-face/pane/(col-2 * 2)/size/x - (sizes/line * 2) ][ max delta negate parent-face/pane/(col-1 * 2)/size/x - (sizes/line * 2) ] unless zero? delta[ arrow: last parent-face/pane if arrow/col = col-1[arrow/offset/x: arrow/offset/x + delta] offset/x: offset/x + delta widths/:col-1: widths/:col-1 + delta widths/:col-2: widths/:col-2 - delta parent-face/pane/(col-1 * 2)/size/x: widths/:col-1 - sizes/cell parent-face/pane/(col-2 * 2)/offset/x: offset/x + sizes/cell either cols = col-2[ parent-face/pane/(col-2 * 2)/size/x: widths/:col-2 ][ parent-face/pane/(col-2 * 2)/size/x: widths/:col-2 - sizes/cell ] show parent-face ] ] ] ] ] ] ] ] p/options: pane/1/options last-col: first back back tail pane last-col/size/x: last-col/size/x + sizes/cell + size/x - total-width if negative? last-col/size/x[ gui-error "Table column widths are too large" ] widths/:cols: widths/:cols + size/x - total-width if all[span find span #W][ last-col/span: #W ] pane/1/init unless no-show[ show self ] ] rebind: make function![][color: colors/page] init: make function![/local p opts dividers?][ opts:[table] if 'multi = first options[remove options insert tail opts 'multi] dividers?: either 'no-dividers = first options[remove options false][true] if 'multi = first options[remove options insert tail opts 'multi] unless integer? cols: divide length? options 3[ gui-error "Table has an invalid options block" ] if all[not empty? data decimal? divide length? data cols][ gui-error "Table has an invalid data block" ] p: self insert tail pane make face-iterator[ offset: as-pair 0 sizes/line size: p/size - as-pair 0 sizes/line span: either p/span[copy p/span][none] data: p/data cols: p/cols widths: p/widths aligns: p/aligns options: opts picked: p/picked action: get in p/action 'on-click alt-action: get in p/action 'on-alt-click dbl-action: get in p/action 'on-dbl-click ] insert tail pane make subface[ offset: as-pair negate sizes/line sizes/cell size: as-pair sizes/cell * 3 sizes/cell * 3 effect:[arrow colors/text rotate 0] cols: p/cols col: none asc: true feel: make default-feel[ engage: make function![face act event][ all[act = 'down face/action face] ] ] action: make function![face /local last-selected][ asc: either none? asc[true][complement asc] effect/rotate: either asc[0][180] last-selected: selected either asc[ sort/skip/compare parent-face/data cols col ][ sort/skip/compare/reverse parent-face/data cols col ] all[ last-selected select-row/no-action (((index? find parent-face/data last-selected) - 1) / cols) + 1 ] show parent-face ] ] either dividers?[set-columns/no-show options][set-columns/no-show/no-dividers options] redraw: get in pane/1 'redraw selected: get in pane/1 'selected feel: make default-feel[ redraw: make function![face act pos /local total arrow][ if act = 'show[ total: 0 foreach width widths[total: total + width] widths/:cols: widths/:cols + size/x - total arrow: last pane if arrow/col = cols[arrow/offset/x: size/x + sizes/cell - sizes/line] ] ] ] ] ] tab-panel: make rebface[ tip:{USAGE: tab-panel data["A"[field]"B"[field]"C"[field]] tab-panel data["1"[field]action[face/color: red]"2"[field]] DESCRIPTION: A panel with a set of tabs. Each tab spec may be preceded by an action block spec. OPTIONS: 'action do action of initial tab (if any) [tab n]where n specifies tab to initially open with (default 1) no-tabs do not display tabs (overlay mode)} size: -1x-1 pane: copy[] tabs: 0 selected: make function![][ either find options 'no-tabs[data][pane/(tabs + data)/text] ] select-tab: make function![num[integer!]][ if any[num < 1 num > tabs][exit] pane/:data/show?: false edit/unfocus either find options 'no-tabs[ pane/(data: num)/show?: true ][ pane/(tabs + data)/color: colors/theme-dark pane/(tabs + data)/font/color: colors/page pane/(data: num)/show?: true pane/(tabs + data)/color: colors/page pane/(tabs + data)/font/color: colors/text ] pane/(data)/action pane/:data show self ] replace-tab: make function![num[integer!]block[block!]/title text[string!]][ pane/:num: layout/only block pane/:num/offset: as-pair 0 either find options 'no-tabs[0][sizes/line] pane/:num/color: colors/page pane/:num/edge: outline-edge all[title pane/(tabs + num)/text: text] if data <> num[pane/:num/show?: false] show self ] init: make function![/local tab tab-offset trigger][ tab-offset: 0x0 foreach[title spec]data[ either title = 'action[ trigger: spec ][ tabs: tabs + 1 tab: layout/only spec tab/offset/y: either find options 'no-tabs[0][sizes/line] tab/color: colors/page tab/edge: outline-edge tab/show?: false tab/span: #LV tab/action: either trigger[make function![face /local var]trigger][none] insert at pane tabs tab unless find options 'no-tabs[ insert tail pane make subface[ offset: tab-offset size: as-pair 1 sizes/line + 1 text: title effect: reduce['round colors/outline-light effects/radius sizes/edge] data: tabs color: colors/theme-dark font: make default-font-heading[color: colors/page] para: default-para feel: make default-feel[ over: make function![face act pos][ face/color: either act[colors/theme-light][ either face/data = face/parent-face/data[colors/page][colors/theme-dark] ] show face ] engage: make function![face act event /local p][ all[find[down alt-down]act face/parent-face/select-tab face/data] ] ] ] tab: last pane tab/size/x: sizes/line + first size-text tab tab-offset/x: tab-offset/x + tab/size/x + 2 ] trigger: none ] ] all[ negative? size/x repeat i tabs[size/x: max size/x pane/:i/size/x] ] all[ negative? size/y repeat i tabs[size/y: max size/y pane/:i/size/y] size/y: size/y + either find options 'no-tabs[0][sizes/line] ] repeat i tabs[ all[span find span #H insert pane/:i/span #H] all[span find span #W insert pane/:i/span #W] ] pane/(data: any[select options 'tab 1])/show?: true unless find options 'no-tabs[select-tab data] all[find options 'action pane/(data)/action pane/:data] ] ] text: make heading[ tip:{USAGE: text "A text string." text "Blue text" text-color blue text "Bold text" bold text "Italic text" italic text "Underline text" underline DESCRIPTION: Normal text.} font: default-font ] text-list: make rebface[ tip:{USAGE: text-list data["One" "Two"] text-list data ctx-rebgui/locale*/colors text-list data[1 2][print face/selected] DESCRIPTION: A single column list with a scroller. OPTIONS: 'multi allows multiple rows to be selected at once} size: 50x25 color: colors/page data:[] edge: outline-edge redraw: make function![][] selected: make function![][] picked:[] rows: make function![][pane/rows] select-row: make function![ row[integer! none! block!] /no-action /local rows lines ][ clear picked if row[ row: either integer? row[to block! row][sort copy row] rows: pane/rows lines: pane/lines foreach r row[ r: max 1 min rows r insert picked r ] unless no-action[action/on-click self] ] show self ] rebind: make function![][color: colors/page] init: make function![/local p][ p: self pane: make face-iterator[ size: p/size span: either p/span[copy p/span][none] data: p/data options: p/options picked: p/picked action: get in p/action 'on-click alt-action: get in p/action 'on-alt-click dbl-action: get in p/action 'on-dbl-click ] pane/init redraw: get in pane 'redraw selected: get in pane 'selected ] ] title-group: make rebface[ tip:{USAGE: title-group %images/setup.png data "Title" "Body" DESCRIPTION: A title and text with an optional image to the left. If an image is specified then height is set to image height.} font: default-font-top rebind: make function![][ font/name: effects/font font/size: sizes/font ] init: make function![/local p indent][ indent: either image[size/y: image/size/y image/size/x + sizes/line][sizes/line] p: self pane: make subface[ offset: as-pair indent sizes/line size: as-pair p/size/x - indent - sizes/line 10000 text: p/data font: make default-font-bold[size: to integer! sizes/font / 0.75] para: default-para-wrap ] pane/size: 5x5 + size-text pane para: make default-para-wrap compose[ origin: (as-pair indent p/pane/size/y + sizes/line + sizes/line) margin: (as-pair sizes/line 0) ] all[not image negative? size/y size/y: 10000 size/y: para/origin/y + second size-text self] data: none ] ] tool-bar: make rebface[ tip:{USAGE: tool-bar silver data["Open" %images/document-open.png[request-file]pad 2 none "Save" %images/document-save.png[]] DESCRIPTION: An iconic toolbar. Height is set to 30 pixels. [pad n none]sequence works as per 'pad in the display function.} size: 100x-1 pane:[] color: colors/outline-light rebind: make function![][color: colors/outline-light] init: make function![/local icon-offset][ size/y: 30 icon-offset: 2x2 foreach[txt icon spec]data[ either string? txt[ insert tail pane make subface[ offset: icon-offset size: 22x22 text: "" image: any[ if word? icon[get icon] if file? icon[load icon] icon ] tip: txt feel: make default-feel[ over: make function![face act pos][ face/color: either act[colors/state-light][none] show face ] engage: make function![face act event][ do select[ down[face/action face] up[face/feel/over face false none] away[face/feel/over face false none] ]act ] ] action: make function![face /local var]spec ] icon-offset: icon-offset + 24x0 ][ icon-offset/x: icon * sizes/cell + icon-offset/x ] ] data: none ] ] tooltip: make rebface[ tip:{USAGE: tooltip "Some text." DESCRIPTION: Tooltip text.} size: -1x-1 effect:[draw[pen colors/outline-dark line-width sizes/edge fill-pen yello box 0x0 0x0 effects/radius]] font: default-font para: make default-para[origin: 4x4 margin: 4x4] rate: 2 init: make function![][ either all[negative? size/x negative? size/y][ size: 10000x10000 size: 8 + size-text self ][ all[negative? size/x para: default-para-wrap size/x: 10000 size/x: 8 + first size-text self] all[negative? size/y para: default-para-wrap size/y: 10000 size/y: 8 + second size-text self] ] poke effect/draw 9 size - 1x1 ] ] tree: make rebface[ tip:{USAGE: tree data["Pets"["Cat" "Dog"]"Numbers"[1 2 3]] DESCRIPTION: Values arranged in a collapsible hierarchy. OPTIONS: 'expand starts with all nodes expanded 'resize change face/size as tree is expanded / collapsed} size: 50x25 color: colors/page pane:[] data:[] edge: outline-edge chain: pos: expand?: p: old-face: none width: height: 0 show-node: make function![items /no-expand][ foreach item items[ either block? item[ either expand?[show-node item][show-node/no-expand item] ][ expand?: either no-expand[ pane/1/offset/y: negate sizes/line false ][ pane/1/offset/y: pos pos: pos + sizes/line if find options 'resize[ height: height + sizes/line width: max width pane/1/offset/x + pane/1/size/x ] either pane/1/expand?[true][false] ] pane: next pane ] ] ] show-tree: make function![][ pos: height: width: 0 show-node data pane: head pane if find options 'resize[ size: as-pair width height all[parent-face parent-face/action/on-resize/child parent-face] ] show self ] build-tree: make function![items /local last-item][ foreach item items[ either block? item[ last-item: last pane last-item/pane/effect/rotate: either find options 'expand[last-item/expand?: true 180][last-item/expand?: false 90] insert tail chain last last-item/data pos: pos + sizes/line build-tree item pos: pos - sizes/line remove back tail chain ][ insert tail pane make subface[ offset: as-pair pos 0 size: as-pair sizes/line + 4 + first size-text make default-text[text: form item]sizes/line text: form item data: compose[(chain) (item)] span: all[p/span find p/span #W #W] pane: make subface[ size: as-pair sizes/line sizes/line effect: copy[arrow rotate 90] ] font: make default-font[] para: default-para-indented feel: make default-feel[ engage: make function![face act event][ if act = 'down[ all[old-face old-face/font/color: colors/text set-color old-face none] unless none? face/expand?[ face/pane/effect/rotate: either face/expand?[face/expand?: false 90][face/expand?: true 180] show-tree ] face/font/color: colors/page set-color face colors/state-light old-face: face face/parent-face/action/on-click face ] ] ] expand?: none ] ] ] ] rebind: make function![][color: colors/page] init: make function![][ p: self pos: 0 chain: copy[] build-tree data show-tree ] ] ] layout: make function![ spec[block!]"Block of widgets, attributes and keywords" /only "Do not change face offset" /local view-face here margin-size indent-width xy gap-size max-width max-height last-widget widget-face arg append-widget left-to-right? after-count after-limit word widget button-size field-size label-size text-size action-alt-click action-away action-click action-dbl-click action-edit action-focus action-key action-over action-resize action-scroll action-unfocus attribute-size attribute-span attribute-text attribute-text-color attribute-text-style attribute-color attribute-image attribute-effect attribute-data attribute-tip attribute-edge attribute-font attribute-para attribute-feel attribute-rate attribute-show? attribute-options attribute-keycode ][ margin-size: xy: sizes/cell * as-pair sizes/margin sizes/margin gap-size: sizes/cell * as-pair sizes/gap sizes/gap indent-width: 0 max-width: xy/x max-height: xy/y left-to-right?: true after-count: 1 after-limit: 10000 view-face: make rebface[ pane: copy[] color: colors/page effect: all[not only effects/window] options: copy[activate-on-show] keycodes: copy[] ] word: widget: button-size: field-size: label-size: text-size: action-alt-click: action-away: action-click: action-dbl-click: action-edit: action-focus: action-key: action-over: action-resize: action-scroll: action-unfocus: attribute-size: attribute-span: attribute-text: attribute-text-color: attribute-text-style: attribute-color: attribute-image: attribute-effect: attribute-data: attribute-tip: attribute-edge: attribute-font: attribute-para: attribute-feel: attribute-rate: attribute-show?: attribute-options: attribute-keycode: none append-widget: make function![][ if widget[ insert tail view-face/pane make widgets/:widget[ type: either widgets/:widget/type = 'face[widget][widgets/:widget/type] offset: xy size: sizes/cell * any[ if attribute-size[either pair? attribute-size[attribute-size][as-pair attribute-size size/y]] if widget = 'bar[as-pair max-width - margin-size/x / sizes/cell size/y] if all[button-size widget = 'button][either pair? button-size[button-size][as-pair button-size size/y]] if all[field-size widget = 'field][either pair? field-size[field-size][as-pair field-size size/y]] if all[label-size widget = 'label][either pair? label-size[label-size][as-pair label-size size/y]] if all[text-size widget = 'text][either pair? text-size[text-size][as-pair text-size size/y]] size ] span: any[attribute-span span] text: any[attribute-text text][text: copy text] effect: any[attribute-effect effect] data: either any[attribute-data = false data = false][false][any[attribute-data data]] rate: any[attribute-rate rate] show?: either none? attribute-show?[show?][attribute-show?] options: copy any[attribute-options options] color: any[attribute-color color] image: any[attribute-image image] text: translate text data: translate data tip: attribute-tip if attribute-text-color[ font: make any[font widgets/default-font][color: attribute-text-color] ] if attribute-text-style[ font: make any[font widgets/default-font][style: attribute-text-style] ] if attribute-edge[edge: make any[edge widgets/default-edge]attribute-edge] if attribute-font[font: make any[font widgets/default-font]attribute-font] if attribute-para[para: make any[para widgets/default-para]attribute-para] if attribute-feel[feel: make feel attribute-feel] action: make action[] all[action-alt-click action/on-alt-click: make function![face /local var]action-alt-click] all[action-away action/on-away: make function![face /local var]action-away] all[action-click action/on-click: make function![face /local var]action-click] all[action-dbl-click action/on-dbl-click: make function![face /local var]action-dbl-click] all[action-edit action/on-edit: make function![face /local var]action-edit] all[action-focus action/on-focus: make function![face /local var]action-focus] all[action-key action/on-key: make function![face event /local var]action-key] all[action-over action/on-over: make function![face /local var]action-over] all[action-resize action/on-resize: make function![face /local var]action-resize] all[action-scroll action/on-scroll: make function![face scroll /page /local var]action-scroll] all[action-unfocus action/on-unfocus: make function![face /local var]action-unfocus] if any[ get in action 'on-alt-click get in action 'on-click get in action 'on-dbl-click get in action 'on-edit get in action 'on-key get in action 'on-scroll ][ unless get in feel 'engage[ feel: make feel[ engage: make function![face act event][ case[ event/double-click[face/action/on-dbl-click face] act = 'up[face/action/on-click face] act = 'alt-up[face/action/on-alt-click face] act = 'key[ face/action/on-key face event face/action/on-edit face ] act = 'scroll-line[face/action/on-scroll face event/offset] act = 'scroll-page[face/action/on-scroll/page face event/offset] ] ] ] ] ] if any[ get in action 'on-away get in action 'on-over ][ unless get in feel 'over[ feel: make feel[ over: make function![face into pos][ either into[face/action/on-over face][face/action/on-away face] ] ] ] ] ] last-widget: last view-face/pane if attribute-keycode[ insert tail view-face/keycodes reduce[attribute-keycode last-widget] ] last-widget/init last-widget/init: none unless left-to-right?[ last-widget/offset/x: last-widget/offset/x - last-widget/size/x ] xy: last-widget/offset max-height: max max-height xy/y + last-widget/size/y if left-to-right?[ xy/x: xy/x + last-widget/size/x max-width: max max-width xy/x ] after-count: either after-count < after-limit[ xy/x: xy/x + either left-to-right?[gap-size/x][negate gap-size/x] after-count + 1 ][ xy: as-pair margin-size/x + indent-width max-height + gap-size/y after-count: 1 ] if :word[set :word last-widget] word: widget: action-alt-click: action-away: action-click: action-dbl-click: action-edit: action-focus: action-key: action-over: action-resize: action-scroll: action-unfocus: attribute-size: attribute-span: attribute-text: attribute-text-color: attribute-text-style: attribute-color: attribute-image: attribute-effect: attribute-data: attribute-tip: attribute-edge: attribute-font: attribute-para: attribute-feel: attribute-rate: attribute-show?: attribute-options: attribute-keycode: none ] ] parse reduce/only spec words[ any[ opt[here: set arg paren! (here/1: do arg) :here][ 'return ( append-widget xy: as-pair margin-size/x + indent-width max-height + gap-size/y left-to-right?: true after-limit: 10000 ) | 'reverse ( append-widget xy: as-pair max-width max-height + gap-size/y left-to-right?: false after-limit: 10000 ) | 'after set arg integer! ( if widget[ append-widget xy: as-pair margin-size/x + indent-width max-height + gap-size/y ] after-count: 1 after-limit: arg ) | 'button-size[set arg integer! | set arg pair! | | set arg none!](button-size: arg) | 'field-size[set arg integer! | set arg pair! | | set arg none!](field-size: arg) | 'label-size[set arg integer! | set arg pair! | | set arg none!](label-size: arg) | 'text-size[set arg integer! | set arg pair! | | set arg none!](text-size: arg) | 'pad[set arg integer! | set arg paren!]( append-widget all[paren? arg arg: do arg] arg: either left-to-right?[arg * sizes/cell][negate arg * sizes/cell] either after-count = 1[xy/y: xy/y + arg][xy/x: xy/x + arg] ) | 'do set arg block! (view-face/init: make function![face /local var]arg) | 'margin set arg pair! (append-widget margin-size: xy: arg * sizes/cell) | 'indent set arg integer! ( append-widget indent-width: arg * sizes/cell xy/x: margin-size/x + indent-width ) | 'space set arg pair! (append-widget gap-size: arg * sizes/cell) | 'tight (append-widget margin-size: xy: gap-size: 0x0) | 'at set arg pair! (append-widget xy: arg * sizes/cell + margin-size after-limit: 10000) | 'effect[set arg word! | set arg block!](attribute-effect: arg) | 'options set arg block! (attribute-options: arg) | 'data set arg any-type! (attribute-data: either paren? arg[do arg][arg]) | 'edge set arg block! (attribute-edge: arg) | 'font set arg block! (attribute-font: arg) | 'para set arg block! (attribute-para: arg) | 'feel set arg block! (attribute-feel: arg) | 'on set arg block! ( action-click: any[action-click select arg 'click] action-alt-click: any[action-alt-click select arg 'alt-click] action-dbl-click: any[action-dbl-click select arg 'dbl-click] action-away: select arg 'away action-edit: select arg 'edit action-focus: select arg 'focus action-key: select arg 'key action-over: select arg 'over action-resize: select arg 'resize action-scroll: select arg 'scroll action-unfocus: select arg 'unfocus ) | 'on-alt-click set arg block! (action-alt-click: arg) | 'on-away set arg block! (action-away: arg) | 'on-click set arg block! (action-click: arg) | 'on-dbl-click set arg block! (action-dbl-click: arg) | 'on-edit set arg block! (action-edit: arg) | 'on-focus set arg block! (action-focus: arg) | 'on-key set arg block! (action-key: arg) | 'on-over set arg block! (action-over: arg) | 'on-resize set arg block! (action-resize: arg) | 'on-scroll set arg block! (action-scroll: arg) | 'on-unfocus set arg block! (action-unfocus: arg) | 'rate[set arg integer! | set arg time!](attribute-rate: arg) | 'tip set arg string! (attribute-tip: arg) | 'text-color set arg tuple! (attribute-text-color: arg) | 'bold (attribute-text-style: 'bold) | 'italic (attribute-text-style: 'italic) | 'underline (attribute-text-style: 'underline) |[set arg integer! | set arg pair!](attribute-size: arg) | set arg issue! (attribute-span: sort arg) | set arg string! (attribute-text: arg) |[set arg tuple! | set arg none!](attribute-color: arg) | set arg image! (attribute-image: arg) | set arg file! (attribute-image: load arg) | set arg url! (attribute-data: arg) | set arg block! ( case[ none? action-click[action-click: arg] none? action-alt-click[action-alt-click: arg] none? action-dbl-click[action-dbl-click: arg] ] ) | set arg logic! (attribute-show?: arg) | set arg char! (attribute-keycode: arg) | set arg set-word! (append-widget word: :arg) | set arg word! (append-widget widget: arg) ] ] ] append-widget view-face/init view-face view-face/init: none view-face/size: margin-size + as-pair max-width max-height unless only[ foreach face view-face/pane[span-size face view-face/size margin-size] all[ zero? view-face/offset view-face/offset: max 0x0 view*/screen-face/size - view-face/size / 2 ] ] view-face ] requestors: make object![ color-spec: copy[text-size 15 margin 2x2 space 1x1] do make function![/local bx r g b i][ bx: 4 + length? locale*/colors r: bx - 1 g: bx + 2 b: bx + 4 i: 1 foreach color locale*/colors[ insert tail color-spec compose/deep[ box 5x5 (color)[face/parent-face/pane/(bx)/action/on-click face]edge[]feel[ over: make function![face act pos /local p][ all[ act p: face/parent-face/pane p/(bx)/color: face/color p/(r)/text: form face/color/1 p/(g)/text: form face/color/2 p/(b)/text: form face/color/3 set-title face/parent-face (uppercase/part form color 1) ] ] ] ] all[zero? i // 8 insert tail color-spec 'return] i: i + 1 ] all['return <> last color-spec insert tail color-spec 'return] ] read-dir: make function![path /local blk dirs][ blk: copy[] if dirs: attempt[read path][ foreach dir remove-each file sort dirs[any[#"/" <> last file #"." = first file]][ insert tail blk head remove back tail dir insert/only tail blk read-dir dirize path/:dir if empty? last blk[remove back tail blk] ] ] blk ] alert: make function![ "Prompts to acknowledge a message." message[string!]"Message text" /title text[string!]"Title text" ][ display/dialog any[text "Alert"][ text 60x-1 message return bar reverse button "OK"[hide-popup] do[set-focus last face/pane] ] ] question: make function![ "Requests a Yes/No answer to a question." message[string!]"Message text" /title text[string!]"Title text" /local result ][ result: none display/dialog any[text "Question"][ text 50x-1 message return bar reverse button #"N" "No"[result: false hide-popup] button #"Y" "Yes"[result: true hide-popup] do[set-focus last face/pane] ] result ] request-char: make function![ "Requests a character." /title text[string!]"Title text" /font name[string!]"Font to use" /local result char-spec size ][ result: none char-spec: copy[text-size 7x7 tight] name: any[name either effects/webdings["webdings"][effects/font]] size: to integer! sizes/font * 1.5 repeat i 256[ if i > 32[ insert tail char-spec compose/deep[ text (colors/page) (form to char! i - 1) font[name: (name) size: (size) align: 'center][result: to char! face/text hide-popup]on[ over[select-face face] away[deselect-face face] ] ] if zero? remainder i 16[insert tail char-spec 'return] ] ] display/dialog any[text "Character Map"]char-spec result ] request-color: make function![ "Requests a color." /title text[string!]"Title text" /color clr[tuple!]"Default color" /allow-none "Allow none as a value" /local result bx btn ][ clr: any[clr colors/text] result: false display/dialog any[text "Color Palette"]compose/deep[ (color-spec) return bar return text "Red" spinner 15 data (clr/1) options[0 255 1][bx/color/1: face/data show bx] bx: box 5x5 #L clr edge[][result: bx/color hide-popup] return text "Green" spinner 15 data (clr/2) options[0 255 1][bx/color/2: face/data show bx] return text "Blue" spinner 15 data (clr/3) options[0 255 1][bx/color/3: face/data show bx] return bar reverse button "OK"[result: bx/color hide-popup] btn: button "None" false[result: none hide-popup] do[ all[allow-none btn/show?: true] bx/size/y: sizes/cell * 17 ] ] result ] request-date: make function![ "Requests a date." /title text[string!]"Title text" /date dt[date!]"Initial date to show (default is today)" /local result ][ result: none display/dialog any[text "Calender"][ tight calendar data (any[dt now/date])[result: face/data hide-popup] ] result ] request-dir: make function![ "Requests a directory." /title text[string!]"Title text" /path dir[file!]"Set starting directory" /expand "Start with all nodes expanded" /local result txt opts ][ if any[none? dir not exists? dir][dir: clean-path %.] dir: dirize dir opts: either expand[[resize expand]][[resize]] result: none display/dialog any[text "Select a Directory:"][ after 1 txt: text 100 (form to-local-file dir) scroll-panel #HW 100x50 data[ tree 100x50 options opts data (read-dir dir)[ var: dir foreach item face/data[var: rejoin[var item #"/"]] set-text txt to-local-file var ] ] bar #WY reverse button #XY "Open"[result: dirize to-rebol-file txt/text hide-popup] ] result ] request-file: make function![ {Requests a file using a popup list of files and directories.} /title text[string!]"Title text" /file path[file! block!]"Default file name or block of file names" /filter name[string!]mask[string!] /only "Return only a single file, not a block" /save "Request file for saving, otherwise loading" /local result blk ][ text: any[text either save["Save"]["Open"]] if file[ set[path file]split-path clean-path path ] if any[none? path not exists? path][path: clean-path %.] file: either any[none? file not exists? path/:file][copy[]][compose[(file)]] if local-request-file result: reduce[ any[select locale*/words text text] "" path file compose[(any[select locale*/words name name select locale*/words "All" "All"])] compose/deep[[(any[mask "*"])]] logic? only logic? save ][ either only[join result/3 first result/4][ blk: copy[] foreach file result/4[insert tail blk join result/3 file] blk ] ] ] request-font: make function![ "Requests a font name, returning a string." /title text[string!]"Title text" /style "Adds a style selector (returns font! object!)" /size "Adds a size selector (returns font! object!)" /align "Adds an alignment selector (returns font! object!)" /local result f blk ][ result: none blk: copy[ group-box "Font" data[ margin 2x2 text-list (as-pair 50 30 + sizes/gap) data effects/fonts[f/font/name: f/text: copy face/selected show f] ] ] all[ style insert tail blk[ group-box 30 "Style" data[ margin 2x2 radio-group data[1 "Normal" "Bold" "Italic" "Underline"][ f/font/style: pick reduce[none 'bold 'italic 'underline]face/picked show f ] ] ] ] if size[ all[style insert tail blk reduce['at as-pair 54 + sizes/gap 25 + sizes/gap]] insert tail blk[ group-box 30 "Size" data[ margin 2x2 spinner #L options[8 36 2]data 24[f/font/size: face/data show f] ] ] all[style align insert tail blk reduce['at as-pair 86 + sizes/gap 0]] ] all[ align insert tail blk[ group-box 30 "Align" data[ margin 2x2 radio-group data[2 "left" "center" "right"][ f/font/align: to word! face/selected show f ] return radio-group data[2 "top" "middle" "bottom"][ f/font/valign: to word! face/selected show f ] ] ] ] insert tail blk[ return f: field #L effects/font 20x20 edge[size: 0x0]font[size: 24 align: 'center] return bar reverse button "Cancel"[hide-popup] button "OK"[result: either any[style size align][f/font][f/font/name]hide-popup] ] display/dialog any[text "Available Fonts"]blk result ] request-menu: make function![ "Requests a menu choice." face[object!]"Widget to appear in relation to" menu[block!]"Label/Action block pairs" /width x[integer!]"Width in pixels (defaults to 25 units)" /offset xy[pair!]"Offset relative to widget (defaults to top right)" /local result ][ result: none do select menu result: widgets/choose face any[x 25 * sizes/cell]any[xy face/offset + as-pair face/size/x 0]extract menu 2 result ] request-password: make function![ "Requests a username and password." /title text[string!]"Title text" /user username[string!]"Default username" /pass password[string!]"Default password" /check rules[block!]{Rules to test password against (fails if string returned)} /only "Password only" /verify "Verify password" /local result s blk u p v ][ blk: copy[text-size 20] all[check rules: make function![text[string!]]rules] all[not only insert tail blk compose[text "Username:" u: field (any[username ""]) return]] insert tail blk compose[text "Password:" p: password (any[password ""]) return] all[verify insert tail blk[text "Verify:" v: password return]] result: none display/dialog any[text "Password"]compose[ (blk) bar reverse button "OK"[ case[ all[not only empty? u/text][ alert "Username must be provided." set-focus u ] all[check string? s: rules p/text][ alert s set-focus p ] all[verify p/text <> v/text][ alert "Please try again." set-focus v ] true[ result: either only[copy p/text][reduce[u/text p/text]] hide-popup ] ] ] ] result ] request-progress: make function![ "Requests a progress dialog for an action block." steps[integer!]"Number of iterations" block[block!]"Action block" /title text[string!]"Title text" /local step s p ][ s: 1 / steps step: make function![][p/data: p/data + s show p] display/parent any[text "Loading ..."][ after 1 label (any[text "Loading ..."]) p: progress do[face/options:[no-title]] ] do bind block 'step unview ] request-spellcheck: make function![ "Requests spellcheck on a widget's text." face[object!] /title text[string!]"Title text" /anagram "Anagram option" /local ignore new next-word word start end txt fld lst a ][ if any[not string? face/text empty? face/text][exit] ignore: copy[] new: copy[] unless exists? %dictionary[make-dir %dictionary] unless locale*/dict[locale*/dict: make hash! 1000] next-word: make function![/init][ while[any[init start <> end]][ either init[ start: end: head face/text unless find edit/letter first start[ while[all[not tail? start: next start find edit/other first start]][] ] init: false ][ start: end while[all[not tail? start: next start find edit/other first start]][] ] end: start while[all[not tail? end: next end find edit/letter first end]][] word: copy/part start end unless any[ empty? word find ignore word find new word find locale*/dict word ][break] word: none ] if all[none? init word][ txt/text: fld/text: word show[txt fld] insert clear lst/data edit/lookup-word word lst/redraw view*/focal-face: face view*/caret: none edit/hilight-text start end show face ] string? word ] if next-word/init[ view*/caret: none edit/hilight-text start end show face display/dialog any[text rejoin["Spellcheck (" locale*/language ")"]][ label-size 25 after 2 label "Original" txt: text 75 word label "Word" fld: field 75 word label "Suggestions" lst: text-list data (edit/lookup-word word) 75x50[set-text fld face/selected] bar reverse button "Close"[ hide-popup ] button "Add"[ insert tail new fld/text unless next-word[hide-popup] ] button "Replace"[ change/part start fld/text end end: skip start length? fld/text unless next-word[hide-popup] ] button "Ignore"[ insert tail ignore word unless next-word[hide-popup] ] a: button "Anagram" false[ either 2 < var: length? fld/text[ face/data: lowercase sort copy fld/text clear lst/data foreach word locale*/dict[ all[var = length? word face/data = sort copy word insert tail lst/data word] ] lst/redraw ][alert "Requires a word with at least 3 characters."] ] do[all[anagram a/show?: true]] ] set-focus face unless empty? new[ insert tail locale*/dict new write locale*/dictionary form locale*/dict ] ] ] request-ui: make function![ "Requests UI changes." /title text[string!]"Title text" /file name[file!]"Set file to save changes (default is ui.dat)" /local result c1 c2 c3 c4 c5 c6 c7 c8 s1 s2 s3 s4 s5 s6 b1 b2 b3 b4 b5 b6 e1 e2 e3 e4 e5 e6 e7 e8 ][ result: none display/dialog any[text "User Interface"][ tab-panel data[ "Colors"[ group-box "General" data[ text-size 15 after 2 text "Page" c1: box 10x5 edge[color: colors/text]colors/page[all[var: request-color/color face/color set-color face var]] text "Text" c2: box 10x5 edge[color: colors/text]colors/text[all[var: request-color/color face/color set-color face var]] ] return group-box "Theme" data[ text-size 15 after 2 text "Light" c3: box 10x5 edge[color: colors/text]colors/theme-light[all[var: request-color/color face/color set-color face var]] text "Dark" c4: box 10x5 edge[color: colors/text]colors/theme-dark[all[var: request-color/color face/color set-color face var]] drop-list #L data["Butter" "Orange" "Chocolate" "Chameleon" "Sky Blue" "Plum" "Scarlet Red"][ set-color c3 pick[252.233.79 252.175.62 233.185.110 138.226.52 114.159.207 173.127.168 239.41.41]face/picked set-color c4 pick[196.160.0 206.92.0 143.89.2 78.154.6 32.74.135 92.53.102 164.0.0]face/picked ] ] group-box "State" data[ text-size 15 after 2 text "Light" c5: box 10x5 edge[color: colors/text]colors/state-light[all[var: request-color/color face/color set-color face var]] text "Dark" c6: box 10x5 edge[color: colors/text]colors/state-dark[all[var: request-color/color face/color set-color face var]] drop-list #L data["Butter" "Orange" "Chocolate" "Chameleon" "Sky Blue" "Plum" "Scarlet Red"][ set-color c5 pick[252.233.79 252.175.62 233.185.110 138.226.52 114.159.207 173.127.168 239.41.41]face/picked set-color c6 pick[196.160.0 206.92.0 143.89.2 78.154.6 32.74.135 92.53.102 164.0.0]face/picked ] ] group-box "Outline" data[ text-size 15 after 2 text "Light" c7: box 10x5 edge[color: colors/text]colors/outline-light[all[var: request-color/color face/color set-color face var]] text "Dark" c8: box 10x5 edge[color: colors/text]colors/outline-dark[all[var: request-color/color face/color set-color face var]] ] ] "Sizes"[ group-box "Pixels & Points" 60 data[ label-size 15 after 3 label "Cell" s1: drop-list 15 (form sizes/cell) data[3 4 5 6 7 8]text "pixels" label "Edge" s2: drop-list 15 (form sizes/edge) data[1 2 3]text "pixel(s)" label "Font" s3: drop-list 15 (form sizes/font) data[8 9 10 11 12 14 16 18 20 22 24]text "points" ] return group-box "Cells" 60 data[ label-size 15 after 3 label "Gap" s4: drop-list 15 (form sizes/gap) data[1 2 3 4]text "cell(s)" label "Margin" s5: drop-list 15 (form sizes/margin) data[2 4 6 8]text "cells" label "Slider" s6: drop-list 15 (form sizes/slider / sizes/cell) data[2 3 4]text "cells" ] ] "Behaviors"[ after 1 group-box "Action" #L data[ label-size 20 after 2 label "On enter" b1: field #L (form behaviors/action-on-enter) label "On tab" b2: field #L (form behaviors/action-on-tab) ] group-box "Focus" #L data[ label-size 20 after 2 label "Caret" b3: field #L (form behaviors/caret-on-focus) label "Hilight" b4: field #L (form behaviors/hilight-on-focus) ] group-box "Tabbing" #L data[ label-size 20 after 2 label "Cyclic" b5: field #L (form behaviors/cyclic) label "Tabbable" b6: field #L (form behaviors/tabbed) ] ] "Effects"[ after 1 group-box "Window effect(s)" #L data[ e1: field #L (either effects/window[mold/only effects/window][copy ""]) ] group-box "General" #L data[ label-size 20 label "Font" e2: button 50x5 #L effects/font[all[var: request-font set-text face var]] return label "Fonts" e3: field #L (mold/only effects/fonts) return label "Radius" e4: spinner 25 options[0 15 1](form effects/radius) text "pixel(s)" return label "Arrows" e5: radio-group 25x5 data[pick[2 1]effects/arrows-together "Win" "Mac"] label "Symbols" e6: radio-group 25x5 data[pick[1 2]effects/webdings "On" "Off"] ] group-box "Delay (in seconds)" #L data[ label-size 20 label "Splash" e7: spinner 25 (form effects/splash-delay) label "Tooltip" e8: spinner 25 options[0 10 1](either none? effects/tooltip-delay["0"][form to integer! effects/tooltip-delay]) ] ] ] reverse button "Cancel"[result: none hide-popup] button "Reset"[ either exists? %ui.dat[ if question {This action will delete your preferences and exit the application, do you wish to proceed?}[ either none? attempt[delete %ui.dat][ alert "Could not delete %ui.dat. File read-only?" ][quit] ] ][result: none hide-popup] ] button "Save"[ colors/page: c1/color colors/text: c2/color colors/theme-light: c3/color colors/theme-dark: c4/color colors/state-light: c5/color colors/state-dark: c6/color colors/outline-light: c7/color colors/outline-dark: c8/color sizes/cell: to integer! s1/text sizes/edge: to integer! s2/text sizes/font: to integer! s3/text sizes/gap: to integer! s4/text sizes/margin: to integer! s5/text sizes/slider: sizes/cell * to integer! s6/text sizes/line: sizes/cell * 5 behaviors/action-on-enter: load/all b1/text behaviors/action-on-tab: load/all b2/text behaviors/caret-on-focus: load/all b3/text behaviors/hilight-on-focus: load/all b4/text behaviors/cyclic: load/all b5/text behaviors/tabbed: load/all b6/text effects/window: either empty? e1/text[none][load/all e1/text] effects/font: form e2/text effects/fonts: load/all e3/text effects/radius: e4/data effects/arrows-together: either e5/selected = "Mac"[true][false] effects/webdings: either e6/selected = "On"[true][false] effects/splash-delay: e7/data effects/tooltip-delay: either zero? e8/data[none][to time! e8/data] widgets/rebind save any[name %ui.dat]reduce[colors sizes behaviors effects] result: true hide-popup ] ] result ] request-value: make function![ "Requests a value." prompt[string!]"Prompt text" /title text[string!]"Title text" /default value[any-type!]"Default value" /type datatype[datatype!]"Return type" /local result f b ][ value: form any[value ""] result: none display/dialog any[text "Ask"][ text prompt f: field value[b/action/on-click b] return bar reverse button "Cancel"[hide-popup] b: button "OK"[ either type[ var: attempt[to datatype f/text] either var[ result: var hide-popup ][alert reform[f/text "is not a valid" join datatype "!"]] ][ result: f/text hide-popup ] ] do[set-focus f] ] result ] splash: make function![ {Displays a centered splash screen for one or more seconds.} spec[block! file! image!]"The face spec or image to display" ][ spec: either block? spec[make subface spec][ make subface[ image: either file? spec[load spec][spec] size: image/size ] ] spec/type: 'splash spec/offset: max 0x0 view*/screen-face/size - spec/size / 2 spec/color: any[spec/color colors/page] view/new/options spec 'no-title wait effects/splash-delay ] ] foreach word find first requestors 'alert[ either word = 'request-file[ all[ find[2 3]fourth system/version value? 'local-request-file set to word! word get in requestors word ] ][ set to word! word get in requestors word ] ] functions: make object![ append-widget: make function![ "Append a custom widget to widgets context." spec[block!]"Widget spec" /local word ][ all[ find words word: to word! first spec gui-error reform[word "is already in use"] ] widgets: make widgets spec all[ find words third spec widgets/:word/type: third spec ] insert tail words word ] clear-text: make function![ {Clear text attribute of a widget or block of widgets.} face[object! block!] /no-show "Don't show" /focus ][ foreach f reduce either object? face[[face]][face][ if string? f/text[ clear f/text all[f/type = 'area f/para/scroll: 0x0 f/pane/data: 0] f/line-list: none ] ] unless no-show[ either all[focus object? face][set-focus face][show face] ] ] display: make function![ {Displays widgets in a centered window with a title.} title[string!]"Window title" spec[block!]"Block of widgets, attributes and keywords" /dialog {Displays widgets in a modal popup window with /parent option} /maximize "Maximize window" /parent "Force parent to be last window (default is first)" /position "Use an alternative positioning scheme" offset[pair! word! block!]{Offset pair or one or more of 'left 'right 'top 'bottom 'first 'second} /min-size "Specify a minimum OS window resize size" size[pair!]{Minimum display size (including window border/title)} /close "Handle window close event" closer[block!]"The close handler block" /local tooltip-time tooltip ][ foreach window view*/screen-face/pane[all[title = window/text exit]] spec: layout spec spec/text: title if position[ either pair? offset[ spec/offset: max 0x0 offset ][ foreach word compose[(offset)][ if word = 'first[word: either view*/screen-face/size/x > view*/screen-face/size/y['left]['top]] if word = 'second[word: either view*/screen-face/size/x > view*/screen-face/size/y['right]['bottom]] do select[ left[spec/offset/x: max 0 view*/screen-face/size/x / 2 - spec/size/x / 2] right[spec/offset/x: max 0 view*/screen-face/size/x / 2 - spec/size/x / 2 + (view*/screen-face/size/x / 2)] top[spec/offset/y: max 0 view*/screen-face/size/y / 2 - spec/size/y / 2] bottom[spec/offset/y: max 0 view*/screen-face/size/y / 2 - spec/size/y / 2 + (view*/screen-face/size/y / 2)] ]word ] ] ] unless empty? view*/screen-face/pane[ either view*/screen-face/pane/1/type <> 'splash[ insert tail spec/options reduce['parent either any[dialog parent][last view*/screen-face/pane][first view*/screen-face/pane]] ][unview] ] either any[min-size maximize][ insert tail spec/options 'resize all[maximize spec/changes:[maximize]] ][ foreach sub-face spec/pane[ all[ sub-face/span not empty? intersect sub-face/span #HWXY insert tail spec/options 'resize break ] ] ] all[ find spec/options 'resize insert tail spec/options reduce['min-size either min-size[size][spec/size + view*/title-size + view*/resize-border]] ] either dialog[ spec/type: 'popup spec/feel: system/words/face/feel show-popup spec ][view/new spec] all[close spec/action: make function![face /local var]closer] spec/feel: make any[spec/feel widgets/default-feel][ orig-size: spec/size mouse-offset: 0x0 if all[not dialog effects/tooltip-delay][ tooltip-time: now/time/precise insert tail spec/pane tooltip: make widgets/tooltip[type: 'tooltip offset: -10000x-10000 tip: none] ] detect: make function![face event /local f][ if none? tooltip[ f: last face/pane if f/type = 'tooltip[ tooltip-time: now/time/precise tooltip: last face/pane ] ] if all[ face/type <> 'popup effects/tooltip-delay tooltip/data event/type <> 'time mouse-offset <> event/offset ][ tooltip-time: now/time/precise tooltip/data: false tooltip/offset: -10000x-10000 show tooltip ] if all[ face/type <> 'popup effects/tooltip-delay not tooltip/data (now/time/precise - tooltip-time) > effects/tooltip-delay ][ f: event/face while[f: find-face event/offset f][ if all[f/type <> 'face f/tip][ tooltip/text: f/tip tooltip/init tooltip/size: 10000x10000 tooltip/size: 8 + size-text tooltip poke tooltip/effect/draw 9 tooltip/size - 1x1 tooltip/offset: min event/face/size - tooltip/size - 2 max 2x2 event/offset - as-pair 0 tooltip/size/y tooltip/data: true if all[ tooltip/parent-face block? tooltip/parent-face/pane ][ remove find tooltip/parent-face/pane tooltip ] insert tail event/face/pane tooltip show tooltip break ] if function? get in f 'pane[break] unless f: f/pane[break] ] ] if find[down up alt-down alt-up]event/type[ if all[ view*/focal-face not within? event/offset win-offset? view*/focal-face view*/focal-face/size ][unless edit/unfocus[exit]] ] do select[ key[ case[ event/key = #"^-"[ if all[view*/focal-face viewed? view*/focal-face][ f: either event/shift[edit/back-field view*/focal-face][edit/next-field view*/focal-face] if find behaviors/action-on-tab view*/focal-face/type[ view*/focal-face/action/on-click view*/focal-face ] if :f[set-focus f] exit ] ] find[#" " #"^M"]event/key[ if all[view*/focal-face view*/focal-face/type = 'button][ view*/focal-face/action/on-click view*/focal-face exit ] ] all[ find[f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12]event/key get in on-fkey event/key ][ on-fkey/(event/key) face event exit ] any[not view*/focal-face view*/focal-face/type = 'button][ either f: select face/keycodes event/key[ f/action/on-click f exit ][ if event/key = #"^["[ if find view*/pop-list view*/pop-face[hide-popup exit] if all[view*/pop-face view*/pop-face/type = 'choose][hide-popup exit] all[get in face 'action not face/action face exit] if all[face = pick view*/screen-face/pane 1 1 <> length? view*/screen-face/pane][ either question "Do you really want to quit this application?"[quit][exit] ] unview/only face exit ] ] ] ] ] move[mouse-offset: event/offset] resize[ all[face/size <> orig-size span-resize face face/size - orig-size] show face orig-size: face/size exit ] close[ if view*/focal-face[ view*/focal-face: view*/caret: none edit/unlight-text ] all[get in face 'action not face/action face exit] if all[face = pick view*/screen-face/pane 1 1 <> length? view*/screen-face/pane][ either question "Do you really want to quit this application?"[quit][exit] ] ] ]event/type event ] ] either dialog[do-events][show spec spec] ] examine: make function![ "Prints information about widgets and attributes." 'widget /indent "Indent output as an MD2 ready string" /no-print "Do not print output to console" /local string tmp blk funcs ][ unless word? widget[widget: to word! widget] unless find tmp: next find first widgets 'choose widget[ print "Unknown widget. Supported widgets are:^/" foreach widget tmp[print join "^-" widget] exit ] widget: widgets/:widget string: replace/all copy widget/tip "^/" "^/^-" replace/all string "[" join " " "[" replace/all string "]" join "]" " " replace/all string "^- " "^-" replace/all string " ^/" "^/" replace string "^-DESCRIPTION:" "^/DESCRIPTION:" replace string "^-OPTIONS:" "^/OPTIONS:" insert tail string { ATTRIBUTES:} foreach attribute skip first rebface 3[ if all[ not find[show? face-flags feel action tip]attribute get tmp: in widget attribute ][ tmp: either find["function" "object" "block" "bitset"]form type? get tmp[join type? get tmp "!"][mold get tmp] insert tail string rejoin[ "^/^-" head insert/dup tail form attribute " " 16 - length? form attribute tmp ] ] ] unless widget/feel = widgets/default-feel[ insert tail string "^/^/PREDEFINED FEELS:" foreach attribute next first widgets/default-feel[ if get in widget/feel attribute[ insert tail string join "^/^-" attribute ] ] ] unless widget/action = widgets/default-action[ insert tail string "^/^/PREDEFINED ACTIONS:" foreach attribute next first widgets/default-action[ if get in widget/action attribute[ insert tail string join "^/^-" attribute ] ] ] funcs: copy[] unless empty? blk: difference first rebface first widget[ insert tail string "^/^/EXTENDED ATTRIBUTES:" foreach attribute blk[ if tmp: in widget attribute[ either function? get tmp[ insert tail funcs attribute ][ tmp: either find["object" "block" "bitset"]form type? get tmp[join type? get tmp "!"][mold get tmp] insert tail string rejoin["^/^-" head insert/dup tail form attribute " " 16 - length? form attribute tmp] ] ] ] ] unless empty? funcs[ insert tail string "^/^/ACCESSOR FUNCTIONS:" foreach attribute funcs[ tmp: copy "" foreach w third get in widget attribute[ all[word? w insert tail tmp join " " w] if refinement? w[ either w = /local[break][insert tail tmp join " /" w] ] ] insert tail string rejoin["^/^-" uppercase form attribute tmp] ] ] if indent[ replace/all string "^/" "^/^-" replace/all string "^-^/" "^/" insert string "^-" ] if no-print[ replace/all string "^-" " " ] either any[indent no-print][string][print string] ] get-values: make function![ {Gets values from input widgets within a display or grouping widget.} face[object!]"Display face" /type "Precede each value with its type" /local blk ][ all[ find[scroll-panel tab-panel]face/type face: either block? face/pane[face: face/pane/1][face/pane] ] blk: copy[] foreach widget face/pane[ if find[ area check check-group drop-list edit-list field group-box password radio-group scroll-panel slider tab-panel table text-list ]widget/type[ all[type insert tail blk widget/type] insert/only tail blk case[ find[area drop-list edit-list field password]widget/type[widget/text] find[check check-group slider]widget/type[widget/data] find[radio-group table text-list]widget/type[widget/picked] find[scroll-panel group-box tab-panel]widget/type[ either type[get-values/type widget][get-values widget] ] ] ] ] blk ] set-color: make function![ "Set and show a widget's color attribute." face[object!] color[tuple! none!] /no-show "Don't show" ][ face/color: color unless no-show[show face] ] set-data: make function![ "Set and show a widget's data attribute." face[object!] data[any-type!] /no-show "Don't show" ][ face/data: either series? data[copy data][data] unless no-show[show face] ] set-focus: make function![ "Set and show widget focus." face[object!] /caret ][ unless edit/unfocus[exit] if face/show?[ if get in face/action 'on-focus[ unless face/action/on-focus face[return false] ] view*/focal-face: face view*/caret: case[ all[caret in face 'caret face/caret][at face/text face/caret] find behaviors/caret-on-focus face/type[either none? edit/caret[tail face/text][edit/caret]] find behaviors/hilight-on-focus face/type[edit/hilight-all face face/text] ] edit/caret: none all[in face 'esc face/esc: copy face/text] either face/type = 'button[face/feel/over face true none][show face] ] ] set-locale: make function![ "Dynamically set/change locale." language[string! none!] /local dat-file ][ clear system/locale/words system/locale/dict: none all[ exists? dat-file: join what-dir either language[rejoin[%language/ language %.dat]][%locale.dat] system/locale: construct/with load dat-file system/locale ] all[ exists? system/locale/dictionary: rejoin[what-dir %dictionary/ system/locale/language %.dat] system/locale/dict: make hash! parse read system/locale/dictionary " " ] locale*: system/locale ] set-state: make function![ "Toggle and show widget state." face[object!] /info "Exit if already info." /edit "Exit if already edit." /local temp ][ all[info find face/options 'info exit] all[edit not find face/options 'info exit] either temp: find face/options 'info[remove temp][insert tail face/options 'info] case[ find[area edit-list field]face/type[ face/color: either find face/options 'info[ face/action: make face/action[on-focus: make function![face][false]] all[face/type = 'edit-list insert tail face/options 'no-click] colors/outline-light ][ face/action: make face/action[on-focus: make function![face][true]] all[face/type = 'edit-list remove find face/options 'no-click] colors/page ] ] face/type = 'button[ unless find face/options 'info[face/feel/over face false 0x0] ] ] show face ] set-text: make function![ "Set and show a widget's text attribute." face[object!]"Widget" text[any-type!]"Text" /caret "Insert at cursor position (tail if none)" /no-show "Don't show" /focus ][ unless string? face/text[exit] either caret[ if all[ face = view*/focal-face view*/caret ][face/caret: index? view*/caret] either face/caret[ insert at face/text face/caret form text view*/caret: at face/text face/caret + length? form text face/caret: index? view*/caret ][insert tail face/text form text] ][insert clear face/text form text] all[ face/para face/para/scroll: 0x0 all[face/type = 'area face/pane/data: 0] ] face/line-list: none unless no-show[either focus[set-focus face][show face]] ] set-text-color: make function![ "Set and show a widget's font color attribute." face[object!] color[tuple! none!] /no-show "Don't show" ][ unless string? face/text[exit] all[ widgets/(face/type)/font face/font = widgets/(face/type)/font face/font: make face/font[] ] face/font/color: color unless no-show[show face] ] set-texts: make function![ "Set and show text attribute of a block of widgets." faces[block!]"Widgets" text[any-type!]"Text or block of text" /no-show "Don't show" ][ unless block? text[text: reduce[text]] foreach face reduce faces[ set-text face first text unless 1 = length? text[text: next text] ] text: head text unless no-show[show faces] ] set-title: make function![ "Set and show window title." face[object!]"Window dialog face" title[string!]"Window bar title" ][ face/text: title face/changes: 'text show face ] set-values: make function![ {Puts values into input widgets within a display or grouping widget.} face[object!]"Display face" blk[block!]"Block of values (or 'skip)" /no-show "Don't show" /local val ][ all[ find[scroll-panel tab-panel]face/type face: either block? face/pane[face: face/pane/1][face/pane] ] foreach widget face/pane[ if find[ area check check-group drop-list edit-list field group-box password radio-group scroll-panel slider tab-panel table text-list ]widget/type[ unless 'skip = val: first blk[ switch/default widget/type[ check[widget/data: val] check-group[all[block? val insert clear widget/data val]] group-box[all[block? val set-values/no-show widget copy/deep val]] radio-group[widget/select-item to integer! val] scroll-panel[all[block? val set-values/no-show widget copy/deep val]] slider[widget/data: to decimal! val] tab-panel[all[block? val set-values/no-show widget copy/deep val]] table[widget/select-row val] text-list[widget/select-row val] ][ widget/line-list: none insert clear widget/text val all[widget/type = 'area widget/para widget/para/scroll: 0x0 widget/pane/data: 0] ] ] if tail? blk[gui-error "set-values had insufficient values"] blk: next blk ] ] blk: head blk unless no-show[show face] ] translate: make function![ {Dynamically translate a string or block of strings.} text "String (or block of strings) to translate" /local match ][ if all[series? text locale*/words][ text: copy/deep text all[ string? text match: select/skip locale*/words text 2 insert clear text match ] if block? text[ foreach word text[ all[ string? word match: select/skip locale*/words word 2 insert clear word match ] ] ] ] text ] ] foreach word find first functions 'append-widget[ set to word! word get in functions word ] remove-each font effects/fonts[not font? font] set-locale none insert tail words next find first widgets 'choose ] system/view/screen-face/feel: none open-events recycle