[ALLY] Re: Scrolling views
From: jeff:rebol at: 18-Feb-2001 21:30
Hello, Bo:
> Brett,
>
> 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.
>
> REBOL [
> Title: "Automated scrolling" Date: 22-Dec-2000 Author:
> "Bohdan Lechnowsky" Email: [bo--rebol--com] 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.
. . .
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.
-jeff
REBOL [
Title: "Add Sliders when necessary"
Author: "Jeff Kreis"
Email: [jeff--rebol--com]
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
