[REBOL] Re: Object viewer
From: gjones05:mail:orion at: 16-Feb-2001 13:09
From: Volker Nitsch
> [rebol [title: "scroll-area with slider"]
> context [
> s: ta: sv: none
> ;---some data
> s: for i 1 130 1 [
> insert "" rejoin [i newline]]
> view layout [
> across
> ta: area 140x480 s
> sv: slider 16x480 [
> scroll-para ta sv]
> ]
> ]
> ]
>
> Volker
Thanks, Volker, this was exactly what I was looking for earlier today.
After seeing your example, I realized that this method was used in many
of the built-in dialogs in the source. I just didn't realize what I was
looking at. More as an exercise than a necessity, I adapted this
approach to Jeff's object viewer (feature creep alert :-). I also
widened the dialogs so that it could accommodate the width of some items
without needing to scroll horizontally. Jeff used some really neat
methods in allowing the creation of multiple pop-ups. I hope I didn't
introduce any new problems like yesterday. Still has a bug in my Win98
/View when I click on the view object (I can't figure it out yet).
REBOL [
Title: "Object as Tree"
Author: "Jeff Kreis"
Email: [jeff--rebol--com]
Date: 15-Feb-2001
Purpose: "View an object in tree view"
Comment: "Works with any object"
History: [
0.1.0 [15-Feb-2001 {Script created and placed on list} "Jeff Kreis"]
0.1.1 [16-Feb-2001 {Suggested change to scrollable areas,
changed size of pop-up to accommodate width without need to scroll,
reordered header history to standard. ?? Bug when click on view
and a few others. Changes suggested by Allen K. not currently
included herein} "G Scott Jones, M.D."]
]
]
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]
cnt: 0
view/offset this-tree: layout [
backdrop 90.90.240
h2 yellow (reform ["Object Viewer:" objw])
across space 0
lst: list 500x430 [
txt 500 [
;-- 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] this-spot
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 [val: unset!]
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 [
backdrop 90.90.240
h2 yellow (reform ["Value of:" this-word])
across
this-area: area 500x300 (mold :this-val)
this-slider: slider 16x300
return
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
unview/only (this-lay)
]
;added slider control for pop-up area, and its
action defined as follows
this-slider/action: compose [scroll-para
(this-area) (this-slider)]
this-close/action: compose [unview/only
(this-lay)]
center-face this-lay
view/new this-lay
]
]
show lst
]
] supply [
;-- Set up each face of the
; iterated pane based on what's in data
face/text: none
face/font/color: black
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 [
either spot/4 ["--"]["+-"]
][#] spot/3
] " " spot/5
]
sld: slider 16x430 [
c: to-integer value * ((length? data) / 5)
if c <> cnt [cnt: c show lst]
] return
button "quit" [quit]
] 150x50
]
view-obj system
