rebol [ title: "GLayout demo" file: %glayout-demo.r version: 0.9.1 author: "Maxim Olivier-Adlhoch" date: 2006-11-17 purpose: "Demonstration of GLayout's features and capabilities." library: [ level: 'beginner platform: 'all type: 'demo domain: [ gui ui user-interface vid graphics] tested-under: [win view 1.3.2 sdk 2.6.2] support: "http://www.pointillistic.com/open-REBOL/moa/steel/glayout/glayout-demo.html" license: 'MIT see-also: "glayout.r" ] ] no-do-quit: func [][ request/ok "I QUIT! ...^/ I needs some files from the net which where not downloaded." quit ] ;--------------------------------------------- ; GET BASE FILES FOR TESTING END-USERS ;--------------------------------------------- if all [ not value? 'slim not exists? %slim.r ][ either request/confirm "SLiM not found. Download it from Rebol.org?" [ either request/confirm join "it will be saved as: " to-local-file join clean-path what-dir "slim.r" [ request-download/to http://www.rebol.org/cgi-bin/cgiwrap/rebol/download-a-script.r?script-name=slim.r %slim.r ][ no-do-quit ] ][ no-do-quit ] ] ; start slim for the rest... ; if user installed a local copy of slim for this test if exists? %slim.r [ do %slim.r ] ; at this point slim is operational unless slim/open 'glayout 0.5.4 [ either confirm "GLayout not found or is not up to date. Download it from Rebol.org?" [ either request/confirm join "it will be saved as: " to-local-file join clean-path what-dir "glayout.r" [ request-download/to http://www.rebol.org/cgi-bin/cgiwrap/rebol/download-a-script.r?script-name=glayout.r %glayout.r ][ no-do-quit ] ][ no-do-quit ] ] slim/vexpose voff unless slim/find-path %glayout.r [ no-do-quit ] ;--------------------------------------------- ; APPLICATION START ;--------------------------------------------- gl: slim/open 'glayout none ;- PANES ;- default-pane default-pane: gl/layout/pane [ column [ elastic header "welcome to GLayout Demo" vtext as-is "This is a very simple overview of many of GLayout's capabilities" vtext as-is "There will be more added as time permits, but at least, for now" vtext as-is "you know a bit of what it can do out of the box." spacer 30 vh3 "Select items in the menu to start your tour" spacer 15 hitext "(Note that menu bug is now fixed :-)" elastic ] ] ;- prefs-pane prefs-pane: gl/layout/pane [ column [ row [ vtext "Enables/disables GLayout's indented console printing" elastic ] row [ rvtext "verbosity: " min-size 100 column [ filler vpane [ check false [either value [gl/von slim/von von][print "OFF" slim/voff gl/voff voff]] ] filler ] elastic ] elastic ] ] ;- inspector-pane inspector-pane: gl/layout/pane [ scrollpane [ column [ spacer 15 header "the GLayout inspector" spacer 15 lvtext "The inspector is a requestor which allows you to scan and browse native rebol values" lvtext "It uses a Finder-type interface and allows you to go into objects and blocks" lvtext "there are still a few minor bugs, like hitting unset! values but, its already very usefull" lvtext "(browsing system/words will always crash it, so don't)" spacer 30 vtext "take a test spin!" insp-fld: field "system/view" row [ button corner 2 "system/view"[insp-fld/text: copy face/text show insp-fld] button corner 2 "system/script"[insp-fld/text: copy face/text show insp-fld] button corner 2 "slim" [insp-fld/text: copy face/text show insp-fld] button corner 2 "slim/libs/GLayout" [insp-fld/text: copy face/text show insp-fld] ] spacer 15 row [ elastic button "inspect!" gold [try [do compose [gl/request-inspector/title (load insp-fld/text) (insp-fld/text)]]] elastic ] elastic ] ] ] ;- snapshot-pane snapshot-pane: gl/layout/pane [ scrollpane [ column [ spacer 15 header "Integrated Gui snapshot, cropping and saving" spacer 15 lvtext "GLayout helps you in making your docs." lvtext "You can snapshot any currently viewed window, live, by hitting Shift-F8" lvtext "You can also snapshot a face or pane, under the cursor, live, by hitting Ctlr-Shift-F8" lvtext "for now those keys are hard-coded, but this can be very easily changed, even by you." spacer 30 header "Window Title" lvtext "Unless you pressed Ctrl, GLayout will ask you for a window title, which will be" lvtext "automatically added to the layout in the next step (cropping), to make it resemble" lvtext "a plain OS-independent window." spacer 30 header "Cropping" lvtext "when the snapshot requestor appears, you are greeted with a resizeable window." lvtext "the portion of the image you actually see, is the portion which will be saved out!" lvtext "so with very simple resize, and scrolling of the gui, you can zero in on a part" lvtext "of the GUI or a specific gadget!" spacer 30 header "Saving" lvtext {Once you press "save", a file browser will appear, allowing you to place a .png image} lvtext {anywhere on your disk. A current limitation, is that you MUST add ".png" extension } lvtext {yourself, cause GLayouts won't. You can only save in PNG format for now.} spacer 30 header "go ahead, press Shift-F8" elastic ] ] ] ;- reqs-pane reqs-pane: gl/layout/pane [ scrollpane [ column [ spacer 15 vh3 "Prebuilt requestors" spacer 30 vtext "Although adding your own requestors, popup and modal dialogs in glayout is dead easy" vtext "we have cooked up a few of them for you." ] ] ] ;- labels-pane ;labels-pane: gl/layout/pane [ labels-pane: [ scrollpane [ column [ spacer 15 vh3 "Label styles:" spacer 30 banner "Banner" header "Header" vh3 "vh3" grp-text "grp-text" text "text" wtext "wtext" vtext "vtext" lvtext "lvtext" rvtext "rvtext" elastic ] ] ] ;- buttons-pane ;buttons-pane: gl/layout/pane [ buttons-pane: [ scrollpane [ column [ spacer 15 vh3 "Button styles:" spacer 30 header left "button:" vtext "corner control:" row [ button corner 12 "12" shrink button corner 9 "9" shrink button corner 5 "5" shrink button corner 4 "4" shrink button corner 3 "3" shrink button corner 2 "2" shrink button corner 1 "1" shrink ] spacer 20 vtext left "outline color control:" row [ button "default" button gold "gold" button red "red" button blue "blue" ] spacer 20 vtext left "deep color control:" row [ button gold deep "gold" button red deep "red" button blue deep "blue" button black deep "black" ] spacer 20 vtext left "mix and match:" row [ button gold white "gold white" button red gold "red gold" button blue black "blue black" button black gray "black gray" ] spacer 50 header left "btn:" row [ btn "btn" btn gold "btn gold" btn 200.200.200 "btn 200.200.200" ] spacer 30 elastic ] ] ] ;- popups-pane ;popups-pane: gl/layout/pane [ popups-pane: [ scrollpane [ column [ spacer 15 vh3 "Popup styles" header left "Drop-down menus" hform [ menu-choice "Menu-choice 1" ["one" "two" separator "three" "four" ["submenu" "AAA" "BBB" "CCC"]] [gl/inform join "Selected: " data] menu-choice "Menu-choice 2" ["one" "two" separator "three" "four" ["submenu" "AAA" "BBB" "CCC"]] [gl/inform join "Selected: " data] menu-choice "Menu-choice 3" ["one" "two" separator "three" "four" ["submenu" "AAA" "BBB" "CCC"]] [gl/inform join "Selected: " data] menu-choice "Menu-choice 4" ["one" "two" separator "three" "four" ["submenu" "AAA" "BBB" "CCC"]] [gl/inform join "Selected: " data] ] spacer 30 header left "choice" vtext "just choose the top choices, to see compound effects on bottom choice:" row [ choice "Color: " ["white" "gold" "red" "blue" "green" "black" ] font [] [ face/color: do load data face/refresh pop-chc/color: face/color pop-chc/refresh ] choice "Font: " ["white" "gold" "red" "blue" "green" "black" ] font [] [ face/font/color: do load data face/refresh pop-chc/font/color: face/font/color pop-chc/refresh ] choice "Outline: " ["white" "gold" "red" "blue" "green" "black"] font [] corner 10 with [outline: white] [ face/outline: do load data face/refresh pop-chc/outline: face/outline pop-chc/refresh ] ] pop-chc: choice font [] "result: " ["looks good" "I like it :-)" "GLayout?"] [gl/inform data] elastic ] ] ] ;- toggles-pane ;toggles-pane: gl/layout/pane [ toggles-pane: [ scrollpane [ column [ spacer 15 vh3 "Toggle styles" spacer 30 header left "toggle text" vpane [ cl: vblack [ toggletext "one" tgl: toggletext "two" toggletext "three" ] ] spacer 10 header left "Check marks" row [ vtext right "check 1" center [check ] vtext right "check 2" shrink center [check true ] ;row [ vtext right "check 3 (in a pane)" ;column [filler vpane [check] filler] center[hpane [check edge [size: 1x1]]] filler ;] ] elastic ] ] ] ;- field-pane ;field-pane: gl/layout/pane [ field-pane: [ scrollpane [ column [ spacer 15 vh3 "Field styles" spacer 30 header left "fields" field "field" spacer 10 field blue "blue field" spacer 10 vtext left "corner control:" row [ field 30 corner 10 "10" field 30 corner 5 "5" field 30 corner 2 "2" field 30 corner 1 "1" ] vtext {Field with input filter (america phone number: ###-###-####)} tel-fld: field spacer 30 header left "text area" text-area def-size 200x100 "Text-area" elastic ] ] ] ;- groups-pane ;groups-pane: gl/layout/pane [ groups-pane: [ scrollpane [ row [ column [ spacer 15 vh3 "Group styles:" spacer 30 row [header def-size 100 "center (new!)" lvtext elx "Centers content." ] vtext left "Inner-margins support for stretchy content (here its 100x10)" center margins 100x10 edge gl/black-edge [ column [ field row [ button "1" button "2" button "3" ] ] ] vtext left "Centers static content. (still offers margins)" center margins 100x10 edge gl/black-edge [ canvas "100x100 canvas" edge gl/red-edge 100x100 ] spacer 20 row [header def-size 100 "row" lvtext elx "borderless horizontal group:" ] row [button "1" button "2" button "3"] spacer 20 row [header def-size 100 "column" lvtext elx "borderless vertical group:" ] column [ button "1" button "2" button "3"] spacer 20 row [header def-size 100 "hpane" lvtext elx "inset horizontal group:" ] hpane [ button corner 2 "1" button corner 2 "2" button corner 2 "3"] spacer 20 row [header def-size 100 "vpane" lvtext elx "inset vertical group:" ] vpane [ button corner 2 "1" button corner 2 "2" button corner 2 "3"] spacer 20 row [header def-size 100 "hform" lvtext elx "outset horizontal group:" ] hform [ button corner 2 "1" button corner 2 "2" button corner 2 "3"] spacer 20 row [header def-size 100 "vform" lvtext elx "outset vertical group:" ] vform [ button corner 2 "1" button corner 2 "2" button corner 2 "3"] spacer 20 row [header def-size 100 "hblack" lvtext elx "horizontal black-edged group:" ] hblack [ button corner 2 "1" button corner 2 "2" button corner 2 "3"] spacer 20 row [header def-size 100 "vblack" lvtext elx "vertical black-edged group:" ] vblack [ button corner 2 "1" button corner 2 "2" button corner 2 "3"] spacer 20 row [header def-size 100 "nesting" lvtext elx "All groups can be nested indefinitely:" ] vpane [ banner "horizontal:" hform [ vpane [ banner "vertical:" button "1" corner 2 button "2" corner 2 button "3" corner 2 ] vpane [ banner "vertical:" hpane [ banner "horizontal:" button "1" hshrink corner 2 button "2" hshrink corner 2 button "3" hshrink corner 2 ] hpane [ banner "horizontal:" button "1" hshrink corner 2 button "2" hshrink corner 2 button "3" hshrink corner 2 ] ] ] ] spacer 20 row [header def-size 100 "scrollpane" lvtext elx "automatic scrollable container:" ] scrollpane def-size 100x100[ row [ column [ button "1" button "2" button "3" button "5" button "6" elastic ] column [ button "1" button "2" button "3" button "5" button "6" elastic ] column [ vtext "Use mouse scrollwheel to scroll this scrollgroup" vtext "Advanced algorythm, adapts scroll speed to content vs viewable" hitext "Adjust X window size and scrollbars will disapear" vtext "No default edges allow you to easily control visuals to what you need." hitext "Note how scrollwheel support works even if panes are nested" hitext "(the group styles viewer is within a scrollpane)" vtext "note how resizing the window keeps scroller's position as much it can" hitext "shift-clicking while using scrollwheel will nudge one pixel at a time" vtext "Note that even due to the amount of graphic heavy gadgets in this group " vtext "(draw using buttons) the scrolling is real time" elastic ] column [ button "1" button "2" button "3" button "5" button "6" elastic ] column [ button "1" button "2" button "3" button "5" button "6" elastic ] ] ] spacer 20 elastic ] spacer 15 ] ] ] ;- others-pane ;others-pane: gl/layout/pane [ others-pane: [ scrollpane [ column [ spacer 15 vh3 "Other styles:" spacer 20 row [ spacer 15 column [ row [ header "scroller" elastic ] row [ scroller ] vtext "with a little VID styling:" hpane [ scroller edge [color: black] ] spacer 30 row [ header "progress" elastic ] progress with [data: 0.33 rate: 2] feel [ engage: func [ face action event ][ if action = 'time [ face/data: face/data + 0.01 if face/data > 1 [face/data: 0] show face ] ] ] spacer 30 row [ header "filebox" elastic ] fbx-path: lvtext to-string clean-path what-dir hpane [ vblack [ fbx-scroll: scrollpane def-size 200x200 [ column [ fbx: filebox browse-path what-dir do [ fbx/browse-callback: func [fb-pane][ vin "browse-callback()" fbx-scroll/refresh fbx-path/text: rejoin [to-string clean-path fbx/current-dir] show fbx-path vout ] ] ] ] ]] row [ button "root" [fbx/browse-path/update %/] button "up" [fbx/browse-path/update 'parent] ] spacer 20 ] spacer 15 ] ] ;elastic ] ] styles-list: ["labels" "buttons" "fields" "toggles" "groups" "popups" "others"] ;- styles-pane style-panes: [ "labels" [labels-pane] "buttons" [buttons-pane] "fields" [field-pane] "toggles" [toggles-pane] "groups" [groups-pane] "popups" [popups-pane] "others" [others-pane] ] style-panes: reduce [ "labels" labels-pane "buttons" buttons-pane "fields" field-pane "toggles" toggles-pane "groups" groups-pane "popups" popups-pane "others" others-pane ] styles-pane: gl/layout/pane [ ;row [ ;button hshrink deep gold corner 2 "<" [ gui-pane-choice/select slide-gadget-pane/prev ] ;button hshrink deep gold corner 2 ">" [gui-pane-choice/select slide-gadget-pane/next ] ;gui-pane-choice: choice elx min-size 150 "Pane: " styles-list [switch-gadget-pane data] ;] stylespad: switchpad style-panes corner 4 ;spacer 5 ;pane-types: column def-size 500x200 [elastic] ] gl/assign-key-event-callback tel-fld [ face event ][ ;prin event/key idx: index? system/view/caret new-string: head insert at copy face/text idx event/key digit: charset [#"0" - #"9" #"#"] threes: [ 1 3 digit ] fours: [1 4 digit ] parse-rule: [ ; (###)###-#### [ "(" 0 1 [ threes 0 1 [")" 0 1 [threes 0 1 ["-" 0 1 fours ]]]]] | ; ###-###-#### [ threes "-" threes "-" 0 1 fours] | ; ###-#### [threes "-" 0 1 fours] | ; ### [ threes] ; just simplifies above rules... ] if any [ ignore: (either (error? err: try [ result: parse/all new-string [parse-rule]]) [ rule-area/colors: reduce [black black] rule-area/font: make face/font [color: white] show rule-area false ][ result ]) ignore: found? find [#"^M" #"^-" up down left right home end #"^~" #"^H"] event/key event/key = #"^[" ][ unless ignore [ unfocus face ] ] not ignore ] cl/select tgl show cl ;- ;- GUI funcs ;-------------------- ;- req-demos() ;-------------------- req-demos: func [ "" type [string!] ][ vin/tags ["req-demos()"] [req-demos] switch type [ "confirm" [ gl/request-confirm/title/buttons/auto-enter "This is a request-confirm type modal dialog." ["ok" "not ok" "doh!"] "not ok" gl/request-confirm/title/label/buttons/auto-enter "title has its own refinement!" "You can edit all text, auto enter button, and buttons" ["not" "don't" "no" "never" "cancel" "escape"] "not" ] "inform" [gl/inform "Inform: ultra basic modal dialog"] "file..." [val: gl/request-file/title/path "select file:" "select-file:" %/ gl/inform rejoin ["selected: " val]] "text" [gl/request-text/auto-enter "enter some text:"] "error" [gl/request-error/help "your error title" "001" "Error description which can span multiple lines^/^/The help button below, is an option you can specify ^/to which you assign an action, which is run when the button is pressed.^/Using browse to open your tool's online docs or opening a help pane, for example." "ok label" [browse http://www.pointillistic.com/open-REBOL/moa/steel/]] ] vout/tags [req-demos] ] ;-------------------- ;- switch-toolbox() ;-------------------- switch-toolbox: func [ tool [string! none!] ][ vin/tags ["switch-toolbox()"] [switch-toolbox] toolbox/pane: switch/default tool [ "gadget types" [styles-pane] "popups" [popups-pane] "prefs" [prefs-pane] "gui snapshots" [snapshot-pane] "inspector" [inspector-pane] ][ default-pane ] gui/refresh vout/tags [switch-toolbox] ] ;-------------------- ;- slide-gadget-pane() ;-------------------- slide-gadget-pane: func [ "" /next /prev /local pane ][ vin/tags ["slide-gadget-pane()"] [slide-gadget-pane] pane: gui-pane-choice/value if none? pane [ pane: skip tail style-panes -2 ] if any [prev next ][ if pane: find style-panes pane [ if next [ pane: skip pane 2 if tail? pane [ pane: head pane ] ] if prev [ if head? pane [ pane: tail pane ] pane: skip pane -2 ] ] ] if block? pane [ pane: pick pane 1 ] vout/tags [slide-gadget-pane] pane ] ;-------------------- ;- switch-gadget-pane() ;-------------------- switch-gadget-pane: func [ "" pane [string! none! word!] /local panes prev next ][ vin/tags ["switch-gadget-pane()"] [switch-gadget-pane] vprobe pane stylespad/select pane ;pane-types/pane: switch pane style-panes ;gui/refresh vout/tags [switch-gadget-pane] ] ;-------------------- ;- next-style-pane() ;-------------------- next-style-pane: func [ "" ][ vin/tags ["next-style-pane()"] [next-style-pane] vprint gui-pane-choice/value vout/tags [next-style-pane] ] ;-------------------- ;- menu-handler() ;-------------------- menu-handler: func [ "" selection /local pane val ][ vin/tags ["menu-handler()"] [menu-handler] selection: next parse/all selection "/" vprobe remold ["Selected: " selection] ;probe selection switch selection/1 [ "features" [ switch selection/2 [ "requestors" [ req-demos selection/3 ] "inspector" [ switch-toolbox "inspector" ] "gadget types" [ switch-toolbox "gadget types" ] "Gui snapshots" [ switch-toolbox "gui snapshots" ] ] ] "styles" [ switch-toolbox "Gadget Types" stylespad/select selection/2 ] "help" [ switch selection/2 [ ; "pane" [ ; vprint "I WILL SWITCH PANE!" ; ;switch-toolbox selection/3 ; gui-pane-choice/select selection/3 ; ] "prefs" [ switch-toolbox "prefs" ] "splash screen" [ switch-toolbox none ] "about..." [ gl/view/modal/center [ column [ header "about..." vpane [ vblack [ lvtext rejoin ["GLayout version: " gl/header/version] lvtext rejoin ["Demo version: " system/script/header/version] hitext para [wrap?: true] "Note that this window is modal, just like a dialog" hitext para [wrap?: true] "This allows you to easily make your own dialogs, using" hitext para [wrap?: true] "the same GLayout dialect, only add /modal to the 'view call." vtext para [wrap?: true] "Also note that this modal window is resizable" ] ] elastic spacer 10 row [ elastic button "close" [hide-popup] elastic ] spacer 10 ] ] ] ] ] ] vout/tags [menu-handler] ] ;- ;- MAIN GUI gui: gl/view/center compose/deep [ column [ hform gray effect [gradient 0x1 (gray * 1.4) (gray * 1.15) ] [ project-menu: menu-choice effect [gradient 0x1 (gray * 1.4) (gray * 1.15) ] "Features" [["Requestors" "confirm" "inform" "file..." "text" "error" ] "GUI snapshots" "Inspector"] [menu-handler data] menu-choice "styles" [ (styles-list) ][menu-handler data] edit-menu: menu-choice "help" [ "about..." "splash screen" separator "prefs" ][menu-handler data] ;pane-menu: menu-choice "Panes" styles-list elastic [color: none] ] spacer 5 row [ spacer 5 ;vpane [ ;vblack [ toolbox: column def-size 550x300 [] ; ] ; ] spacer 5 ] spacer 5 row [ ; vtext "Take the tour" ; hpane [ ; button hshrink corner 2 "<" ; button hshrink corner 2 ">" ; ] ; vtext hshrink "next: " ; hitext hshrink left "styles" elastic hpane [ button corner 2 "Quit" [quit] ] spacer 20 ] spacer 5 ] ] ;switch-toolbox "Gadget Types" switch-toolbox none ;gui/refresh ; styles-pane/pane/1/refresh do-events