Archive version of: vid-build.r ... version: 9 ... luce80 16-Feb-2011

Amendment note: Minor bug fixes and retouches || Publicly available? Yes

REBOL [
	Title: "VID_build"
	Date: 16-Feb-2011
	Version: 0.6.6
	File: %vid-build.r
	Author: "Marco Antoniazzi"
	Purpose: "Easily create VID guis"
	eMail: [luce80 AT libero DOT it]
	History: [
		0.0.1 [14-Mar-2010 "First version"]
		0.0.2 [31-Mar-2010 "Enhancements"]
		0.0.3 [21-Apr-2010 "Enhancements and bug fixes"]
		0.0.4 [11-Sep-2010 "Enhancements"]
		0.0.5 [18-Sep-2010 "Enhancements"]
		0.0.6 [24-Sep-2010 "Enhancements and bug fixes"]
		0.0.7 [26-Sep-2010 "Added style button and sensor"]
		0.0.8 [09-Oct-2010 "gui window reopens where it was closed"]
		0.0.9 [01-Nov-2010 "Enhancements and bug fixes"]
		0.6.0 [03-Jan-2011 "Added a few keyboard shortcuts, undo, redo, prefs, help, clear and bug fixes"]
		0.6.5 [08-Jan-2011 "Window's offset and size in prefs, added panel, gui to clip, find and bug fixes"]
		0.6.6 [16-Feb-2011 "Minor bug fixes and retouches"]
	]
	Notes: {
	- Shortcuts: Undo <Ctrl+z>, Redo <Ctrl+r>, Cut <Ctrl+x>, Copy <Ctrl+c>, Paste <Ctrl+v>, edit style <F2>, Quit <Esc>,
		Select previous <Up>, next <Down>, some previous <Pg-Up>, some next <Pg-Down>
		first <Home>, last <End>, Mouse-wheel also scrolls
	- Use <Ctrl> to multi-select lines to be added to panels, beware the order used to select
	}
	Todo: {
	- add "Save" button
	- save also offset of window
	- sub-layouts of panels
	- link or redo of vid-ancestry, effect-lab, font-lab, paint
	}
	Category: [util vid view]
	library: [
		level: 'intermediate
		platform: 'all
		type: 'tool
		domain: [gui vid]
		tested-under: [View 2.7.7.3.1]
		support: none
		license: 'BSD
		see-also: none
	]
]

docs: http://www.rebol.com/docs/view-guide.html ; change to suit your needs

counter: 0
line: ""
lab: " "
copied: []
main-list: copy []
undo-list: copy []
redo-list: copy []
pick-list: copy []
win-options: copy []
temp-options: copy []
win-title: "VID_build"
saved?: yes
text-found?: no
here-at: false
text-searched: ""
gui-script: copy []
back-picked: copy []
visible-lines: 0
system/view/vid/error: func [msg spot] [to-error [msg]] ; patch VID error function to keep it silent
widget_to_block: func [widget [block!] text [string!]][
	join widget [join text form counter]
]
add_new_widget: func [new-widget [block!] /local str-counter] [
	str-counter: reverse head change copy "0000" reverse to-string counter ; pad left with 0s
	new-widget: copy new-widget
	insert new-widget load rejoin ["L" str-counter ":"]
	counter: counter + 1
	add_to_undo-list
	
	either empty? gui-list/data [
		clear main-list
		append/only main-list new-widget
		append gui-list/data mold/only new-widget
	][
		if empty? gui-list/picked [append gui-list/picked first gui-list/data] ; security check
		insert/only find/only/tail main-list to-block first gui-list/picked new-widget
		insert find/tail gui-list/data first gui-list/picked mold/only new-widget
	]

	append clear gui-list/picked mold/only new-widget
	update_list_and_layout
]
add_new_text: func [new-widget [block!] /local new-text] [
	if new-text: request-text/default join "New text" counter [
		add_new_widget join new-widget copy/deep new-text 
	]
]
add_panel: func [/local picked] [
	picked: copy gui-list/picked
	loop length? picked [
		append picked mold/only remove load first picked
		remove picked
	]
	add_new_widget load rejoin [{panel [origin 0 space 4x4 } reform picked {]}]
]

remove_selected: func [/local picked] [
	if empty? gui-list/data [exit]
	add_to_undo-list
	remove find/only main-list to-block first gui-list/picked

	picked: find gui-list/data first gui-list/picked
	clear gui-list/picked
	either tail? next picked [ ; is last line?
		append gui-list/picked first back picked
	][
		append gui-list/picked first next picked
	]
	remove picked

	update_list_and_layout
]
copy_selected: does [
	if empty? gui-list/data [exit]
	copied: copy first find/only main-list to-block first gui-list/picked
	remove copied ; remove line label
]
paste_selected: does [
	if empty? copied [exit]
	add_new_widget copied
]

add_to_undo-list: does [
	insert/only undo-list copy main-list
	if not empty? gui-list/picked [insert pick-list first gui-list/picked]
	saved?: no
]
undo: does [
	if empty? undo-list [exit]
	insert/only redo-list copy main-list
	append pick-list gui-list/picked
	main-list: take undo-list
	rebuild_gui-list
	if not empty? gui-list/data [
		append gui-list/picked either empty? pick-list [first gui-list/data][take pick-list]
	]
	update_list_and_layout
]
redo: does [
	if empty? redo-list [exit]
	insert/only undo-list copy main-list
	insert pick-list gui-list/picked
	main-list: take redo-list
	rebuild_gui-list
	if not empty? gui-list/data [
		append gui-list/picked either empty? pick-list [first gui-list/data][take/last pick-list]
	]
	update_list_and_layout
]

move_selected: func [/up /down /local picked dir new-index] [
	if empty? gui-list/data [exit]
	dir: either up [-1] [1]
	new-index: dir + index? picked: find gui-list/data first gui-list/picked
	if any [(new-index < 1) (new-index > length? gui-list/data)] [exit]

	add_to_undo-list
	move find/only main-list to-block first gui-list/picked dir

	move picked dir
	update_list_and_layout
]
replace_line: func [lab [string!] line [string!] /local old-line] [
	line: rejoin [lab line]
	if empty? gui-list/data [add_new_widget load line exit]
	old-line: find/only main-list to-block first gui-list/picked
	if (mold/only first old-line) = line [exit] ; unmodified line
	add_to_undo-list
	change/only old-line load line
	
	change/only find/only gui-list/data first gui-list/picked line
	append clear gui-list/picked line
	update_list_and_layout
]
select_line: func [dir [word!] /local old-index new-index] [
	if empty? gui-list/data [exit]
	dir: switch/default dir [
			up [-1]
			down [1]
			page-up [negate visible-lines]
			page-down [visible-lines]
			home [-10000] ; a great number
			end [10000] ; a great number
		] [exit]
	new-index: dir + old-index: index? find gui-list/data first gui-list/picked
	new-index: max 1 min new-index length? gui-list/data
	if new-index = old-index [exit]

	append clear gui-list/picked pick gui-list/data new-index
	show gui-list/update
	change_style
]
change_style: does [
	if empty? gui-list/data [
		clear edit-style/text
		clear lab
		exit
	]
	; avoid Ctrl to erase selection
	either empty? gui-list/picked [append gui-list/picked back-picked][back-picked: copy first gui-list/picked]
	selected-line: first gui-list/picked
	edit-style/text: copy line: find/tail selected-line " "
	lab: copy/part selected-line line
	show edit-style
	text-found?: no
]
rebuild_gui-list: func [/reset /local temp-list str-counter re-counter] [
	clear gui-list/data
	temp-list: main-list
	if main-list <> reduce [min-layout] [
		re-counter: 0
		forall temp-list [
			if reset [
				str-counter: reverse head change copy "0000" reverse to-string re-counter ; pad left with 0s
				head change first temp-list load rejoin ["L" str-counter ":"]
				re-counter: re-counter + 1
			]
			append gui-list/data mold/only first temp-list
		]
	]
	clear gui-list/picked
]
update_list_and_layout: does [
	; use a minimum layout to show a prettier window
	if empty? gui-list/data [main-list: reduce [min-layout]]

	show gui-list/update
	change_style
	
	;should I recycle ?
	new-win-layout: copy def-layout
	forall main-list [append new-win-layout load first main-list] ; reconstruct layout
	reopen_window
]

reopen_window: func [/local new-win-offset view-err?] [
	new-win-offset: new-win/offset
	unview/only new-win
	new-win: none
	new-win: layout new-win-layout 
	either counter = 1 [
		if error? try [view/new/title/options center-face new-win win-title win-options] [view-err?: true]
	][
		if error? try [view/new/title/offset/options new-win win-title new-win-offset win-options] [view-err?: true]
	]
	window/changes: 'activate
	either view-err? [undo clear redo-list focus edit-style] [focus window]
]
min-layout: [size 100x100]
new-win: layout min-layout
def-layout: [do [sp: 4x4] origin sp space sp]
new-win-layout: copy def-layout

spc: 4x4
rebuild_script: func [the-script /local temp-main-list] [
	temp-main-list: copy/deep main-list
	forall temp-main-list [remove first temp-main-list append the-script rejoin ["^-" mold/only first temp-main-list "^/"] ]
]
open_prefs: func [btn /local face] [
	win-options: copy temp-options
	foreach face win-checks/pane [
		if face/style = 'check-line [
			face/data: found? find win-options to-word face/text
		]
	]
	prefs-win-pos/text: new-win/offset
	prefs-win-size/text: new-win/size 
	prefs-win-title/text: new-win/text 
	field-min-size/text: either find win-options 'min-size [to-string win-options/min-size] [copy ""]
	inform/title/offset prefs-layout "" window/offset + btn/offset + (btn/size * 0x1)
]
set_prefs: does [
	remove/part find win-options 'min-size 2
	if (trim field-min-size/text) <> "" [append win-options reduce ['min-size to-pair field-min-size/text]]
	update_list_and_layout
	prefs-layout/changes: 'activate
	focus prefs-layout
]
prefs-layout: layout [
	origin 4x4 space 4x4 
	across
	text "Window pos:"
	prefs-win-pos: info 65 return
	text "Window size:"
	prefs-win-size: info 65
	below
	h4 "Window  title:" 
	prefs-win-title: field 150 [win-title: face/text set_prefs]
	h4 "Window options:"
	win-checks: panel [
		origin 0 space 4x4
		style check-line check-line [alter win-options to-word face/text set_prefs]
		check-line "no-title"
		check-line "no-border" 
		check-line "resize" 
		check-line "all-over" 
		check-line "activate-on-show"
	]
	Across 
	text "min-size"
	field-min-size: field 90 [either all [(trim face/text) <> "" error? try [face/text: to-string to-pair form reduce load face/text]] [focus face] [show face set_prefs]] return 
	btn 72 "OK" green + 50 [hide-popup temp-options: win-options]
	btn 72 "Cancel" [hide-popup win-options: temp-options update_list_and_layout]
]
find_in_list: func [face /local start line found] [
	if empty? gui-list/data [focus window exit]
	start: gui-list/data
	if all [text-found? text-searched = face/text] [start: next find gui-list/data gui-list/picked]
	foreach line start [if find line face/text [found: line break]]
	either found [
		append clear gui-list/picked found
		show gui-list/update
		change_style
		text-found?: yes
		text-searched: copy face/text
		focus face
	] [
		focus window ; to unfocus edit-style
	]
]
gadgets-layout: layout/offset [
	origin 0 space spc
	style box box 50x20 font [size: 12 color: black shadow: none]
	across
	button 78 "button" [add_new_widget widget_to_block [button] "New button"]
	toggle 78 "toggle" [add_new_widget [toggle "UP" "Down" sky water]]
	btn 40 "btn" [add_new_widget widget_to_block [btn] "New button"] return
	rotary 78 "rotary" [add_new_widget [rotary "item 1" "item 2" "item 3"]]
	choice 78 "choice" [add_new_widget [choice "choice 1" "choice 2" "choice 3"]]
	tog 40 "tog" [add_new_widget [tog " UP " "Down"]] return
	check-line "check" [add_new_widget widget_to_block [check-line] "check this"]
	radio-line "radio" [add_new_widget widget_to_block [radio-line] "choose this"]
	pad 0x4 led 12x12 [add_new_widget [led 12x12]] pad 0x-4 text "led" [add_new_widget [led 12x12]]
	label "sensor" [add_new_widget [sensor 0x0 keycode [#"^(ESC)"] [unview] ]] return
	arrow up [add_new_widget [arrow up]]
	arrow down [add_new_widget [arrow down]]
	arrow left [add_new_widget [arrow left]]
	arrow right [add_new_widget [arrow right]]
	box "box" white - 20 [add_new_widget [box white]]
	box "panel" edge [size: 1x1 effect: 'ibevel color: black] [add_panel] return
	label "Progress:" [add_new_widget [progress]] pad 0x4 progress 120 pad 0x-4  return
	label "Separator:" [add_new_widget [bar]] pad 0x10 bar 120 pad 0x-10 return
	label "Horizontal Slider:" [add_new_widget [slider 120x16 0.5]] pad 0x3 slider 50x16 0.5 return
	label "Vertical Slider:" [add_new_widget [slider 16x120 0.5]] pad 70x-30 slider 16x50 0.5 return
	label "Horizontal Scroller:" [add_new_widget [scroller 120x16 0.5]] scroller 50x16 0.5 return
	label "Vertical Scroller:" [add_new_widget [scroller 16x120 0.5]] pad 78x-30 scroller 16x50 0.5 return
	field 100 "field" [add_new_widget [field]]
	drop-down 100 with [text: "drop-down" list-data: ["item 1" "item 2" "item 3"]] [add_new_widget [drop-down 200 with [text: first list-data: ["item 1" "item 2" "item 3"]]] ] return
	area 100x48 "area" [add_new_widget [area 200x48]]
	text-list 100x48 data ["1st line" "2nd line" "3rd line" "4rd line"] [add_new_widget [text-list 200x48 "1st line"]] return
] spc
text-layout: layout/offset [
	origin 0 space spc
	below
	text "Normal text" [add_new_text [text]]
	text "Bold text" bold [add_new_text [text bold]]
	text "Italic text" italic [add_new_text [text italic]]
	text "Underlined text" underline [add_new_text [text underline]]
	label "Label text" [add_new_text [label]] return
	title "Title" [add_new_text [title]]
	h1 "Heading 1" [add_new_text [h1]]
	h2 "Heading 2" [add_new_text [h2]]
	h3 "Heading 3" [add_new_text [h3]]
	h4 "Heading 4" [add_new_text [h4]]
] spc
window: layout [
	style choice choice white - 20 font [style: none size: 11 colors: [0.0.0 255.150.55] shadow: none]
	origin spc space spc
	across
	btn "Load gui block" [load_gui]
	btn "Save as..." yellow [save_file]
	btn "Save as REBOL..." yellow [save_file/reb]
	btn "Reopen window" green + 100 [unview/only new-win view/new center-face new-win]
	btn "Prefs" [open_prefs face]
	btn "?" sky [browse docs] return
	btn "Undo" #"^z" [undo]
	btn "Redo" #"^r" [redo]
	btn "Copy gui to clipboard" [clear gui-script rebuild_script gui-script write clipboard:// to-string gui-script]
	btn "Clear gui" orange [if not empty? gui-list/picked [here-at: false add_to_undo-list clear main-list rebuild_gui-list update_list_and_layout]]
	text "Find:" para [origin: 2x4] field 80 [find_in_list face] return
	h3 "Choose auto-layout:" return
	choice "Across" "Below" 60x22 [add_new_widget reduce [to-word face/text]]
	btn "Return" [add_new_widget [return]]
	btn "Guide" [add_new_widget [guide]]
	btn "here: at" [add_new_widget [here: at] here-at: true]
	btn "at here" [either here-at [add_new_widget [at here]][alert {Add a "here: at"}]]
	btn "tab" [add_new_widget [tab]]
	choice "origin 10x10" "space 10x10" "pad 10x10" "tabs 100" "indent 10" 90x22 [add_new_widget load value]
	btn "style" [
		if not empty? gui-list/picked [
			add_new_widget reduce ['style this-style: second to-block first gui-list/picked this-style 'red]
		]
	] return
	h3 "Choose element to add:" return
	rotary "Gadgets" "Text" 220x24 gray + 100 font [colors: [0.0.0 255.150.55] shadow: none] [
		switch value [
			"Gadgets" 	[panels/pane: gadgets-layout show panels]
			"Text" 		[panels/pane: text-layout show panels]
		]
	]
	btn "Cut" #"^x" gadgets-layout/size / 3x1 * 1x0 + -16x24 [copy_selected remove_selected]
	btn "Copy" #"^c" gadgets-layout/size / 3x1 * 1x0 + -16x24 [copy_selected]
	btn "Paste" #"^v" gadgets-layout/size / 3x1 * 1x0 + -16x24 [paste_selected]
	arrow 'up 24x24 [move_selected/up] arrow 'down 24x24 [move_selected/down] return
	panels: box gadgets-layout/size + (spc * 4) edge [size: spc effect: 'ibevel] with [pane: gadgets-layout]
	gui-list: text-list panels/size data copy [] [change_style] with [
		update: func [/local item tot-rows visible-rows] [
			tot-rows: length? data visible-lines: visible-rows: lc
			sld/redrag visible-rows / max 1 tot-rows
			if item: find data picked/1 [
				either visible-rows >= tot-rows [
					sld/step: 0.0
					sld/data: 0.0
					sn: 0
				][
					sld/step: 1 / (tot-rows - visible-rows)
					sld/data: (index? item) / tot-rows ; simple but it works
					if sld/data < sld/step [sld/data: 0]
					sn: to-integer sld/data / sld/step
				]
			]
			self
		]
		append init [
			iter/para/origin: -40x0 ; hide labels (should be size-text something)
			sld/action: func [face value] [ ;patched
				if sn = value: max 0 to-integer value * ((length? slf/data) - lc) [exit] ; I always hated that "1 +" !
				sn: value 
				show sub-area
			]
		]
	] return
	h3 "Edit style:"
	key (escape) [ask-close]
	key keycode [f2] [if not empty? gui-list/data [focus edit-style]] return
	edit-style: field panels/size * 2x0 - 104x0 + 4x38 wrap [
		if (trim face/text) = "" [
			remove_selected
			exit
		]
		either attempt [layout to-block compose load face/text] [
			if (type? lab) <> string! [lab: copy/part selected-line line] ; "lab" used as get-word !!
			replace_line lab face/text
		] [
			focus edit-style
		]
	]
	choice "color" "gradient" "edge" "show?: no" "show?: yes" "comment" "uncomment"[
		if edit-style/text <> "" [
			switch value [
				"color" 	[repend edit-style/text [" " any [request-color ""]]]
				"gradient" 	[append edit-style/text { effect [gradient 200.0.0 0.0.200]}]
				"edge" 		[append edit-style/text { edge [size: 2x2 effect: 'bevel color: red]}]
				"show?: no" [either not sh?: find/tail edit-style/text "show?: " [append edit-style/text { with [show?:  no]}][change sh? " no"]]
				"show?: yes" [either not sh?: find/tail edit-style/text "show?: " [append edit-style/text { with [show?: yes]}][change sh? "yes"]]
				"comment" [if not find edit-style/text "comment" [insert edit-style/text {do [comment [} append edit-style/text {]]}]]
				"uncomment" [if find edit-style/text "do [comment [" [replace edit-style/text {do [comment [} "" remove/part back back tail edit-style/text 2]]
			]
			replace_line lab edit-style/text
		]
	] return
]
window/feel: make window/feel [
	detect: func [face event][
		case [
			event/type = 'key [
				if system/view/focal-face/feel = ctx-text/edit [ ; editing has precedence (if not escaping)
					either event/key = (escape) [change_style focus window return none][return event]
				]
				if face: find-key-face face event/key [
					if get in face 'action [do-face face event/key]
					return none
				]
				if word? event/key [select_line event/key]
				return none
			]
			event/type = 'scroll-line [either event/offset/y < 0 [select_line 'up] [select_line 'down] ]
			event/type = 'close [ask-close return none]
		]
		event
	]
]

ask-close: does [
	either not saved? [
		switch request ["Exit without saving?" "Yes" "Save" "No"] reduce [
			true [quit]
			false [if save_file [quit]]
		]
	][
		quit
	]
]
save_file: func [/reb /local file-name filt ext response script] [
	if empty? main-list [return false]

	either reb [
		filt: "*.r"
		ext: %.r
	][
		filt: "*.rbl"
		ext: %.rbl
	]
	file-name: request-file/title/keep/only/filter "Save as Rebol script" "Save" filt
	if equal? file-name none [return false]
	if not-equal? suffix? file-name ext [append file-name ext]
	response: true
	if exists? file-name [response: request/confirm rejoin [{File "} last split-path file-name {" already exists, overwrite it?}]]
	if response <> true [return false]
	flash join "Saving to: " file-name

	either reb [
		script: copy rejoin [{REBOL [{Automatically generated by VID_build. Author: Marco Antoniazzi}]
		^/^/view/title/options center-face layout [^/^-} mold/only def-layout "^/"]
		rebuild_script script
		append script rejoin [{] "} win-title {" [} win-options {]}]
		;print script
		write file-name script
	][
		insert main-list compose/only/deep ['VID_build_gui-block [counter (counter) win-title (win-title) win-options (win-options)]]
		save file-name main-list
		remove/part main-list 2
	]
	saved?: yes
	wait 2
	unview
	true
]
load_gui: func [/local file-name temp-list] [
	until [
		file-name: request-file/title/keep/only/filter "Load a gui block" "Load" "*.rbl"
		if equal? file-name none [exit]
		exists? file-name
	]
	temp-list: load file-name
	if not-equal? first temp-list 'VID_build_gui-block [exit]
	main-list: temp-list
	counter: second main-list
	clear win-options
	win-title: "VID_build"
	if block? counter [ ; compatibility
		win-prefs: counter
		counter: win-prefs/counter
		if (win-title: to-string win-prefs/win-title) = "" [win-title: "VID_build"]
		temp-options: win-options: win-prefs/win-options
	]
	remove/part main-list 2

	;counter: 0 ; always start with 0
	rebuild_gui-list/reset
	append gui-list/picked last gui-list/data
	update_list_and_layout
	undo-list: copy [] redo-list: copy []
	saved?: true
]

view/new/title/options window "VID_build" []

inform layout [text as-is trim/auto {
	This is a simple, fast VID GUI builder.
	The knowledge of REBOL VID System is required.

	Instructions:

		1) Click on some "styles" below the "Gadgets" button
		2) Experiment with the other elements
		3) Save the layout as a Rebol block or a Rebol program
	}
]
wait 0.3 ; to not confuse user
view/new center-face new-win
window/changes: 'activate
focus window
do-events