REBOL [
	Title:	 "REBOL/View VID"
	Date:	 cvs-date "$Date: 2000/06/01 12:13:17 $"
	Version: cvs-version "$Revision: 1.112 $"
	File:	 %vid.r
	Author:  "Carl Sassenrath"
	Purpose: {The standard dialect for creating user inferfaces.}
	Rights: {
		Copyright 2000 REBOL Technologies. All rights reserved."
		The standard REBOL license agreement applies to this code.
		This code along with any changes, enhancements, or any other
		derivative works remain the property of REBOL Technologies.
	}
	Note: {
		Send bug fixes and enhancements to carl@rebol.com.
		I reserve the right to accept or deny changes to this
		code.
	}
	Category: [view 5]
]

find-key-face: func [
	"Search faces to determine if keycode applies."
	face [object!] keycode [char! word!] /local w f result
][
	either all [
		w: in face 'keycode
		w: get w
		any [keycode = w  all [block? w find w keycode]]
	][face][
		w: in face 'pane
		either block? w: get w [
			;!!! There is a bug in foreach! a Break/return here does not return the correct result!
			result: none
			foreach f w [if all [object? f f: find-key-face f keycode][result: f break]]
			result
		][
			if object? :w [find-key-face w keycode]
		]
	]
]

clear-fields: func [
	"Clear all text fields faces of a layout."
	panel [object!]
][
	if not all [in panel 'type panel/type = 'face] [exit]
	foreach face panel/pane [if all [face/flags find face/flags 'field] [clear face/text]]
]

insert-event-func [
	either all [event/type = 'key face: find-key-face face event/key][
		if block? face/action [do face/action] none
	][event]
]

blank-face: make face [
	edge: font: para: feel: image: color: text: effect: none
]

system/view/vid: make object! [

	verbose: off
	warn: off

	vid-colors: [  ; standard color scheme
		font   [255.255.255 255.180.55]
		body   [40.100.130 255.180.55]
		button 40.100.130
		bevel  110.120.130
		title  250.250.100
		field  240.240.240
		field-select 255.255.100
		field-font 0.0.0
	]

	vid-face: make face [ ; root definition
		size: none
		state: false    ; holds state of button
		style:          ; style name as a word
		action:         ; action to take on pick
		flags:          ; option flags
		words:          ; special keywords actions
		colors:         ; alternate face colors
		texts:          ; alternate text
		keycode:        ; shortcut key
		params:         ; face attributes to be parsed
		init:           ; what to do after the face is made
		blinker:        ; state of the blink
		related:        ; relational tags
		pane-size: none ; size of layout pane
		edge: make edge [size: 0x0]
		font: make font [style: none color: white align: 'left valign: 'top shadow: 1x1 colors: vid-colors/font]
	]

	vid-words: []  ; initialized on first evaluation of layout
	vid-styles: reduce ['face vid-face]
	facet-words: [edge font para feel effect keycode rate colors texts] ; allowed as params

	track: func [blk] [if verbose [print blk]]
	error: func [msg spot] [print [msg either series? :spot [mold copy/part :spot 6][:spot]]]

	image-cache: []
	set 'load-image func [
		"Load an image through the image cache."
		image-file [file! url!] "Local file or remote URL"
		/update "Force update from source site"
		/clear "Purge the entire cache"
		/local image
	][
		if clear [system/words/clear image-cache recycle]
		if any [update  not image: select image-cache image-file] [
			if all [update image] [remove/part find image-cache image-file 2]
			repend image-cache [
				image-file
				image: either file? image-file [load image-file][
					either update [load-thru/update image-file][load-thru image-file]
				]
			]
		]
		image
	]

	set 'get-style func [name][select vid-styles name]

	set 'put-style func [name new-face /local here][
		either here: find vid-styles name [change next here new-face][repend vid-styles [name new-face]]
	]

	expand-specs: func [face specs /local here] [
		specs: copy specs
		foreach var [edge: font: para:] [
			if here: find/tail specs :var [
				if here/1 <> 'none [
					insert here reduce either get in face to-word :var [
						['make to-word :var]][
						['make to-path reduce ['vid-face to-word :var]]
					]
				]
			]
		]
		specs
	]

	set 'stylize func [
		"Return a block of new face styles."
		styles [block!] "Block of style triplets: new-style from-style spec-block"
		/master "Add to or change the master style sheet"
		/local where old-face spot new-styles
	][
		new-styles: either master [vid-styles][copy []]
		foreach [new old specs] styles [
			if spot: select reduce [
				word? new    ["new face name," new]    
				word? old    ["existing face name," old]     
				block? specs ["face specification block," mold specs]
			] false [print ["Stylize function expected" reduce spot] halt]
			track ["New Style" new "from" old]
			if not any [old-face: select new-styles old
				old-face: select vid-styles old][print ["No such style:" old] halt]
			specs: expand-specs old-face specs
			either spot: find new-styles new [
				if verbose [print ["Redefining style:" new]]
				change next spot make old-face specs
			][repend new-styles [new make old-face specs]]
			new: last new-styles
			if spot: new/words [  ; convert word actions to functions
				while [spot: find spot block!] [
					change spot func [new args] first spot
				]
			]
		]
		new-styles
	]

	do-params: func [
		"Build block of parameters (and attribute words) while not a vid word or style."
		specs words styles /local params item
	][
		params: copy []
		forall specs [
			item: first specs
			if set-word? :item [break]
			either word? :item [
				if any [find vid-words item find styles item][break]
				params: insert params either any [
					item = 'with
					all [words find words item]
					all [find facet-words item]
				][to-lit-word item][item]
			][
				params: insert/only params :item
			]
		]
		reduce [specs reduce head params]  ; note params are evaluated here!
	]

	set 'set-font func [aface 'word value] [ ; deals with none font and cloning the font
		if none? aface/font [aface/font: vid-face/font]
		if none? in aface/font 'cloned [aface/font: make aface/font [cloned: true]]
		set in aface/font word value
	]

	flag?: func [face 'flag] [all [face/flags find face/flags flag]]

	next-tab: func [tabs way where] [
		if pair? tabs [
			tabs: max 1x1 tabs ; prevent div zero
			return where / tabs * tabs + tabs * way + (where * reverse way)
		]
		if block? tabs [
			foreach t tabs [
				if integer? t [t: t * 1x1] ; block of integers is ok too
				if all [pair? t (way * t) = (way * max t where)] [
					return way * t + (where * reverse way)
				]
			]
		]
		100 * way + where
	]

	set 'layout func [
		"Return a face with a pane built from style description dialect."
		specs [block!] "Dialect block of styles, attributes, and layouts"
		/size pane-size [pair!] "Size (wide and high) of pane face"
		/offset where [pair!] "Offset of pane face" 
		/parent new [object! word! block!] "Face style for pane"
		/origin pos [pair!] "Set layout origin"
		/local pane way space tabs var value args new-face pos-rule val params start vid-rules max-off guide
		styles def-style rtn word
	][
		;-- Get parent face style for layout:
		new-face: make any [
			all [parent object? new new]
			all [parent word? new get-style new]
			vid-face
		] any [all [parent block? new new][parent: 'panel]]
		if not parent [new-face/offset: any [all [offset where] 25x25]]
		new-face/size: pane-size: any [
			all [size pane-size]
			new-face/size
			system/view/screen-face/size - (2 * new-face/offset)
		]
		new-face/pane: pane: copy []
		origin: where: either origin [pos][20x20]
		space: 8x8 way: 0x1  pos: guide: none  max-off: 0x0  tabs: 100x100
		def-style: none

		;-- Search dialect for all style definitions:
		styles: copy vid-styles
		parse specs [some [thru 'style val: 
			[set word word! (if not find styles word [insert styles reduce [word none]])
			| none (error "Expected a style name" val)]
		]]
		parse specs [some [ thru 'styles val: [
				set word word! (
					if all [value? word value: get word block? value] [
						insert styles value
					]
				) | none (error "Expected a style name" val)
			]
		]]

		;-- Standard dialect rules:
		rtn: [where: (max-off * reverse way) + (way * any [guide origin])] ; max-off: 0x0]
		vid-rules: [
			  'at [set pos pair! (where: pos) | none]
			| 'space pos-rule (space: 1x1 * pos)
			| 'pad pos-rule (where: where + either integer? pos [way * pos][pos])
			| 'across (if way <> 1x0 [way: 1x0 do rtn])
			| 'below (if way <> 0x1 [do rtn way: 0x1])
			| 'origin [set pos pair! (origin: pos) | none] (where: origin max-off: 0x0)
			| 'guide [set pos pair! (guide: where: pos) | none (guide: where)] (max-off: 0x0)
			| 'return (do rtn)
			| 'tab (where: next-tab tabs way where)
			| 'tabs [
				set value [block! | pair!] (tabs: value) |
				set value integer! (tabs: value * 1x1)
			  ]
			| 'indent pos-rule (where/x: either integer? pos [where/x + pos][pos/x])
			| 'style set def-style word!
			| 'styles set value block! ; action done earlier
			| 'size set pos pair! (pane-size: new-face/size: pos size: true)
	;broken		| 'include set word word! (append pane get word)
			| 'sense set value block! [new/feel/engage: func [face action event] value]
			| 'do set value block! (do :value)
		]
		pos-rule: [set pos [integer! | pair! | skip (error "Expected position or size:" :pos)]]
		if empty? vid-words [ ; build list of dialect keywords on init
			foreach value vid-rules [if lit-word? :value [append vid-words to-word value]]
		]

		;-- Parse each phrase:
		while [not tail? specs] [
			forever [
				;-- Look for vid words and face style names. All others are args.
				value: first specs  specs: next specs
				if set-word? :value [var: :value break]
				if not word? :value [error "Misplaced item:" :value break]
				;-- If it's a vid word, parse its args:
				if find vid-words value [
					either value = 'style [
						params: reduce [first specs] ; style word to define
						specs: next specs
					][
						set [specs params] do-params start: specs [] styles
					]
					if :var [set :var where  var: none]
					insert params :value
					if not parse params vid-rules [error "Invalid args:" start]
					break
				]
				;-- If its a style, make its face:
				new: select styles value
				if not new [error "Unknown word or style:" value break]
				set [specs params] do-params specs new/words styles
				new: make new either val: select params 'with [expand-specs new val][[]]
				if :var [set :var new  var: none]
				;-- Handle its arguments:
				new/style: value
				new/pane-size: pane-size ; !!! should not be needed!
				new/params: params
				if not flag? new fixed [new/offset: where]
				forall params [
					val: first params ;probe val
					switch/default type?/word val [
						pair!   [new/size: val]
						string! [new/text: val]
						block!  [new/action: val]
						file!   [new/image: load-image val]
						url!    [new/image: load-image val]
						image!  [new/image: val]
						char!   [new/keycode: val]
						tuple!  [either flag? new text [set-font new color val][new/color: val]]
						integer! [new/data: val]
						word!   [
							any [
								if all [new/words args: find new/words :val] [
									until [function? first args: next args]	; function follows words, guaranteed
									params: do first args new params
								]
								if :val = 'with [params: next params]
								if value: find facet-words :val [
									either tail? params: next params [error "Missing argument for" :val][
										set in new val either not find value 'feel [first params][ ; else, it's an object
											make any [get in new val  vid-face/:val] first params ; !!!check for block?
										]
									]
								] ; error "Not a style word:" -- not needed, the reduce would have caught it
							]
						]
					][
						error "Unrecognized parameter:" val
					]
				]
				track ["Style:" new/style "Offset:" new/offset "Size:" new/size]
				new/parent-face: none ; used to flag that child needs to be parent
				do bind new/init in new 'init
				if new/parent-face [new: new/parent-face]
				either def-style [
					change next find styles def-style new
					def-style: none
				][
					append pane new
					if not flag? new fixed [
						max-off: maximum max-off new/size + space + where
						where: way * (new/size + space) + where
					]
					if all [warn any [new/offset/x > pane-size/x new/offset/y > pane-size/y]][
						error "Face offset outside the pane:" new/style]
					track ["Style:" new/style "Offset:" new/offset "Size:" new/size]
				]
				break ;forever
			]
		]
		if not size [ ; auto resize
			foreach face pane [if flag? face drop [face/size: 0x0]]
			new-face/size: size: origin + second span? pane
			foreach face pane [
				if flag? face drop [face/size: size]
				face/pane-size: size
			]
		]
		new-face
	]

	choice-face: make face [
		
		iter-face: none
		item-size: none

		pane: func [face oset /num] [
			if pair? oset [return to-integer (1 + (to-integer oset/:way / item-size/:way))]
			if any [none? oset oset > length? iter-face/flat-texts] [return none]
			iter-face/text: pick iter-face/flat-texts oset
			iter-face/offset: iter-face/old-offset: mway * item-size * (oset - 1)
			iter-face/selectable: not all [iter-face/texts <> iter-face/flat-texts find iter-face/texts iter-face/text] 
			iter-face/color: switch true reduce [
				iter-face/selectable and iter-face/selected [iter-face/colors/2]
				iter-face/selectable and not iter-face/selected [iter-face/colors/1]
				not iter-face/selectable [any [iter-face/colors/3 iter-face/colors/2]]
			]
			iter-face
		]

		evt-func: func [face event /local iface over] [
			either event/type = 'down [
				iface: choice-face/pane self event/offset - choice-face/offset
				any [all [iface: choice-face/pane self iface over: 'over]
					 all [iface: choice-face/pane self 1 over: 'away]]
				iface/feel/engage iface over event
				remove-event-func :evt-func
				none
			] [event]
		]

		set 'choose func [
			"Generates a choice selector menu, vertical or horizontal."
			choices [block!] "Block of items to display"
			function [function! none!] "Function to call on selection"
			parent [object!] "The parent choice button"
			/offset xy [pair!] "Offset of choice box"
			/across "Use horizontal layout"
			/local t oset up down wsize d2
		][
			insert-event-func :evt-func
			set [way mway iway] pick [[y 0x1 1x0][x 1x0 0x1]] none? across
			; set up the iterated face
			d2: any [all [parent/edge parent/edge/size] 0x0]
			iter-face: make parent [
				size: size - (2 * d2)
				pane-parent: parent
				feel: vid-feel/choice-iterator
				texts: choices
				flat-texts: []
				action: :function
				selected: false
				selectable: true
				edge: none
				if colors = vid-colors/body [colors/1: color]
				if not block? colors [colors: vid-colors/body]
				color: colors/1
			]
			item-size: iter-face/size
			either find choices block! [
				clear iter-face/flat-texts
				foreach x choices [append iter-face/flat-texts x]] [iter-face/flat-texts: choices]

			; set up the pane
			self/size: (item-size * mway * length? iter-face/flat-texts) + (item-size * iway) + (2 * (t: any [all [edge edge/size] 0x0]))
			either offset [self/offset: xy][
				oset: parent/offset + (any [all [parent/edge parent/edge/size] 0x0]) - t
				; shift the pane to its start position
				t: any [find iter-face/flat-texts parent/text iter-face/flat-texts]
				up: (index? t) - 1 * item-size/:way ; pixels needed up
				down: ((subtract length? iter-face/flat-texts index? t) + 1 * item-size/:way) ; pixels needed down
				wsize: get in find-window parent 'size
				; 4's and 8s are to keep the iterator off the window edges
				self/offset: (any [
					all [up < (oset/:way - 4) down < (wsize/:way - oset/:way - 4)
						 oset - ((mway * ((index? t) - 1) * item-size/:way))] ; it fits up & down
					all [up < (oset/:way - 4) if wsize/:way > (up + down + 8) [
							d2: (to-integer ((wsize/:way - oset/:way - 4) / item-size/:way)) * item-size/:way ; pixels that'll fit below the face
							oset - ((up + down - d2) * mway)]]
					oset - (oset - 4 * mway / iter-face/size/:way * iter-face/size/:way) ; just fit the top as high as we can
				])
			]
			show-popup/window self parent/parent-face
		]
	]

	vid-feel: make object! [

		sensor: make face/feel [
			cue: blink: none
			engage: func [face action event][
				switch action [
					time [if not face/state [face/blinker: not face/blinker]]
					down [face/state: on]
					up   [if face/state [do face/action] face/state: off]
					over [face/state: on]
					away [face/state: off]
				]
				cue face action
				show face
			]
		]

		hot: make sensor [
			over: func [face action event][
				if all [face/font face/font/colors][
					face/font/color: pick face/font/colors not action
					show face
					face/font/color: first face/font/colors
				]
			]
			cue: func [face action][
				if all [face/font face/font/colors][face/font/color: pick face/font/colors not face/state]
			]
		]

		radio: make sensor [
			over: none
			redraw: func [face act pos][face/color: pick face/colors not face/state]
			engage: func [face action event][
				if action = 'down [
					foreach item face/parent-face/pane [
						if all [item/related = face/related item/state][item/state: false show item]
					]
					face/state: true
					show face
				]
			]
		]

		button: make hot [
			redraw: func [face act pos /local state] [
				face/edge/effect: pick [ibevel bevel] face/state
				if face/texts [face/text: face/texts/1]
				all [face/state face/texts face/text: any [face/texts/2 face/texts/1]]
				state: either not face/state [face/blinker][true]
				if face/colors [face/color: pick face/colors not state]
				if face/effects [face/effect: pick face/effects not state]
			]
			cue: none
		]

		toggle: make button [
			engage: func [face action event][
				if action = 'down [face/state: not face/state do face/action]
				show face
			]
		]

		check: make toggle [
			redraw: func [face act pos] [
				all [pos: find face/effect 'cross  remove pos]
				if face/state [insert face/effect 'cross]
				if face/colors [face/color: pick face/colors not state]
				if face/effects [face/effect: pick face/effects not state]
			]
			engage: func [face action event][
				if action = 'down [
					face/state: not face/state
					show face
				]
			]
		]

		rotary: make hot [
			redraw: func [face act pos] [
				face/text: face/data/1
				face/edge/effect: pick [ibezel bezel] face/state
				if face/colors [face/color: pick face/colors not face/state]
				if face/effects [face/effect: pick face/effects not face/state]
			]
			next-face: func [face] [
				face/data: either tail? next face/data [head face/data][next face/data]
			]
			back-face: func [face] [
				face/data: either head? face/data [back tail face/data][back face/data]
			]
			engage: func [face action event /local do-it down-it][
				do-it: [if face/state [do face/action] face/state: off]
				down-it: [if not face/state [next-face face] face/state: on]
				switch action [
					down down-it
					up do-it
					right-down [if not face/state [back-face face] face/state: on]
					right-up do-it
					over down-it
					away [if face/state [back-face face] face/state: off]
				]
				show face
			]
		]

		choice: make hot [
			engage: func [face action event][
				if action = 'down [choose face/texts func [face parent] any [face/action [parent/text: face/text]] face]
				show face
			]
		]

		choice-iterator: make face/feel [
			over: func [face state] [
				face/selected: all [face/selectable state]
				show face
			]
			engage: func [face act event] [
				if event/type = 'down [
					all [face/selected face/selectable face/action face face/pane-parent]
					hide-popup/window face/pane-parent/parent-face
				]
				show face
			]
		]

		drag: make face/feel [
			set-offset: func [face pair /local way] [
				face/offset: (face/offset * reverse face/way) + (pair * face/way)
			]
			engage: func [face action event /local t pf][
				if find [over away] action [
					pf: face/parent-face
					set-offset face max 0x0
						min pf/size - face/size - (2 * pf/edge/size)
							face/offset + event/offset - face/data
					t: pf/state * face/offset / (pf/size - face/size)
					pf/data: t/x + t/y + 1
					do pf/action
					show face
				]
				if action = 'down [face/data: event/offset]
			]
		]

		slide: make drag [
			engage: func [face action event /local t][
				if action = 'down [
					set-offset face/pane max 0x0
						min face/size - face/pane/size - (2 * face/edge/size)
							event/offset - (face/pane/size / 2)
					t: face/state * face/pane/offset / (face/size - face/pane/size)
					face/data: t/x + t/y + 1
					do face/action
					show face
				]
			]
		]

		progress: make face/feel [
			redraw: func [face act pos][
				face/pane/size: max 0x0 min face/size face/data * face/pane/way + (face/pane/size * reverse face/pane/way)
				if face/pane/way = 0x1 [face/pane/offset: face/size - face/pane/size]
			]
		]

		unselect-text: does [system/view/highlight-start: system/view/highlight-end: none]

		copy-selected-text: func [/local start end][
			if all [
				string? start: system/view/highlight-start
				string? end: system/view/highlight-end
				not zero? offset? start end
			][
				if negative? offset? start end [start: end end: system/view/highlight-start]
				write clipboard:// copy/part start end
				true
			]
		]

		copy-text: func [face] [
			if not copy-selected-text [ ; copy all if none selected (!!! should be line)
				system/view/highlight-start: face/text
				system/view/highlight-end: tail face/text
				copy-selected-text
			]
		]

		delete-selected-text: func [/local start end][
			if all [
				string? start: system/view/highlight-start
				string? end: system/view/highlight-end
			][
				if negative? offset? start end [start: end end: system/view/highlight-start]
				remove/part start end
				system/view/caret: start
				unselect-text
				true
			] ; returns result
		]

		next-field: func [face /local item][
			all [
				item: find face/parent-face/pane face
				while [
					if tail? item: next item [item: head item]
					face <> first item
				][
					if all [object? item/1 block? item/1/flags find item/1/flags 'tabbed][
						return item/1]
				]
			]
			none
		]

		back-field: func [face /local item][
			all	[
				item: find face/parent-face/pane face
				while [face <> first item: back item][
					if all [object? item/1 block? item/1/flags find item/1/flags 'tabbed][
						return item/1]
					if head? item [item: tail item]
				]
			]
			none
		]

		add-char: func [char][
			delete-selected-text
			system/view/caret: insert system/view/caret char
		]

		charset-normal: complement charset [#"^A" - #"^(1F)" #"^(DEL)"]

		edit-text: func [face event action /local char tmp][
			char: event/key
			either find charset-normal char [add-char char][
				switch char [
					up [
						system/view/highlight-start: system/view/highlight-end: none
						tmp: caret-to-offset face system/view/caret
						textinfo face system/view/line-info system/view/caret
						tmp/y: tmp/y - system/view/line-info/size/y
						system/view/caret: offset-to-caret face tmp
					]
					down [
						system/view/highlight-start: system/view/highlight-end: none
						tmp: caret-to-offset face system/view/caret
						textinfo face system/view/line-info system/view/caret
						tmp/y: tmp/y + system/view/line-info/size/y
						system/view/caret: offset-to-caret face tmp
					]
					left [
						system/view/highlight-start: system/view/highlight-end: none
						if not head? system/view/caret [
							system/view/caret: back system/view/caret
						]
					]
					right [
						system/view/highlight-start: system/view/highlight-end: none
						if not tail? system/view/caret [
							system/view/caret: next system/view/caret
						]
					]
					home [
						system/view/highlight-start: system/view/highlight-end: none
						tmp: caret-to-offset face system/view/caret
						tmp/x: 0
						system/view/caret: offset-to-caret face tmp
					]
					end [
						system/view/highlight-start: system/view/highlight-end: none
						tmp: caret-to-offset face system/view/caret
						tmp/x: 32000
						system/view/caret: offset-to-caret face tmp
					]
					#"^(back)" [
						if all [not delete-selected-text not head? system/view/caret][
							remove system/view/caret: back system/view/caret]
					]
					#"^M" [
						either flag? face return [
							do action
							focus next-field face
						][add-char newline]
					]
					#"^(del)" [
						if all [not delete-selected-text not tail? system/view/caret][
							remove system/view/caret]
					]
					#"^X" [copy-text face delete-selected-text]
					#"^C" [copy-text face]
					#"^V" [
						delete-selected-text
						system/view/caret: insert system/view/caret read clipboard://
					]
					#"^A" [ ; select all
						system/view/highlight-start: face/text
						system/view/highlight-end: tail face/text
					]
					#"^G" [clear face/text system/view/caret: face/text]
					#"^(tab)" [
						tmp: either event/shift [back-field face][next-field face]
						if tmp [focus tmp][add-char char]
					]
				]
			]
			show face
		]

		focus: func [face /local tmp-face][
			if system/view/focal-face [
				tmp-face: system/view/focal-face
				system/view/focal-face: none
				unselect-text
				show tmp-face
			]
			if system/view/focal-face: face [
				if not string? face/text [face/text: either face/text [form face/text][copy ""]]
				system/view/caret: tail face/text
				show face
			]
		]

		edit: make face/feel [
			redraw: func [face act pos][
				face/color: pick face/colors face <> system/view/focal-face
			]
			engage: func [face act event index][
				switch act [
					down [
						either face <> system/view/focal-face [
							focus face
						][
							system/view/highlight-start:
							system/view/highlight-end: none
							system/view/caret: offset-to-caret face event/offset
							show face
						]
					]
					over [
						if system/view/caret <> offset-to-caret face event/offset [
							if not system/view/highlight-start [
								system/view/highlight-start: system/view/caret
							]
							system/view/highlight-end:
							system/view/caret: offset-to-caret face event/offset
							show face
						]
					]
					key [edit-text face event face/action]
				]
			]
		]
	]

	stylize/master [
		SENSOR FACE [
			feel: vid-feel/sensor
			set [size color image effect edge font para] none
			init: [if none? size [size: 100x100]]
		]

		IMAGE FACE [
			size: color: image: none
			feel: vid-feel/sensor
			effect: [fit]
			edge: [size: 0x0 color: black]
			font: [size: 16 align: 'center valign: 'middle style: 'bold shadow: 2x2]
			init: [
				if image [
					if none? size [size: image/size]
					if color [effect: join effect ['colorize color]]
				]
				if none? size [size: 100x100]
			]
			words: [effect [new/effect: second args next args]]
		]

		BACKDROP IMAGE [flags: [fixed drop] init: append copy init [size: pane-size]]

		BACKTILE BACKDROP [flags: [fixed drop] effect: [tile-view]]

		BOX IMAGE []

		FRAME IMAGE [edge: [size: 2x2 color: vid-colors/bevel effect: 'ibevel]]

		TEXT FACE [
			size: image: color: none
			edge: none
			flags: [text]
			init: [
				if string? text [trim/lines text]
				if none? text [text: copy ""]
				change font/colors font/color
				if action [feel: vid-feel/hot]
				if none? size [
					size: max 1x1 pane-size * 9 / 10 - offset - para/margin ; 80% of width available
					if data [size/x: data]
					size: size-text self
	;				either in self 'align [size: s][size/y: s/y]
					all [ ; add origin and margin sizes (what about if multiple paras?)!!!
						para para/origin size: size + para/origin
						para/margin size: size + para/margin
					]
				]
				if data [size/x: data]
			]
			words: [
				left center right [set-font new align first args args]
				top middle bottom [set-font new valign first args args]
				bold italic [set-font new style first args args]
			]
		]

		LABEL TEXT [
			font: [valign: 'middle]
			align: none
			init: append copy init [
				switch align [
					center [offset/x: first offset - (size / 2)]
					right [offset/x: first (offset - size)]
				]
			]
			words: [
				left center right [new/align: first args args]
				top middle bottom [set-font new valign first args args]
				bold italic [set-font new style first args args]
			]
		]

		TITLE TEXT [
			font: [size: 24 style: 'bold align: 'center valign: 'middle color: vid-colors/title shadow: 3x3]
		]

		SUBTITLE TITLE [font: [size: 18 style: 'italic]]

		BUTTON FACE [
			size: 100x24
			color: image: none
			font: [align: 'center valign: 'middle style: 'bold]
			edge: [size: 2x2 effect: 'bevel color: vid-colors/bevel]
			feel: vid-feel/button
			effects: none
			init: [
				edge: make edge []
				font/color: first font/colors
				if all [image not effect] [
					effect: copy [fit]
					if color [append effect reduce ['colorize color]]
				]
				if not color [color: vid-colors/button]
			]
		]

		CHECK BUTTON [
			size: 16x16
			font: none
			feel: vid-feel/check
			color: vid-colors/field
			edge: [effect: 'ibevel]
			init: [effect: copy []]
		]

		RADIO CHECK [
			size: 16x16
			feel: vid-feel/radio
			colors: reduce [vid-colors/field vid-colors/body/1]
			edge: [effect: none color: 0.0.0 size: 0x0]
			init: [effect: copy [oval key 0.0.0]]
			words: [of [new/related: second args next args]]
		]

		ARROW BUTTON [
			size: 20x20 16x16
			font: none
			color: vid-colors/field
			init: [
				effect: compose [arrow 0.0.0 rotate (
					select [up 0 right 90 down 180 left 270] data
				) fit]
			]
			words: [up right down left [new/data: first args args]]
		]

		TOGGLE BUTTON [feel: vid-feel/toggle]

		ROTARY BUTTON [
			edge: [size: 4x2 effect: 'bezel]
			feel: vid-feel/rotary
			insert init [data: texts]
			words: [data [new/texts: second args next args]]
		]

		CHOICE ROTARY [
			colors: vid-colors/body
			feel: vid-feel/choice
		]

		FIELD FACE [
			size: 200x24
			color: none
			colors: reduce [vid-colors/field vid-colors/field-select]
			edge: [size: 2x2 color: vid-colors/bevel effect: 'ibevel]
			font: [color: vid-colors/field-font style: colors: shadow: none]
			para: [wrap?: off]
			feel: vid-feel/edit
			init: [
				if color [colors: reduce [color colors/2]]
				if not string? text [text: either text [form text][copy ""]]
			]
			flags: [field return tabbed]
		]

		AREA FIELD [size: 400x150 flags: [field tabbed]]

		SLIDER FACE [
			feel: vid-feel/slide
			color: 100.100.100
			size: 16x200
			font: none
			para: none
			data: none
			edge: [size: 2x2 effect: 'ibevel color: 128.128.128]
			dragger: make face [
				offset: 0x0
				color: 128.128.128
				feel: vid-feel/drag
				font: para: none
				edge: make edge [size: 1x1 effect: 'bevel color: 128.128.128]
			]
			asize: none
			init: [
				asize: size
				state: any [data max size/x size/y]
				pane: make dragger [
					way: pick [1x0 0x1] asize/x > asize/y
					size: 20 * way + (asize * reverse way) - 4x4 ; slider edge size
				]
			]
		]

		PROGRESS IMAGE [
			feel: vid-feel/progress
			color: 100.100.100
			size: 200x16
			font: none
			para: none
			data: 0
			edge: [size: 2x2 effect: 'ibevel color: 128.128.128]
			bar: make face [
				offset: 0x0
				way: none
				color: 0.80.200
				edge: font: para: none
			]
			append init [
				pane: make bar []
				if colors [color: first colors pane/color: second colors]
				pane/way: pick [1x0 0x1] size/x > size/y
				pane/size: pane/way + (size * reverse pane/way)

			]
		]

		PANEL IMAGE [feel: none append init [parent-face: layout/parent/size action self size]]

		LIST IMAGE [
			color: 240.240.240
			feel: none
			subface: none
			subfunc: none
			edge: [size: 2x2 color: 128.128.128 effect: 'ibevel]
			append init [
				subface: layout/parent/origin action blank-face 0x0
				pane: func [face id /local count spane][
					if pair? id [return 1 + second id / subface/size]
					subface/offset: subface/old-offset: id - 1 * subface/size * 0x1
					if subface/offset/y + subface/size/y > size/y [return none]
					count: 0
					foreach item subface/pane [
						if object? item [			
							subfunc item id count: count + 1
						]
					]
					subface
				]
			]
			set-it: func [face stuff index count /item][ 
				item: stuff/:count/:index either file? item [face/image: load-image item][face/text: any [item ""]]
			]
			words: [supply [new/subfunc: func [face count index] second args next args]
				map [set-it: func [face stuff index count /map item] compose/deep [
						map: [(second args)]
						item: stuff/:count/:index
						all ['text = map/:index none? item item: ""]
						either all ['image = map/:index any [file? item url? item]][face/image: load-image item][
							all [map/:index set in face map/:index item]
						]
					]
					next args
				]
				data [new/subfunc: func [face count index /item/stuff] compose/deep [
						stuff: [(second args)] 
						either count > length? stuff [face/text: "" face/image: none][
							set-it face stuff index count
						]
					]
					next args
				]
			]
		]

		ANIM IMAGE [
			frames: copy []
			rate: 1
			feel: make feel [
				engage: func [face action event][
					if action = 'time [
						face/image: first face/frames
						if tail? face/frames: next face/frames [
							face/frames: head face/frames
						]
						show face
					]
				]
			]
			words: [	    
				frames [append new/frames second args next args]
				rate   [new/rate: second args next args]
			]
			init: append copy init [
				forall frames [change frames load-image first frames]
				frames: head frames
				image: first frames 
			]
		]

	]
]