Scrolling Views

Scrolling Views - by Bo

Here is a handy function (with examples) that may help you or others make scrolling views easier. Last I heard VID was going to get scrolling built in by default, but until then this function can be used.

    Title:  "Automated scrolling"
    Date:   22-Dec-2000
    Author: "Bohdan Lechnowsky"
    File:   %scroll-face.r
    Version: 1.0.0
    Purpose: {
        Demonstrates a way to write a scrollable face.
    Comments: {
        This is a generalized function with 100% environmentally-friendly
        local variables.  It can operate on any number of scrollable 
        windows in the same main face--even scrollable windows nested
        inside other scrollable windows--as the example shows.
    History: [
        0.9.0   ["Initial concept explored" "Bohdan Lechnowsky"]
        0.9.1   ["Tweaks" "Bohdan Lechnowsky"]
        1.0.0   ["Fully working version" "Bohdan Lechnowsky"]
        1.1.0   ["Added arrows and size option plus minor mods" "Bohdan Lechnowsky"]
        1.1.1   ["Bug fix with local variable" "Bohdan Lechnowsky"]
        1.1.2   ["Another bug fix with local variable" "Bohdan Lechnowsky"]

scroll-face: func [
    {Returns vertically scrollable version of input face.}
    at      {Face to attach scroll-face bar to}
    v       {Visible size of the attach-to face}
    /arrows {Include up and down arrows}
    /size   {Change size of scroll bar/arrows}
    s       {New size for scroll bar/arrows}
    /local l a f
    if not size [s: 16]
    l: layout/offset [
        backdrop 0.0.0
        at 0x0
        space 0
        size (v + (s * 1x0))
        box (v)
        slider (v * 0x1 + (s * 1x0)) []
    ] 0x0

    if arrows [
        l/pane/3/size/y: l/pane/3/size/y - (s * 2)
        arrow: layout/offset [
            arrow up (s * 1x1) [
                f: face/parent-face/pane
                f/2/offset/y: min 0 f/2/offset/y + 15
                f/3/data: negate f/2/offset/y / (f/2/size/y - v/y)
                show face/parent-face
            arrow down (s * 1x1) [
                f: face/parent-face/pane
                f/2/offset/y: max v/y - f/2/size/y f/2/offset/y - 15
                f/3/data: negate f/2/offset/y / (f/2/size/y - v/y)
                show face/parent-face
        ] 0x0
        arrow/pane/1/offset: l/pane/3/offset * 1x0 + (l/pane/3/size * 0x1)
        arrow/pane/2/offset: l/pane/3/offset * 1x0 + (l/pane/3/size * 0x1 + (s * 0x1))
        append l/pane arrow/pane
l/pane/2: at
l/pane/3/action: func [f a] compose [
    f/parent-face/pane/2/offset/y: (negate at/size/y - v/y) * f/data
    show f/parent-face
l/pane/3/redrag v/y / at/size/y

; Simple example (JOL):

view scroll-face/arrows/size layout/offset [text "system/view/VID/vid-styles" 300 txt mold system/view/VID/vid-styles 300 as-is] 0x0 300x500 25

; Another easy example:

e: func [t][request/ok rejoin ["Thank you for selecting button " t "!"]]

ee: [e face/text]

f: layout [
txt "Please select a button"
button "A" ee
button "B" ee
button "C" ee
button "D" ee

view scroll-face f 180x100

; Nested scroller example:

f1: layout/offset [at 0x0 txt system/license 300 as-is] 0x0
f2: layout/offset [at 0x0 txt mold system/options 300 as-is] 0x0

g: scroll-face/arrows/size f1 300x150 10
h: scroll-face/arrows/size f2 300x150 10

i: layout/offset [backdrop black size 340x340 box 300x150 box 300x150] 0x0

i/pane/2: g
i/pane/3: h
i/pane/2/offset: 10x10
i/pane/3/offset: 10x170

view scroll-face/arrows/size i 340x150 50


Scrolling Views - by Jeff

[Jeff's replying to Bo]

Neat function you got there. After looking at it, I decided I'd make a similar function this afternoon, that would attach both horizontal and vertical scroll bars to a given face but only when the face is larger in either respective dimension than the declared visible area. I noticed that your version increased the face in size when adding the scrollers. Keeping the face constrained allows me to throw any given face at the function and it will do the right thing; so a face that may grow at some point can be sent in when as it grows, and when it is beyond the preset visible range scroll bars are automatically added, but still fitting where it used to go as seen in the second included example.

This is a rather gonzo example of meta-programming VID, (and the readability suffers somewhat) but it allows for a symmetric, low redundancy of methods approach to the problem.

    Title:  "Add Sliders when necessary"
    Author: "Jeff Kreis"
    Version: 0.0.1
    Purpose: {
        Adds Horizontal and Vertical scroll bars when necessary
        to a face, depending on the amount that is visible. 
        Constrains face to a specific size.
    Comments: "Meta-programming VID. Styles. Layout called only once."
slar: stylize [
    sl: slider [face/user-data/1/offset: fract-pair face show face/user-data/1]
    arr: arrow [push-scroll face] it: box with [set [font para edge] none]
scroll-face: func [
    {Returns version of input face with vert or horiz scroll if needed.}
    at      [object!]  {Face to attach scroll bars to}
    viz     [pair!]    {Visible size of final face}
    /arrows            {Include arrows}
    /size              {Size of scroll bar/arrows}
    siz     [integer!] {New width for scroll bar/arrows}
    /local l slr slu ra la ua da as sx sy vx vy x
    xper yper xoff yoff hsiz vsiz sz2 b1 aru arl
    fract-pair: func [face /local o f2 f3 fd c][
        set [o f2 f3] face/user-data o: o/offset fd: to-integer f2 * face/data
        pick reduce [c: repair [pick reduce [o/x o/y] f3 fd] reverse c] f3
    push-scroll: func [face /local s1 s2 f][
        set [s1 s2] face/user-data f: s1/user-data/1                
        s1/data: min 1.0 max 0.0 s1/data + switch face/data [
            up [- s2] down [s2] right [s2] left [- s2]
        ] f/offset: fract-pair s1 show [s1 f]
    repair: func [x][to-pair reduce x]

    sz2: any [all [arrows any [siz 16]] 0] siz: any [siz 16] 
    set [vx vy sx sy] reduce [viz/x viz/y at/size/x at/size/y] 
    set [xper yper xoff yoff] reduce [vx / sx vy / sy vx - sx vy - sy]
    if (not sx: xoff < 0) and (not sy: yoff < 0) [return at]
    ua: any [all [sy vsiz: repair [siz (-2 * sz2)+ vy: either sx [vy - siz][vy]]
            vx: vx - siz copy [return slu: sl vsiz]][]] 
    ra: any [all [sx hsiz: repair [vx - (2 * sz2) siz]
            vy: either sy [vy][vy - siz] copy [across slr: sl hsiz]][]]
    viz: repair [vx vy]
    if arrows [ 
        x: reduce ['arr 1x1 * siz]
        foreach [s d] reduce [
            ua [ua: (x) up da: (x) down] ra [ra: (x) left la: (x) right] 
        ][if not empty? s [insert tail s compose d]]
    l: layout/origin compose [styles slar space 0 b1: it (viz)(ua)(ra)] 0x0
    b1/pane: at l/offset: at/offset: 0x0 aru: [slu yper] arl: [slr xper] 
    foreach [item go] reduce [
        slu [at yoff 1] slr [at xoff 2] ua aru da aru la arl ra arl
    ][if object? item [set in item 'user-data reduce go]] 
    all [slr slr/redrag xper] all [slu slu/redrag yper] 
    return l

;-- Some silly examples:
f: layout [ origin 0x0 space 0 size 200x200 box 
    red box blue return box yellow box green]
foreach s [100x200 200x100 100x100][
    view/offset scroll-face f s 140x130 

;-- A growing face: 
g: next first system/words
f: layout [
    backdrop 240.210.140
    h1 "Growing text:"
    t: box 200x200
    button "Add 20 words" [
        loop 20 [
            append tt/text reform [g/1 " "]
            if tail? g: next g [g: next head g]
        ] tt/size: 184x0 + (0x1 * size-text tt)
        t/pane: scroll-face/arrows tt 200x200
        show [t tt]
t/pane: tt: make face [
    edge: none size: 200x200 text: "System/words: ^/" 
    font: make font [align: [justify]]
    color: 240.210.140
view f