[REBOL] tree style: first attemp
From: robert::muench::robertmuench::de at: 9-Apr-2002 22:42
Hi, below you will find a first attemp for a "tree" style based on the
list-style. The source is not indented to avoid line breaks.
However, I'm sure it's far from perfect but that's how far I made it today. Have
a look and let me and the others know what you think.
Known Bugs:
- Expanding more than one top-level item is possible but you need to collaps
them from top-down ??
- Some code is include that I used to test variants.
Robert
rebol []
;-- Generate images for dot and arrows:
make-image: func [xy wh eff] [
eff: layout [
size 20x20 at xy
box wh effect eff
]
eff/color: main-color
to-image eff
]
dot: make-image 6x5 9x9 [gradient 1x1 255.0.0 0.0.0 oval key 0.0.0]
arr: make-image 3x3 14x14 [arrow 0.0.127 rotate 90]
ard: make-image 3x3 14x14 [arrow 0.0.127 rotate 180]
;-- Action stuff
expand-action: [
face/user-data/expanded: not face/user-data/expanded
update-list
]
;-- Item definition
item: context [
subitems: make block! []
expanded: make logic! false
face: none
counter: 0
]
item-list: []
cnt: 1
loop 10 [
tmp: make item [counter: cnt]
for x 0 2 1 [
append tmp/subitems rejoin ["Eintrag:" cnt "-" x]
]
append item-list tmp
cnt: cnt + 1
]
;-- GUI stuff
; older approach
make-item-face: func [item][
; first do the layout so that we can access all the objects in it
item/face: layout [
origin 0 space 0 across
ar: image arr
tx: text "Dies ist ein Test"
dt: image dot
]
; now we can alter the objects
ar/action: :expand-action
dt/action: :subitem-action
ar/user-data: tx/user-data: item
item/face
]
main-layout: [
across
space 0
image 20x20 expand-action
text 120x20
]
subitems: []
top-level-list: head item-list
offset: 0
barrier: 0
update-list: does [
subitems: []
top-level-list: head item-list
offset: 0
barrier: 0
show lst
]
cnt: 0
; concept:
; - we only count main entries
; - subitems are copied into a series and are removed from it after being
displayed
; - if the series of subitems is empty the normal top-level entries are
continued
main-supply: [
; do we need to access a top-level entry?
if empty? subitems [
; ok, do we have to consider that sub-level items have been displayed
either count > barrier
[cnt: count - offset] ; if so we have to adjust our pointer to the top-level
objects
[cnt: count] ; if not we just use the count index
; get our object
face/user-data: item-list/:cnt
; optimization
if none? face/user-data [exit]
]
; which path to choose? Show top-level or sub-level item?
either empty? subitems
[ ; ok, we display a top-level item
switch/default index [
1 [face/image: either empty? face/user-data/subitems
[dot]
[either face/user-data/expanded [ard][arr]]
]
2 [face/text: rejoin ["Dies ist ein Test: " cnt]
; subitems is our trigger to switch to sub-level item rendering
; so we have to assure that the last column of the actual row is driven before
setting the trigger
; this will result in a sub-level item rendering in the next loop
either face/user-data/expanded
[subitems: copy face/user-data/subitems offset: length? subitems barrier: count
+ offset]
[subitems: []] ; not needed ??
]
][probe "No list-object reference"]
]
[ ; we display a sub-level item
switch index [
1 [face/image: dot]
2 [face/text: first subitems remove subitems]
]
]
return
]
main-gui: layout [ lst: list 200x200 main-layout supply main-supply]
view main-gui ; make-item-face item
halt
