| 1 | REBOL [
|
|---|
| 2 | Title: "RebGUI system"
|
|---|
| 3 | Owner: "Ashley G. Trüter"
|
|---|
| 4 | Purpose: "Creates the RebGUI context and associated global functions."
|
|---|
| 5 | Acknowledgements: {
|
|---|
| 6 | The following people have contributed code and / or coding suggestions to this project:
|
|---|
| 7 |
|
|---|
| 8 | Allen Kamp
|
|---|
| 9 | Alphe Salas-Schuman (shadwolf)
|
|---|
| 10 | Anton Rolls
|
|---|
| 11 | Ashley G. Trüter
|
|---|
| 12 | Carl Sassenrath
|
|---|
| 13 | Christian Ensel
|
|---|
| 14 | Christopher Ross-Gill
|
|---|
| 15 | David Oliver (Oldes)
|
|---|
| 16 | Gabriele Santilli
|
|---|
| 17 | Graham Chiu
|
|---|
| 18 | Gregg Irwin
|
|---|
| 19 | Henrik Mikael Kristensen
|
|---|
| 20 | Ladislav Mecir
|
|---|
| 21 | Pascal Lefevre
|
|---|
| 22 | Richard (Cyphre)
|
|---|
| 23 | Robert M. Müench
|
|---|
| 24 | Romano Paolo Tenca
|
|---|
| 25 | Vincent Ecuyer
|
|---|
| 26 | Volker Nitsch
|
|---|
| 27 | ...
|
|---|
| 28 |
|
|---|
| 29 | and the many others who have taken the time to look at RebGUI and discuss it on AltME.
|
|---|
| 30 | }
|
|---|
| 31 | History: {
|
|---|
| 32 | 16 Added words block for layout function
|
|---|
| 33 | 17 Added set-attribute & set-attributes accessor functions
|
|---|
| 34 | 27 Added REBGUI-BUILD test
|
|---|
| 35 | 33 Replaced build test with ctx-rebgui/build word <- MUST BE UPDATED PRIOR TO CREATING A NEW DISTRO
|
|---|
| 36 | 34 Closed a number of long-standing tickets (21,53,3,44,41,4,5), many of which had been fixed previously
|
|---|
| 37 | 36 Added viewed?
|
|---|
| 38 | 39 Spell-check focal-face fix
|
|---|
| 39 | Bumped min View requirement to 1.3.2
|
|---|
| 40 | 40 Added colors/button
|
|---|
| 41 | Button now uses colors/button and colors/over
|
|---|
| 42 | 41 Fixed button away bug
|
|---|
| 43 | 42 Fixed tool-bar tooltips (hide on mouse up)
|
|---|
| 44 | return none if duplicate display title
|
|---|
| 45 | 43 button/color now picks up dynamic color change
|
|---|
| 46 | 44 tool-tip and tool-bar code unified
|
|---|
| 47 | Fixed area bug (info killed engage for all areas)
|
|---|
| 48 | 45 display now returns face
|
|---|
| 49 | clear-widget uses radio-group/select-item and table/text-list select-row
|
|---|
| 50 | table/rows attribute added to complement table/cols
|
|---|
| 51 | text-list/rows attribute added
|
|---|
| 52 | get-input and set-input funcs added
|
|---|
| 53 | 47 Fixed locale bug and added translate func
|
|---|
| 54 | 48 Incorporated Cyphre's changes
|
|---|
| 55 | 49 Added spinner widget
|
|---|
| 56 | 50 Replaced spaces with tabs
|
|---|
| 57 | 51 Distance? function optimized (Ladislav)
|
|---|
| 58 | 52 Added action-on-tab (Graham)
|
|---|
| 59 | 60 Tooltips are now set to off by default (Graham)
|
|---|
| 60 | 61 Added rebind facet to rebface
|
|---|
| 61 | 62 tooltip-delay
|
|---|
| 62 | 65 Cleaned up comments
|
|---|
| 63 | tool-tip renamed tooltip
|
|---|
| 64 | Added span-size func to support new #L and #V span directives
|
|---|
| 65 | 70 Added missing calendar & symbol widgets to SVN
|
|---|
| 66 | 71 Calendar fix
|
|---|
| 67 | 74 Added [on-alt-click on-away on-click on-dbl-click on-focus on-key on-over on-scroll on-unfocus] words
|
|---|
| 68 | Added [text-color] words
|
|---|
| 69 | 78 Added fkey handler for f1 - f12 (Graham)
|
|---|
| 70 | 81 Added /continue refinement to gui-error
|
|---|
| 71 | 82 Fixed locale* errors and improved spellcheck hash! saving performance
|
|---|
| 72 | 93 Added on-edit handler
|
|---|
| 73 | 94 edit-list focus fix
|
|---|
| 74 | 95 Added on keyword
|
|---|
| 75 | 96 Fixed tooltip sizing bug
|
|---|
| 76 | 111 Added on-resize handler
|
|---|
| 77 | }
|
|---|
| 78 | ]
|
|---|
| 79 |
|
|---|
| 80 | if system/version < 1.3.2 [make error! "RebGUI requires View 1.3.2 or greater"]
|
|---|
| 81 |
|
|---|
| 82 | ; Are we using view.r?
|
|---|
| 83 |
|
|---|
| 84 | unless value? 'viewed? [
|
|---|
| 85 | find-window: make function! [
|
|---|
| 86 | "Find a face's window face."
|
|---|
| 87 | face [object!]
|
|---|
| 88 | ][
|
|---|
| 89 | while [face/parent-face] [face: face/parent-face]
|
|---|
| 90 | face
|
|---|
| 91 | ]
|
|---|
| 92 | viewed?: make function! [
|
|---|
| 93 | "Returns TRUE if face is displayed."
|
|---|
| 94 | face [object!]
|
|---|
| 95 | ][
|
|---|
| 96 | found? find system/view/screen-face/pane find-window face
|
|---|
| 97 | ]
|
|---|
| 98 | ]
|
|---|
| 99 |
|
|---|
| 100 | system/locale: make system/locale [ ; colors are in descending order of brightness
|
|---|
| 101 | 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]
|
|---|
| 102 | words: []
|
|---|
| 103 | language: "English"
|
|---|
| 104 | dictionary: none
|
|---|
| 105 | dict: none
|
|---|
| 106 | ]
|
|---|
| 107 |
|
|---|
| 108 | ;
|
|---|
| 109 | ; --- RebGUI context ---
|
|---|
| 110 | ;
|
|---|
| 111 |
|
|---|
| 112 | ctx-rebgui: make object! [
|
|---|
| 113 |
|
|---|
| 114 | build: 118
|
|---|
| 115 | view*: system/view
|
|---|
| 116 | locale*: system/locale
|
|---|
| 117 |
|
|---|
| 118 | ;
|
|---|
| 119 | ; Internal helper functions
|
|---|
| 120 | ;
|
|---|
| 121 |
|
|---|
| 122 | ; find face under mouse cursor
|
|---|
| 123 |
|
|---|
| 124 | find-face: make function! [pnt [pair!] f [object! block!] /local p result] [
|
|---|
| 125 | all [
|
|---|
| 126 | object? :f
|
|---|
| 127 | f/show?
|
|---|
| 128 | within? pnt win-offset? f f/size
|
|---|
| 129 | return f
|
|---|
| 130 | ]
|
|---|
| 131 | p: either object? :f [get in f 'pane] [:f]
|
|---|
| 132 | either block? :p [
|
|---|
| 133 | result: none
|
|---|
| 134 | foreach face head reverse copy p [
|
|---|
| 135 | if all [object? :face face/show? face: find-face pnt face] [
|
|---|
| 136 | result: face
|
|---|
| 137 | break
|
|---|
| 138 | ]
|
|---|
| 139 | ]
|
|---|
| 140 | result
|
|---|
| 141 | ] [
|
|---|
| 142 | all [object? :p find-face pnt :p]
|
|---|
| 143 | ]
|
|---|
| 144 | ]
|
|---|
| 145 |
|
|---|
| 146 | ; valid font?
|
|---|
| 147 |
|
|---|
| 148 | subface: make system/standard/face [
|
|---|
| 149 | color: edge: font: para: feel: none
|
|---|
| 150 | ]
|
|---|
| 151 |
|
|---|
| 152 | all-chars: make string! 256
|
|---|
| 153 | repeat i 256 [insert tail all-chars to char! i - 1]
|
|---|
| 154 |
|
|---|
| 155 | font?: make function! [
|
|---|
| 156 | font-name [string!]
|
|---|
| 157 | ][
|
|---|
| 158 | all [font-name = font-sans-serif return true]
|
|---|
| 159 | (size-text make subface [text: all-chars font: make view*/screen-face/font [name: font-sans-serif]]) <>
|
|---|
| 160 | (size-text make subface [text: all-chars font: make view*/screen-face/font [name: font-name]])
|
|---|
| 161 | ]
|
|---|
| 162 |
|
|---|
| 163 | ; global error handler
|
|---|
| 164 |
|
|---|
| 165 | gui-error: make function! [
|
|---|
| 166 | error [string!]
|
|---|
| 167 | /continue
|
|---|
| 168 | ][
|
|---|
| 169 | write/append/lines %rebgui.log reform [now/date now/time error]
|
|---|
| 170 | unless continue [make error! error]
|
|---|
| 171 | ]
|
|---|
| 172 |
|
|---|
| 173 | ; handles #HWXY span directives
|
|---|
| 174 |
|
|---|
| 175 | span-resize: make function! [face [object!] delta [pair!]] [
|
|---|
| 176 | if face/span [
|
|---|
| 177 | face/old-size: face/size
|
|---|
| 178 | all [find face/span #X face/offset/x: face/offset/x + delta/x]
|
|---|
| 179 | all [find face/span #Y face/offset/y: face/offset/y + delta/y]
|
|---|
| 180 | all [find face/span #W face/size/x: face/size/x + delta/x]
|
|---|
| 181 | all [find face/span #H face/size/y: face/size/y + delta/y]
|
|---|
| 182 | all [face/old-size <> face/size object? get in face 'action face/action/on-resize face]
|
|---|
| 183 | ]
|
|---|
| 184 | ; pane could be an iterator function
|
|---|
| 185 | any [
|
|---|
| 186 | if block? get in face 'pane [foreach f face/pane [span-resize f delta]]
|
|---|
| 187 | if object? get in face 'pane [span-resize face/pane delta]
|
|---|
| 188 | ]
|
|---|
| 189 | ]
|
|---|
| 190 |
|
|---|
| 191 | ; handles #LVO span directives
|
|---|
| 192 |
|
|---|
| 193 | span-size: make function! [face [object!] size [pair!] margin [pair!]] [
|
|---|
| 194 | if face/span [
|
|---|
| 195 | all [
|
|---|
| 196 | find face/span #L
|
|---|
| 197 | face/size/x: size/x - face/offset/x - margin/x
|
|---|
| 198 | all [find [drop-list edit-list] face/type face/pane/offset/x: face/size/x - sizes/line + 1]
|
|---|
| 199 | ]
|
|---|
| 200 | all [find face/span #V face/size/y: size/y - face/offset/y - margin/y]
|
|---|
| 201 | all [face/old-size <> face/size object? get in face 'action face/action/on-resize face]
|
|---|
| 202 | if find face/span #O [
|
|---|
| 203 | face/offset/x: either any [zero? face/offset/y size/y = (face/offset/y + face/size/y)] [
|
|---|
| 204 | size/x - face/size/x
|
|---|
| 205 | ][
|
|---|
| 206 | size/x - face/size/x - margin/x
|
|---|
| 207 | ]
|
|---|
| 208 | ]
|
|---|
| 209 | ]
|
|---|
| 210 | if block? get in face 'pane [
|
|---|
| 211 | either face/type = 'tab-panel [
|
|---|
| 212 | foreach f face/pane [span-size f face/size 0x0]
|
|---|
| 213 | ][
|
|---|
| 214 | foreach f face/pane [span-size f face/size face/pane/1/offset]
|
|---|
| 215 | ]
|
|---|
| 216 | ]
|
|---|
| 217 | if object? get in face 'pane [span-size face/pane face/size face/pane/offset]
|
|---|
| 218 | ]
|
|---|
| 219 |
|
|---|
| 220 | ; unview faces down to n
|
|---|
| 221 |
|
|---|
| 222 | unview-keep: make function! [num [integer!] /local pane] [
|
|---|
| 223 | pane: head view*/screen-face/pane
|
|---|
| 224 | while [(length? pane) > num] [remove back tail pane]
|
|---|
| 225 | show view*/screen-face
|
|---|
| 226 | ]
|
|---|
| 227 |
|
|---|
| 228 | 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]
|
|---|
| 229 |
|
|---|
| 230 | ;
|
|---|
| 231 | ; --- Hilight funcs ---
|
|---|
| 232 | ;
|
|---|
| 233 |
|
|---|
| 234 | select-face: make function! [face] [
|
|---|
| 235 | face/color: colors/state-light
|
|---|
| 236 | face/font/color: colors/page
|
|---|
| 237 | show face
|
|---|
| 238 | ]
|
|---|
| 239 |
|
|---|
| 240 | deselect-face: make function! [face /fill] [
|
|---|
| 241 | face/color: either fill [colors/page] [none]
|
|---|
| 242 | face/font/color: colors/text
|
|---|
| 243 | show face
|
|---|
| 244 | ]
|
|---|
| 245 |
|
|---|
| 246 | ;
|
|---|
| 247 | ; UI Definitions
|
|---|
| 248 | ;
|
|---|
| 249 |
|
|---|
| 250 | colors: construct/with either exists? %ui.dat [pick load %ui.dat 3] [[]] make object! [
|
|---|
| 251 | page: ivory ;white
|
|---|
| 252 | text: coal ;black
|
|---|
| 253 | theme-light: 195.221.127
|
|---|
| 254 | theme-dark: 136.187.0
|
|---|
| 255 | state-light: 255.204.127
|
|---|
| 256 | state-dark: 255.153.0
|
|---|
| 257 | outline-light: 204.204.204
|
|---|
| 258 | outline-dark: 136.136.136
|
|---|
| 259 | ]
|
|---|
| 260 |
|
|---|
| 261 | sizes: construct/with either exists? %ui.dat [pick load %ui.dat 6] [[]] make object! [
|
|---|
| 262 | cell: 4
|
|---|
| 263 | edge: 1
|
|---|
| 264 | font: 12 ; pt size
|
|---|
| 265 | font-height: none ; pixel height - set by widget init code
|
|---|
| 266 | gap: 2
|
|---|
| 267 | line: cell * 5
|
|---|
| 268 | margin: 4
|
|---|
| 269 | slider: cell * 4
|
|---|
| 270 | ]
|
|---|
| 271 |
|
|---|
| 272 | behaviors: construct/with either exists? %ui.dat [pick load %ui.dat 9] [[]] make object! [
|
|---|
| 273 | action-on-enter: [drop-list edit-list field password spinner]
|
|---|
| 274 | action-on-tab: [field]
|
|---|
| 275 | caret-on-focus: [area]
|
|---|
| 276 | cyclic: [group-box panel sheet tab-panel]
|
|---|
| 277 | hilight-on-focus: [edit-list field password spinner]
|
|---|
| 278 | tabbed: [area button drop-list drop-tree edit-list field grid password spinner]
|
|---|
| 279 | ]
|
|---|
| 280 |
|
|---|
| 281 | effects: construct/with either exists? %ui.dat [pick load %ui.dat 12] [[]] make object! [
|
|---|
| 282 | arrows-together: false
|
|---|
| 283 | radius: 5
|
|---|
| 284 | font: either font? "arial" ["verdana"] [font-sans-serif]
|
|---|
| 285 | fonts: sort reduce [font-sans-serif font-fixed font-serif "verdana"]
|
|---|
| 286 | splash-delay: 1
|
|---|
| 287 | tooltip-delay: 0:00:01
|
|---|
| 288 | webdings: font? "webdings"
|
|---|
| 289 | window: none
|
|---|
| 290 | ]
|
|---|
| 291 |
|
|---|
| 292 | on-fkey: make object! [
|
|---|
| 293 | f1: f2: f3: f4: f5: f6: f7: f8: f9: f10: f11: f12: none
|
|---|
| 294 | ]
|
|---|
| 295 |
|
|---|
| 296 | #include %rebgui-edit.r
|
|---|
| 297 | #include %rebgui-widgets.r
|
|---|
| 298 | #include %rebgui-layout.r
|
|---|
| 299 | #include %rebgui-requestors.r
|
|---|
| 300 | #include %rebgui-functions.r
|
|---|
| 301 |
|
|---|
| 302 | remove-each font effects/fonts [not font? font] ; remove invalid font names
|
|---|
| 303 | set-locale none ; set locale
|
|---|
| 304 | insert tail words next find first widgets 'choose ; add widget names to words
|
|---|
| 305 | ]
|
|---|
| 306 |
|
|---|
| 307 | system/view/screen-face/feel: none ; kill global events system (used by 'insert-event-func)
|
|---|
| 308 | open-events ; needed in case we are running from rebface / enface
|
|---|
| 309 | recycle ; free unused memory |
|---|
