;; =================================================== ;; Script: simple-vid-resizing.r ;; downloaded from: www.REBOL.org ;; on: 28-Mar-2024 ;; at: 9:33:28.350338 UTC ;; owner: luce80 [script library member who can update ;; this script] ;; =================================================== REBOL [ Title: "Simplified VID resizing" Date: 21-05-2020 Version: 1.5.2 File: %simple-vid-resizing.r Author: "Marco Antoniazzi" Rights: "Copyright (C) 2015 Marco Antoniazzi" Purpose: "Helps create resizing VID guis" eMail: [luce80 AT libero DOT it] History: [ 1.0.0 [15-08-2013 "First version"] 1.0.1 [16-08-2013 "Changed case/all with switch/all"] 1.0.2 [21-10-2013 "Adapted to R3 (with vid1r3.r3)"] 1.1.0 [22-12-2014 "changed resize-deep to resize-faces"] 1.2.0 [24-01-2015 "fixed R2 pair! rounding errors, reduced resizer block"] 1.2.1 [24-07-2015 "added win-resizer"] 1.2.2 [10-04-2016 "fixed insert-event-func"] 1.2.3 [09-08-2018 "added code to avoid doing examples"] 1.2.4 [14-08-2018 "added FIXMEs and UPDATEd comment"] 1.2.5 [16-05-2020 "fixed by calling also resize-face"] 1.3.0 [17-05-2020 "added 'move and 'resize followed by pair! or number!s"] 1.4.0 [17-05-2020 "added panel's propagation"] 1.5.1 [19-05-2020 "added bonus align and stretch functions"] 1.5.2 [21-05-2020 "removed view hack"] ] Help: { I have noticed that in many of my resizable guis there are only a few widgets that move or change size when the window is resized and they move or change size only to "follow" the window borders. In these situations the resizing algorithm is very simple and so I have created this "patch" to let you create resizable guis in a very simple way. Use the words: move-x, move-y, move-xy, resize-x, resize-y, resize-xy in a layout block to let a widget movement or dimensioning "follow" the window borders. Use: resize [ ] to set multiple values. Note that you can use any number inside the block You can alse use 'move or 'resize followed by a pair! or one or two number!s You can also make a "second pass" using the functions and to adjust faces positions and size to have them align to each other. } Category: [util vid view] library: [ level: 'intermediate platform: 'all type: 'how-to domain: [gui vid] tested-under: [View 2.7.8.3.1 Atronix-View 3.0.0.3.3] support: none license: 'BSD see-also: none ] comment: "2-Sep-2012 GUI automatically generated by VID_build. Author: Marco Antoniazzi" ] ;**** please set correct path to vid1r3.r3 and sdk sources (or use empty string to use default path to sdk) **** if all [system/version > 2.9.0 not value? 'mimic-do-event] [do/args %../../r3/local/vid1r3.r3 %../../sdk-2706031/rebol-sdk-276/source] import*: func ["Loads and evaluates one or more module(s)" module [file! url! block!]][ ; using asterisk on name to avoid confusion with R3 version ; recursion is used to check datatype of every block's element either block? module [forall module [import* first module]][do load module] ] module: func [ title [string!] "MUST be given in literal (static) form" ctx [word!] "name of main context" code [block!] "Object variables and values. The module's code." examples [block!] "Code for test pourposes, not executed if script is loaded" ][ if not value? ctx [ set ctx context code ] if any [none? system/script/parent none? system/script/parent/header] [ context examples ] ] ; align, stretch align: func [ "Align face(s) to another face" where [word!] "One of: left center right top middle bottom" faces [object! block!] "The face(s) to move" face [object!] "The face to align to" /only "Move faces as a group" /window "The face to align to is a window" /pad offset [integer!] "Add an extra move after moving" /local what axis distance aface face-offset span ][ offset: any [offset 0] what: select [left 0 center .5 right 1 top 0 middle .5 bottom 1] where axis: select [left 1 center 1 right 1 top 2 middle 2 bottom 2] where if none? axis [to-error append "Wrong word: " where] faces: reduce compose [(faces)] face-offset: either window [0][face/offset/(axis)] either only [ span: span? faces span/2: span/2 - span/1 distance: face/size/(axis) - span/2/(axis) * what + face-offset - span/1/(axis) foreach aface faces [ aface/offset/(axis): aface/offset/(axis) + distance + offset ] ][ foreach aface faces [ aface/offset/(axis): face/size/(axis) - aface/size/(axis) * what + face-offset + offset ] ] ] stretch: func [ "Resize a face from a border to reach the border of another face" from [word!] "One of: left right top bottom" from-face [object!] "The face to resize" to [word!] "One of: left center right top middle bottom" to-face [object!] "The face to reach" /pad offset [integer!] "Add an extra size after resizing" /local axis ][ offset: any [offset 0] axis: select [left 1 center 1 right 1 top 2 middle 2 bottom 2] to if none? axis [to-error append "Wrong word: " to] to: select [left 0 center .5 right 1 top 0 middle .5 bottom 1] to to: to-face/size/(axis) * to + to-face/offset/(axis) + offset axis: select [left 1 right 1 top 2 bottom 2] from if none? axis [to-error append "Wrong word: " from] switch from [ left top [ from-face/size/(axis): from-face/size/(axis) + from-face/offset/(axis) - to from-face/offset/(axis): to ] right bottom [from-face/size/(axis): to - from-face/offset/(axis)] ] ] ; module "Simplified VID resizing" 'resizer-ctx ;if not value? 'resizer-ctx [ ; avoid redefinition ;resizer-ctx: context [ resize-faces: func [face [object!] siz [pair!] /local decis][ ; FIXME: if window is maximized [return] if block? get in face 'pane [ foreach face face/pane [ if attempt [face/feel/resizer][ decis: face/feel/decis ; using to avoid rounding errors of R2 integer pair! if none? decis/1 [decis/1: face/offset/x] decis/1: decis/1 + (siz/x * face/feel/resizer/1) if none? decis/2 [decis/2: face/offset/y] decis/2: decis/2 + (siz/y * face/feel/resizer/2) face/offset: as-pair decis/1 decis/2 if none? decis/3 [decis/3: face/size/x] decis/3: decis/3 + (siz/x * face/feel/resizer/3) if none? decis/4 [decis/4: face/size/y] decis/4: decis/4 + (siz/y * face/feel/resizer/4) either in face 'resize [ face/resize as-pair decis/3 decis/4 ][ face/size: as-pair decis/3 decis/4 resize-face face as-pair decis/3 decis/4 ] ] ; recurse to propagate ; FIXME: should I pass new size difference? (But I have to store it somewhere ?) resize-faces face siz ] ] ] ; insert-event-func func [face event /local siz][ if event/type = 'active [ face: event/face face/data: face/size ] if event/type = 'resize [ face: event/face siz: face/size - face/data ; compute size difference face/data: face/size ; store new size resize-faces face siz show face ] event ] ; VID new facets insert tail svv/facet-words reduce [ 'move-x 'move-y 'move-xy 'resize-x 'resize-y 'resize-xy func [new args][ if none? new/feel [new/feel: make face/feel [decis: reduce [none none none none] resizer: copy [0 0 0 0]]] if not in new/feel 'resizer [new/feel: make new/feel [decis: reduce [none none none none] resizer: copy [0 0 0 0]]] switch/all first args [ move-x [new/feel/resizer/1: 1] move-y [new/feel/resizer/2: 1] move-xy [new/feel/resizer/1: 1 new/feel/resizer/2: 1] resize-x [new/feel/resizer/3: 1] resize-y [new/feel/resizer/4: 1] resize-xy [new/feel/resizer/3: 1 new/feel/resizer/4: 1] ] args ] 'move func [new args /local mvx mvy jump][ if none? new/feel [new/feel: make face/feel [decis: reduce [none none none none] resizer: copy [0 0 0 0]]] if not in new/feel 'resizer [new/feel: make new/feel [decis: reduce [none none none none] resizer: copy [0 0 0 0]]] mvx: pick args 2 mvy: pick args 3 jump: 1 case/all [ pair? mvx [ new/feel/resizer/1: mvx/1 new/feel/resizer/2: mvx/2 jump: 1 mvy: none ] number? mvx [ new/feel/resizer/1: mvx jump: 1 ] number? mvy [ new/feel/resizer/2: mvy jump: 2 ] ] skip args jump ] 'resize func [new args /local szx szy jump][ if none? new/feel [new/feel: make face/feel [decis: reduce [none none none none] resizer: copy [0 0 0 0]]] if not in new/feel 'resizer [new/feel: make new/feel [decis: reduce [none none none none] resizer: copy [0 0 0 0]]] jump: 1 either block? second args [ new/feel/resizer: copy reduce second args ][ szx: pick args 2 szy: pick args 3 case/all [ pair? szx [ new/feel/resizer/3: szx/1 new/feel/resizer/4: szx/2 jump: 1 szy: none ] number? szx [ new/feel/resizer/3: szx jump: 1 ] number? szy [ new/feel/resizer/4: szy jump: 2 ] ] ] skip args jump ] ] ] ;] ; value? ;do ; just comment this line to avoid executing examples [ ; if system/script/title = "Simplified VID resizing" [;do examples only if script started by us ; context [ ; avoid inserting names in global context do [flush_events: func [{12-May-2007 Anton Rolls}] [ ; Remove the event-port remove find system/ports/wait-list system/view/event-port ; Clear the event port of queued events while [pick system/view/event-port 1][] ; Re-add the event-port to the wait-list insert system/ports/wait-list system/view/event-port ]] ;do head remove back back tail load %simple\simple-win-resizer-style.r req-win: layout [ do [sp: 4x4] origin sp space sp style text text black feel none style btn btn 24x24 Across btn "<" btn ">" btn "^^" field resize-x arrow down white 24x24 move 1 btn "+" 252.223.44 move 1x0 return text-list 400x200 resize-xy return field 136 move 0x1 resize .5 0 text "Filter:" move .5 1 choice "All files (*.*)" "Rebol files (*.r)" 120 move .5 1 field 50 resize [.5 1 .5 0] return panel edge [size: 1x1] move-y resize 1 [ across btn "left" 125 resize .5 btn "right" 125 move .5 resize .5 ] return pad 0x10 check-line "Show hidden files" move-y btn "Select" 150 resize [0 1 .75 0] btn "Cancel" 50 resize [.75 1 .25 0] #"^(esc)" [unview] return ;sizer: win-resizer ;] sizer: box 21x21 move-xy edge [size: 1x1 effect: 'ibevel color: 128.128.128.50] effect [ draw [ line-width 1 pen 255.255.255.50 line 2x20 20x2 line 7x20 20x7 line 12x20 20x12 pen 128.128.128.50 line 3x20 20x3 line 8x20 20x8 line 13x20 20x13 ] ] feel [ engage: func [face action event /local rooto-face] [ if flag-face? face disabled [exit] if action = 'down [face/data: event/offset] if action = 'up [face/data: none] if all [face/data find [over away] action] [ flush_events face/offset: max (face/user-data) face/offset + event/offset - face/data rooto-face: find-window face rooto-face/size: face/offset + face/size show rooto-face ] ] ] ] ; second pass , try commenting these out to see the difference align/only 'right [req-win/pane/5 req-win/pane/6] req-win/pane/7 align 'middle req-win/pane/9 req-win/pane/10 align 'middle req-win/pane/13 req-win/pane/14 align 'center req-win/pane/12 req-win/pane/7 align/only 'right [req-win/pane/14 req-win/pane/15] req-win/pane/7 align/window 'right sizer req-win align/window 'bottom sizer req-win stretch 'right req-win/pane/4 'left req-win/pane/5 stretch 'right req-win/pane/11 'right req-win/pane/7 sizer/user-data: sizer/offset view/options req-win 'resize ; ] ; context ; ] ; if title ; A final note: this patch gives the opportunity to think about an other kind of sizing behaviour for guis. ; Normally in complex gui frameworks the widgets have: min-size, def-size, max-size and sometimes even ; hard-min-size and hard-max-size. These covers almost 100% of situations. ; But we could have a different situation (that I already use in many of my scripts) ; You build the gui in its minimum size, then you open the window in some default size (there is not a max size). ; This, with a resizing algorithm as the one presented here, covers 80% of situations. ; UPDATE: I could create 2 "fake" layouting panels: "row" and "column" . They will reposition children faces and ; possibly calculate the right "decis" and move them to the parent-face pane. Simple and effective ! ]