REBOL [
	Title: "ROAM - REBOL Object Browser"
	Author: ["Carl Sassenrath" "Gregg Irwin"]
	Version: 0.1.2 ; Alpha
	Copyright: "2005 REBOL Technologies"
	Needs: [1.2.122]
	History: [
		0.1.2 {Resizing added} Gregg
	]
]

help-text: {
Roam is a very simple object browser for REBOL. It has none of the
features of other object browsers, but it is very easy to use. Click on
the displayed fields to explore. Click the back arrow to return to the
prior object.
}

values: []
cnt: 0
max-str: 72
std-effect: reduce ['gradient 1x1 ivory mint + 50]
path-val: to-path [system]
bar-color: 240.240.180
over-count: none
over-color: 200.200.255

clip-str: func [str] [
	; Keep string to one line.
	trim/lines str 
	if (length? str) > max-str [str: append copy/part str max-str "..."]
	str
]

form-val: func [val] [
	; Form a limited string from the value provided.
	if any-block? :val [return reform ["length:" length? val]]
	if image? :val [return reform ["size:" val/size]]
	if any-function? :val [
		val: third :val
		if block? val/1 [val: next val]
		return clip-str either string? val/1 [copy val/1][mold val]
	]
	if object? :val [val: next first val]
	clip-str either port? :val [form val][mold :val]
]

disect-object: func [obj /local words vals out type n] [
	words: first obj
	vals: next second obj
	out: copy []
	n: 0
	foreach word next words [
		type: type?/word pick vals 1
		n: n + 1
		append/only out reduce [
			word
			n
			form word
			form type
			either type <> 'unset! [form-val pick vals 1]['unset]
			color-type type
		]
		vals: next vals
	]
	out
]

disect-block: func [blk /local out type n] [
	out: copy []
	n: 0
	foreach item blk [
		type: type?/word :item
		append/only out reduce [
			n: n + 1
			n
			reform ["index:" n]
			form type
			either type <> 'unset! [form-val item]['unset]
			color-type type
		]
	]
	out
]

disect-func: func [funct /local out type n] [
	out: copy []
	n: 0
	foreach item first :funct [
		type: type?/word :item
		append/only out reduce [
			n: n + 1
			n
			reform ["index:" n]
			form type
			either type <> 'unset! [form-val item]['unset]
			color-type type
		]
	]
	type: type?/word second :funct
	append/only out reduce [
		'body
		n
		"body"
		form type
		form-val second :funct
		color-type type
	]
	out
]

disect: func [val /local ret] [
	ret: switch type?/word :val [
		block!  [disect-block val]
		object! [disect-object val]
		function! [disect-func :val]
		native! [disect-func :val]
		action! [disect-func :val]
		op! [disect-func :val]
	]
	either ret [
		values: ret true
	][
		if series? val [show-info/val path-val val none]
	]
]

color-type: func [type] [
	type: find [
		none!
			120.120.120
		logic! integer! decimal! money! char! tuple! date! time! pair!
			60.60.60
		string! file! url! issue! image! bitset! email! tag!
			0.160.0
		block! list! hash! paren! struct!
			0.160.0
		object! port!
			0.0.160
		native! action! function! op! routine!
			200.0.0
		datatype!
			80.150.200
		word! set-word! lit-word! get-word! path! set-path! get-path! lit-path!
			200.150.80
	] type
	either type [first find type tuple!] [160.160.160]
]

next-value: func [word][
	if either integer? word [
		attempt [disect do join path-val word]
	][
		attempt [disect get in do path-val word]
	][
		append path-val word
		update-lst
	]
]

back-value: does [
	if not tail? next path-val [remove back tail path-val]
	disect do path-val
	update-lst
]

update-lst: does [
	tpa/text: form path-val
	cnt: 0
	scr/data: 0
	scr/redrag lst-cnt / max 1 length? values
	show [tpa lst scr]
]

sort-values: func[field] [
	sort/compare values func [a b] [b/:field > a/:field]
	show lst
]

show-help: does [
	inform layout [
		backdrop effect std-effect
		h2 "ROAM Help:"
		txt 300 help-text
		txt blue underline bold "Send Feedback" [browse http://www.rebol.com/feedback.html]
		indent 200 btn-cancel 80 [hide-popup]
	]
]

show-info: func [path /val data] [
	if not val [data: mold do path]
	view/new layout [
		origin 0x0 space 0
		txt bold form path
		area 640x500 data
		btn-cancel 75 "Close" [unview/only face/parent-face]
	]
]

out: layout [
	origin 0 space 0 across
	style hdr txt bold white black 20x20
	f-top-pnl: panel 640x26 [
		across
		pad 5x2
		h2 80 as-is "ROAM 0.1"
		pad 0x2
		txt 502 bottom bold gray "[A very simple REBOL object browser]"
		f-help: txt "Help" underline blue [show-help]
	] effect std-effect
	return
	box 40x20 bar-color effect [draw [fill-pen red triangle 25x10 34x4 34x16]] [back-value]
	tpa: text 560x20 0.0.200 bar-color bold [back-value]
	f-show: btn 40 "Show" [
		either tail? next path-val [alert "Output is too large."][
			show-info path-val
		]
	]
	return
	hdr 40  "#" right [sort-values 2]
	hdr 120 "Name" [sort-values 3]
	hdr 60  "Type" [sort-values 4]
	f-val-hdr: hdr 420 "Value or attributes" [sort-values 5]
	return
	lst: list 640x400 - 16x0 [
		across space 0
		style txt base-text
			font [colors: [0.0.0 0.0.0]]
			feel [
				over: func [face ovr] [
					if all [ovr over-count <> face/data][over-count: face/data show lst]
				]
				engage: func [face act evt] [
					if all [act = 'down face/user-data][next-value face/user-data/1]
				]
			]
		txt 40 right gray
		txt 120 bold
		txt 60  bold
		txt 1024 font []  
	] supply [
		count: count + cnt
		face/color: pick [240.240.240 220.230.220] odd? count
		face/text: ""
		if not face/user-data: pick values count [exit]
		if over-count = count [face/color: over-color]
		face/data: count
		face/font/color: either index >= 3 [face/user-data/6][0.0.0]
		face/text: pick face/user-data index + 1
	]
	do [lst-cnt: to-integer lst/size/y / lst/subface/size/y - 1]
	scr: scroller 16x400 [
		value: to-integer value * max 0 (length? values) - lst-cnt
		if cnt <> value [cnt: value show lst]
	]
]

on-resize: does [
	f-top-pnl/size/x: out/size/x
	f-help/offset/x: out/size/x - f-help/size/x - 5
	tpa/size/x: out/size/x
	f-show/offset/x: out/size/x - f-show/size/x
	f-val-hdr/size/x: out/size/x - f-val-hdr/offset/x
	lst/size/x: out/size/x - 16
	lst/size/y: out/size/y - lst/offset/y
	scr/offset/x: out/size/x - scr/size/x
	scr/resize/y out/size/y - scr/offset/y
	lst-cnt: to-integer lst/size/y / lst/subface/size/y - 1
	scr/redrag lst-cnt / max 1 length? values	
	show out
]


back-value
insert-event-func [
	if event/type = 'scroll-line [
		n: max 0 (length? values) - lst-cnt
		cnt: max 0 min n cnt + event/offset/y
		scr/data: cnt / max 1 n
		show [scr lst]
	]
	if event/type = 'resize [on-resize]
	event
]
view/options center-face out 'resize

;	system object
;	native functions
;	mezzanine functions
;	protocols
;	components
;	VID styles