| View discussion [20 posts] | View script | License |
| Download script | History | Other scripts by: luce80 |
7-May 7:19 UTC
[0.053] 27.134k
[0.053] 27.134k
 | Archive version of: vid-build.r ... version: 7 ... luce80 3-Jan-2011Amendment 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-eventsNotes
|