| 1 | display: make function! [
|
|---|
| 2 | "Displays widgets in a centered window with a title."
|
|---|
| 3 | title [string!] "Window title"
|
|---|
| 4 | spec [block!] "Block of widgets, attributes and keywords"
|
|---|
| 5 | /dialog "Displays widgets in a modal popup window with /parent option"
|
|---|
| 6 | /maximize "Maximize window"
|
|---|
| 7 | /parent "Force parent to be last window (default is first)"
|
|---|
| 8 | /position "Use an alternative positioning scheme"
|
|---|
| 9 | offset [pair! word! block!] "Offset pair or one or more of 'left 'right 'top 'bottom 'first 'second"
|
|---|
| 10 | /min-size "Specify a minimum OS window resize size"
|
|---|
| 11 | size [pair!] "Minimum display size (including window border/title)"
|
|---|
| 12 | /close "Handle window close event"
|
|---|
| 13 | closer [block!] "The close handler block"
|
|---|
| 14 | /local tooltip-time tooltip
|
|---|
| 15 | ][
|
|---|
| 16 | ; prevent duplicate display being opened
|
|---|
| 17 | foreach window view*/screen-face/pane [all [title = window/text exit]]
|
|---|
| 18 | ; parse block spec into face object
|
|---|
| 19 | spec: layout spec
|
|---|
| 20 | spec/text: title
|
|---|
| 21 | ; position?
|
|---|
| 22 | if position [
|
|---|
| 23 | either pair? offset [
|
|---|
| 24 | spec/offset: max 0x0 offset
|
|---|
| 25 | ][
|
|---|
| 26 | foreach word compose [(offset)] [
|
|---|
| 27 | if word = 'first [word: either view*/screen-face/size/x > view*/screen-face/size/y ['left] ['top]]
|
|---|
| 28 | if word = 'second [word: either view*/screen-face/size/x > view*/screen-face/size/y ['right] ['bottom]]
|
|---|
| 29 | do select [
|
|---|
| 30 | left [spec/offset/x: max 0 view*/screen-face/size/x / 2 - spec/size/x / 2]
|
|---|
| 31 | right [spec/offset/x: max 0 view*/screen-face/size/x / 2 - spec/size/x / 2 + (view*/screen-face/size/x / 2)]
|
|---|
| 32 | top [spec/offset/y: max 0 view*/screen-face/size/y / 2 - spec/size/y / 2]
|
|---|
| 33 | bottom [spec/offset/y: max 0 view*/screen-face/size/y / 2 - spec/size/y / 2 + (view*/screen-face/size/y / 2)]
|
|---|
| 34 | ] word
|
|---|
| 35 | ]
|
|---|
| 36 | ]
|
|---|
| 37 | ]
|
|---|
| 38 | ; make window after 1st a child of 1st (or last if parent refinement used)
|
|---|
| 39 | unless empty? view*/screen-face/pane [
|
|---|
| 40 | either view*/screen-face/pane/1/type <> 'splash [
|
|---|
| 41 | insert tail spec/options reduce ['parent either any [dialog parent] [last view*/screen-face/pane] [first view*/screen-face/pane]]
|
|---|
| 42 | ] [unview]
|
|---|
| 43 | ]
|
|---|
| 44 | ; resize window?
|
|---|
| 45 | either any [min-size maximize] [
|
|---|
| 46 | insert tail spec/options 'resize
|
|---|
| 47 | all [maximize spec/changes: [maximize]]
|
|---|
| 48 | ][
|
|---|
| 49 | ; do any sub-faces require resize?
|
|---|
| 50 | foreach sub-face spec/pane [
|
|---|
| 51 | all [
|
|---|
| 52 | sub-face/span
|
|---|
| 53 | not empty? intersect sub-face/span #HWXY
|
|---|
| 54 | insert tail spec/options 'resize
|
|---|
| 55 | break
|
|---|
| 56 | ]
|
|---|
| 57 | ]
|
|---|
| 58 | ]
|
|---|
| 59 | ; min-size?
|
|---|
| 60 | all [
|
|---|
| 61 | find spec/options 'resize
|
|---|
| 62 | insert tail spec/options reduce ['min-size either min-size [size] [spec/size + view*/title-size + view*/resize-border]]
|
|---|
| 63 | ]
|
|---|
| 64 | ; popup or display?
|
|---|
| 65 | either dialog [
|
|---|
| 66 | spec/type: 'popup
|
|---|
| 67 | spec/feel: system/words/face/feel
|
|---|
| 68 | show-popup spec
|
|---|
| 69 | ] [view/new spec]
|
|---|
| 70 | ; add window feel to handle resize, focus and/or keycodes
|
|---|
| 71 | all [close spec/action: make function! [face /local var] closer]
|
|---|
| 72 | spec/feel: make any [spec/feel widgets/default-feel] [
|
|---|
| 73 | orig-size: spec/size
|
|---|
| 74 | mouse-offset: 0x0
|
|---|
| 75 | ; tooltip code
|
|---|
| 76 | if all [not dialog effects/tooltip-delay] [
|
|---|
| 77 | tooltip-time: now/time/precise
|
|---|
| 78 | insert tail spec/pane tooltip: make widgets/tooltip [type: 'tooltip offset: -10000x-10000 tip: none]
|
|---|
| 79 | ]
|
|---|
| 80 | detect: make function! [face event /local f] [
|
|---|
| 81 | ; The following code prevents tooltips being lost after returning from
|
|---|
| 82 | ; a requestor. Seems like the requestor detect function replaces the
|
|---|
| 83 | ; calling display's detect function!
|
|---|
| 84 | if none? tooltip [
|
|---|
| 85 | f: last face/pane
|
|---|
| 86 | if f/type = 'tooltip [
|
|---|
| 87 | tooltip-time: now/time/precise
|
|---|
| 88 | tooltip: last face/pane
|
|---|
| 89 | ]
|
|---|
| 90 | ]
|
|---|
| 91 | if all [
|
|---|
| 92 | face/type <> 'popup ;not dialog
|
|---|
| 93 | effects/tooltip-delay
|
|---|
| 94 | tooltip/data
|
|---|
| 95 | event/type <> 'time
|
|---|
| 96 | mouse-offset <> event/offset
|
|---|
| 97 | ] [
|
|---|
| 98 | tooltip-time: now/time/precise
|
|---|
| 99 | tooltip/data: false
|
|---|
| 100 | tooltip/offset: -10000x-10000
|
|---|
| 101 | show tooltip
|
|---|
| 102 | ]
|
|---|
| 103 | if all [
|
|---|
| 104 | face/type <> 'popup ;not dialog
|
|---|
| 105 | effects/tooltip-delay
|
|---|
| 106 | not tooltip/data
|
|---|
| 107 | (now/time/precise - tooltip-time) > effects/tooltip-delay
|
|---|
| 108 | ] [
|
|---|
| 109 | f: event/face
|
|---|
| 110 | while [f: find-face event/offset f] [
|
|---|
| 111 | if all [f/type <> 'face f/tip] [
|
|---|
| 112 | tooltip/text: f/tip
|
|---|
| 113 | tooltip/init
|
|---|
| 114 | tooltip/size: 10000x10000
|
|---|
| 115 | tooltip/size: 8 + size-text tooltip
|
|---|
| 116 | poke tooltip/effect/draw 9 tooltip/size - 1x1
|
|---|
| 117 | tooltip/offset: min event/face/size - tooltip/size - 2 max 2x2 event/offset - as-pair 0 tooltip/size/y
|
|---|
| 118 | tooltip/data: true
|
|---|
| 119 | if all [
|
|---|
| 120 | tooltip/parent-face
|
|---|
| 121 | block? tooltip/parent-face/pane
|
|---|
| 122 | ][
|
|---|
| 123 | remove find tooltip/parent-face/pane tooltip
|
|---|
| 124 | ]
|
|---|
| 125 | insert tail event/face/pane tooltip
|
|---|
| 126 | show tooltip
|
|---|
| 127 | break
|
|---|
| 128 | ]
|
|---|
| 129 | if function? get in f 'pane [break]
|
|---|
| 130 | unless f: f/pane [break]
|
|---|
| 131 | ]
|
|---|
| 132 | ]
|
|---|
| 133 | ; unfocus if a different widget is clicked on
|
|---|
| 134 | if find [down up alt-down alt-up] event/type [
|
|---|
| 135 | if all [
|
|---|
| 136 | view*/focal-face
|
|---|
| 137 | ; face <> view*/focal-face (hack borrowed from VID)
|
|---|
| 138 | not within? event/offset win-offset? view*/focal-face view*/focal-face/size
|
|---|
| 139 | ] [unless edit/unfocus [exit]]
|
|---|
| 140 | ]
|
|---|
| 141 | do select [
|
|---|
| 142 | key [
|
|---|
| 143 | case [
|
|---|
| 144 | event/key = #"^-" [
|
|---|
| 145 | if all [view*/focal-face viewed? view*/focal-face] [
|
|---|
| 146 | ; find previous/next tabbable field
|
|---|
| 147 | f: either event/shift [edit/back-field view*/focal-face] [edit/next-field view*/focal-face]
|
|---|
| 148 | if find behaviors/action-on-tab view*/focal-face/type [
|
|---|
| 149 | view*/focal-face/action/on-click view*/focal-face
|
|---|
| 150 | ]
|
|---|
| 151 | if :f [set-focus f]
|
|---|
| 152 | exit
|
|---|
| 153 | ]
|
|---|
| 154 | ]
|
|---|
| 155 | find [#" " #"^M"] event/key [
|
|---|
| 156 | if all [view*/focal-face view*/focal-face/type = 'button] [
|
|---|
| 157 | view*/focal-face/action/on-click view*/focal-face
|
|---|
| 158 | exit
|
|---|
| 159 | ]
|
|---|
| 160 | ]
|
|---|
| 161 | all [
|
|---|
| 162 | find [f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12] event/key
|
|---|
| 163 | get in on-fkey event/key
|
|---|
| 164 | ][
|
|---|
| 165 | on-fkey/(event/key) face event
|
|---|
| 166 | exit
|
|---|
| 167 | ]
|
|---|
| 168 | ; if key is assigned to a click action do it
|
|---|
| 169 | any [not view*/focal-face view*/focal-face/type = 'button] [
|
|---|
| 170 | either f: select face/keycodes event/key [
|
|---|
| 171 | f/action/on-click f exit
|
|---|
| 172 | ][
|
|---|
| 173 | if event/key = #"^[" [
|
|---|
| 174 | ; Hide popup on ESC
|
|---|
| 175 | if find view*/pop-list view*/pop-face [hide-popup exit]
|
|---|
| 176 | ; Hide choose if it currently doesn't have focus
|
|---|
| 177 | if all [view*/pop-face view*/pop-face/type = 'choose] [hide-popup exit]
|
|---|
| 178 | ; exit if closer action returns false
|
|---|
| 179 | all [get in face 'action not face/action face exit]
|
|---|
| 180 | ; prompt to quit if first window of multiple is closed
|
|---|
| 181 | if all [face = pick view*/screen-face/pane 1 1 <> length? view*/screen-face/pane] [
|
|---|
| 182 | either question "Do you really want to quit this application?" [quit] [exit]
|
|---|
| 183 | ]
|
|---|
| 184 | unview/only face
|
|---|
| 185 | exit
|
|---|
| 186 | ]
|
|---|
| 187 | ]
|
|---|
| 188 | ]
|
|---|
| 189 | ]
|
|---|
| 190 | ]
|
|---|
| 191 | move [mouse-offset: event/offset]
|
|---|
| 192 | resize [
|
|---|
| 193 | all [face/size <> orig-size span-resize face face/size - orig-size]
|
|---|
| 194 | show face
|
|---|
| 195 | orig-size: face/size
|
|---|
| 196 | exit
|
|---|
| 197 | ]
|
|---|
| 198 | close [
|
|---|
| 199 | ; unfocus
|
|---|
| 200 | if view*/focal-face [
|
|---|
| 201 | view*/focal-face: view*/caret: none
|
|---|
| 202 | edit/unlight-text
|
|---|
| 203 | ]
|
|---|
| 204 | ; exit if closer action returns false
|
|---|
| 205 | all [get in face 'action not face/action face exit]
|
|---|
| 206 | ; prompt to quit if first window of multiple is closed
|
|---|
| 207 | if all [face = pick view*/screen-face/pane 1 1 <> length? view*/screen-face/pane] [
|
|---|
| 208 | either question "Do you really want to quit this application?" [quit] [exit]
|
|---|
| 209 | ]
|
|---|
| 210 | ]
|
|---|
| 211 | ] event/type
|
|---|
| 212 | event
|
|---|
| 213 | ]
|
|---|
| 214 | ]
|
|---|
| 215 | either dialog [do-events] [show spec spec]
|
|---|
| 216 | ] |
|---|
