[REBOL] Re: Object viewer
From: allenk:powerup:au at: 16-Feb-2001 8:25
Cool Jeff. I've tinkered with it, see below.
I guess it could be extended to present different colours based on type! but
I left it with just color coding the objects.
Title: "Object as Tree"
Author: "Jeff Kreis"
Purpose: "View an object in tree view"
Comment: "Works with any object"
History: [16-Feb-2001 ["Allen K" "Cosmetic changes, coloured text,
removed bg alt-rows"]]
view-obj: func [
'objw "A word that refers to an object"
/local obj data this-parent this-val
this-word expanded? this-depth val new-val
if not object? obj: get objw [make error! "View-obj views objects"]
data: make block! 300
;- this-parent this-val this-word expanded? depth
repend data [none obj objw off 0]
view/offset this-tree: layout [
h2 yellow (reform ["Object Viewer:" objw])
across space 0
lst: list 500x430 [
txt 500 black ivory [
;-- First find parent and from there
; find this thing
val: pick face/user-data 2
this-spot: find data face/user-data/1
this-spot: skip find next this-spot :val -2
set [this-parent this-val this-word expanded? this-depth]
either expanded? [
;-- Remove stuff that has me as a parent
spot: skip find/last data :this-val 5
remove/part skip this-spot 5 spot
change at this-spot 4 off
either object? :this-val [
;-- Add my stuff to data below me
spot: skip this-spot 5
new-data: make block! 50
foreach word next first this-val [
if unset? set/any 'val get/any in this-val word
repend new-data [this-val :val word off
this-depth + 1]
insert spot new-data
change at this-spot 4 on ;- Expanded?
;-- Edit my value
this-lay: layout [
h2 yellow (reform ["Value of:" this-word])
this-area: area 300x300 (mold :this-val)
across txt yellow "do?" do-check: check off
this-set: button "set"
this-close: button "close"
;- Use compose to stick the values in
; there so there can be more than
; one of these windows open and each
; button action will refer to its
; own instance values.
this-set/action: compose [
set this-val: in (this-parent) (to-lit-word
this-word) new-val: load (this-area/text)
if get in (do-check) 'data [new-val: set
this-val do new-val]
change/only at (reduce [this-spot]) 2 :new-val
this-close/action: compose [unview/only (this-lay)]
] supply [
;-- Set up each face of the
; iterated pane based on what's in data
; face/font/color: black
set-font face 'color leaf
count: count + cnt
; face/color: either even? count [200.200.200][ivory]
if tail? spot: skip data ((count - 1) * 5) [return none]
face/user-data: reduce [spot/1 spot/3]
this-val: pick spot 2
face/text: head insert/dup reform [
either object? :this-val [
set-font face 'color blue
either spot/4 ["--"]["+-"]
] " " spot/5
sld: slider 16x430 [
c: to-integer value * ((length? data) / 5)
if c <> cnt [cnt: c show lst]
button "quit" [quit]