[ALLY] Scrolling Faces

From: philb:upnaway at: 27-Mar-2001 13:10

Hi list,

below is a minor modification to Bo's scroll-face.r to add horizontal scroll
bars.
Just replace the image %graph.png with an image larger than the siz variable
(400x400)

Cheers Phil

REBOL [
    Title:  "Automated scrolling"
    Date:   22-Dec-2000
    Author: "Bohdan Lechnowsky"
    Email:  [bo--rebol--com]
    File:   %scroll-face.r
    Version: 1.2.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"]
        1.2.0   ["Add horizontal Scroll Bar & Arrows" "Phil Bevan"]
    ]
]

scroll-face: func [
    {Returns vertically & horizontally scrollable version of input face.}
    at      {Face to attach scroll-face bar to}
    v       {Visible size of the attach-to face}
    /arrows {Include 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
        across
        space 0
        size (v + (s * 1x1))
        origin 0x0
        at 0x0
        box (v)
        slider (v * 0x1 + (s * 1x0)) []
        return
        at (v * 0x1)
        slider (v * 1x0 + (s * 0x1)) []
        at (v * 1x1)
        box gray (s * 1x1)
    ] 0x0

    if arrows
    [
        l/pane/3/size/y: l/pane/3/size/y - (s * 2)
        l/pane/4/size/x: l/pane/4/size/x - (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-lr: layout/offset
        [
            arrow left (s * 1x1) [
                f: face/parent-face/pane
                f/2/offset/x: min 0 f/2/offset/x + 15
                f/4/data: negate f/2/offset/x / (f/2/size/x - v/x)
                show face/parent-face
            ]
            arrow right (s * 1x1) [
                f: face/parent-face/pane
                f/2/offset/x: max v/x - f/2/size/x f/2/offset/x - 15
                f/4/data: negate f/2/offset/x / (f/2/size/x - v/x)
                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))

        arrow-lr/pane/1/offset: l/pane/4/offset * 0x1 + (l/pane/4/size *
1x0)
        arrow-lr/pane/2/offset: l/pane/4/offset * 0x1 + (l/pane/4/size * 1x0
+ (s * 1x0))

        append l/pane arrow/pane
        append l/pane arrow-lr/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
    l/pane/4/action:
        func [f a] compose
            [
                f/parent-face/pane/2/offset/x: (negate at/size/x - v/x) *
f/data
                show f/parent-face
            ]
        l/pane/4/redrag v/x / at/size/x
    l
]

;-- A simple example
siz: 400x400

f: layout
[
    backdrop 0.70.0
    t: box (siz + 16x16)
    button "Quit" [quit]
]

f-im: scroll-face/arrows layout/offset
    [
        backdrop 0.70.0
        origin 0x0
        space 0
        at 0x0
        image %graph1.png   ; your image here
    ] 0x0 siz
t/pane: f-im

view/offset f 140x130

[1] · 2 · 3 · See whole thread