Archive version of: vid-build.r ... version: 7 ... luce80 3-Jan-2011

Amendment note: Added a few keyboard shortcuts, undo, redo, prefs, help, clear and bug fixe || Publicly available? Yes

REBOL [
	Title: "VID_build"
	Date: 03-Jan-2011
	Version: 0.6.0
	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"]
	]
	Todo: {
	- add button to re-initialize labels
	- add "Save" button
	- show offset and size of window
	- save also offset of window
	- add panels (with tree-list or second text-list?)
	- add "Find" button
	}
	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
	]
]

counter: 0
line: ""
copied: []
main-list: copy []
undo-list: copy []
redo-list: copy []
pick-list: copy []
win-options: copy []
temp-options: copy []
win-title: "VID_build"
saved?: true
docs: http://www.rebol.com/docs/view-guide.html ; change to suit your needs
system/view/vid/error: func [msg spot] [to-error [msg]] ; patch VID error function to keep it silent
system/view/window-feel: make face/feel [ ; patch system/view/window-feel/detect function to not interfere with fields
	detect: func [face event][
		either all [
			event/type = 'key
			face: find-key-face face event/key
		][
			if get in face 'action [do-face face event/key]
			if system/view/focal-face/feel = ctx-text/edit [return event] ; <- added
			none
		][
			event
		]
	]
]

widget_to_block: func [widget [block!] text [string!]][
	join widget [join text form counter]
]
add_new_widget: func [new-widget [block!]] [
	insert new-widget load rejoin ["L" 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
	]

	clear gui-list/picked
	append 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 
	]
]

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 copy copied
]

add_to_undo-list: does [
	insert/only undo-list copy main-list
	insert pick-list gui-list/picked
	saved?: false
]
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_up_selected: does [
	if empty? gui-list/data [exit]
	if equal? first gui-list/data first gui-list/picked [exit]
	add_to_undo-list
	move find/only main-list to-block first gui-list/picked -1

	move find gui-list/data first gui-list/picked -1
	update_list_and_layout
]
move_down_selected: does [
	if empty? gui-list/data [exit]
	if equal? last gui-list/data first gui-list/picked [exit]
	add_to_undo-list
	move find/only main-list to-block first gui-list/picked 1

	move find gui-list/data first gui-list/picked 1
	update_list_and_layout
]
replace_line: func [lab [string!] line [string!]] [
	line: rejoin [lab line]
	if empty? gui-list/data [add_new_widget copy load line exit]
	add_to_undo-list
	change/only find/only main-list to-block first gui-list/picked load line
	
	change/only find/only gui-list/data first gui-list/picked line
	clear gui-list/picked
	append gui-list/picked line
	update_list_and_layout
]
change_style: does [
	if empty? gui-list/data [
		clear edit-style/text
		clear lab
		exit
	]
	selected-line: first gui-list/picked ; 
	edit-style/text: copy line: find/tail selected-line " "
	lab: copy/part selected-line line
	show edit-style
]
rebuild_gui-list: does [
	clear gui-list/data
	forall main-list [if main-list <> reduce [min-layout] [append gui-list/data mold/only first main-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]]

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

reopen_window: func [/local new-win-offset] [
	new-win-offset: new-win/offset
	unview/only new-win
	new-win: none
	new-win: layout new-win-layout 
	either counter = 1 [
		view/new/title/options center-face new-win win-title win-options
	][
		view/new/title/offset/options new-win win-title new-win-offset win-options
	]
	window/changes: 'activate
	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
open_prefs: func [btn /local face] [
	temp-options: copy win-options
	foreach face win-checks/pane [
		if face/style = 'check-line [
			face/data: found? find temp-options to-word face/text
		]
	]
	inform/title/offset prefs-layout "" window/offset + btn/offset + (btn/size * 0x1)
]
set_prefs: func [/local win-min-size] [
	remove/part find temp-options 'min-size 2
	if (trim field-min-size/text) <> "" [
		if error? try [win-min-size: to-pair field-min-size/text][focus field-min-size return]
		append temp-options reduce ['min-size win-min-size]
	]
	win-options: temp-options
	hide-popup
	update_list_and_layout
]
prefs-layout: layout [
	origin 4x4 space 4x4 
	h4 "Window  title:" 
	field 150 [win-title: face/text]
	h4 "Window options:"
	win-checks: panel [
		origin 0x0 space 4x4
		style check-line check-line [alter temp-options to-word face/text]
		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 error? try [to-pair face/text] [focus face] [show face]] return 
	btn 72 "OK" green + 50 [set_prefs]
	btn 72 "Cancel" [hide-popup]
]
gadgets-layout: layout/offset [
	origin 0 space spc
	across
	button 78 "button" [add_new_widget widget_to_block [button] "New button"]
	toggle 78 "toggle" [add_new_widget copy [toggle "UP" "Down" sky water]]
	btn 40 "btn" [add_new_widget widget_to_block [btn] "New button"] return
	rotary 78 "rotary" [add_new_widget copy [rotary "item 1" "item 2" "item 3"]]
	choice 78 "choice" [add_new_widget copy [choice "choice 1" "choice 2" "choice 3"]]
	tog 40 "tog" [add_new_widget copy [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 copy [led 12x12]] pad 0x-4 text "led" [add_new_widget copy [led 12x12]]
	label "sensor" [add_new_widget copy [sensor 0x0 keycode [#"^(ESC)"] [unview] ]] return
	arrow up [add_new_widget copy [arrow up]]
	arrow down [add_new_widget copy [arrow down]]
	arrow left [add_new_widget copy [arrow left]]
	arrow right [add_new_widget copy [arrow right]]
	box 100x20 "box" white - 20 font [size: 12 color: black shadow: none] [add_new_widget copy [box white]] return
	label "Progress:" [add_new_widget copy [progress]] pad 0x4 progress 120 pad 0x-4  return
	label "Separator:" [add_new_widget copy [bar]] pad 0x10 bar 120 pad 0x-10 return
	label "Horizontal Slider:" [add_new_widget copy [slider 120x16 with [data: 0.5]]] pad 0x3 slider 50x16 with [data: 0.5] return
	label "Vertical Slider:" [add_new_widget copy [slider 16x120 with [data: 0.5]]] pad 70x-30 slider 16x50 with [data: 0.5] return
	label "Horizontal Scroller:" [add_new_widget copy [scroller 120x16 with [data: 0.5]]] scroller 50x16 with [data: 0.5] return
	label "Vertical Scroller:" [add_new_widget copy [scroller 16x120 with [data: 0.5]]] pad 78x-30 scroller 16x50 with [data: 0.5] return
	field 100 "field" [add_new_widget copy [field]]
	drop-down 100 with [text: "drop-down" list-data: ["item 1" "item 2" "item 3"]] [add_new_widget copy [drop-down 200 with [text: first list-data: ["item 1" "item 2" "item 3"]]] ] return
	area 100x48 "area" [add_new_widget copy [area 200x48]]
	text-list 100x48 data ["1st line" "2nd line" "3rd line" "4rd line"] [add_new_widget copy [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 "Clear gui" orange [if not empty? gui-list/picked [add_to_undo-list clear main-list rebuild_gui-list update_list_and_layout]] return
	h3 "Choose auto-layout:" return
	choice "Across" "Below" 60x22 [add_new_widget copy reduce [to-word face/text]]
	btn "Return" [add_new_widget copy [return]]
	btn "Guide" [add_new_widget copy [guide]]
	btn "here: at" [add_new_widget copy [here: at]]
	btn "at here" [add_new_widget copy [at here]]
	btn "tab" [add_new_widget copy [tab]]
	choice "origin 10x10" "space 10x10" "pad 10x10" "tabs 100" "indent 10" 90x22 [add_new_widget copy load value]
	btn "style" [
		if not empty? gui-list/picked [
			add_new_widget copy 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 [if system/view/focal-face <> edit-style [copy_selected remove_selected]]
	btn "Copy" #"^c" gadgets-layout/size / 3x1 * 1x0 + -16x24 [if system/view/focal-face <> edit-style [copy_selected]]
	btn "Paste" #"^v" gadgets-layout/size / 3x1 * 1x0 + -16x24 [if system/view/focal-face <> edit-style [paste_selected]]
	arrow 'up 24x24 [move_up_selected] arrow 'down 24x24 [move_down_selected] return
	panels: box gadgets-layout/size + (spc * 4) edge [size: spc effect: 'ibevel]
	do [panels/pane: gadgets-layout   lab: " "]
	gui-list: text-list panels/size data copy [] [change_style] return
	h3 "Edit style:"
	key #"^(ESC)" [either system/view/focal-face = edit-style [change_style] [quit_prog window compose [type 'close face (window)]]] 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] [
			replace_line lab face/text
		] [
			focus edit-style
		]
	]
	choice "color" "gradient" "edge" [
		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]}]
			]
			replace_line lab edit-style/text
		]
	] return
]

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]
	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 reform [{REBOL [{Automatically generated by VID_build. Author: Marco Antoniazzi}]
		^/^/view/title/options center-face layout [^/^-} mold/only def-layout "^/"]
		forall main-list [remove first main-list append script reform ["^-" mold/only first main-list "^/"] ]
		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?: true
	wait 2
	unview
	true
]
load_gui: func [/local file-name temp-list] [
	file-name: request-file/title/keep/only/filter "Load a gui block" "Load" "*.rbl"
	if equal? file-name none [exit]
	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"]
		win-options: win-prefs/win-options
	]
	remove/part main-list 2

	rebuild_gui-list
	append gui-list/picked last gui-list/data
	update_list_and_layout
	undo-list: copy [] redo-list: copy []
	saved?: true
]

quit_prog: func [face event /local answer] [
    either all [event/type = 'close event/face = window][
		either not saved? [
			answer: request ["Exit without saving?" "Yes" "Save" "No"]
			case [ ; switch does NOT work! Rebol bug?
				answer = true [quit]
				answer = false [either save_file [quit] [none]]
				answer = none [none]
			]
		][
			quit
		]
	][
		event
	]
]
insert-event-func :quit_prog

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

inform layout [text as-is {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