Skip to content

Instantly share code, notes, and snippets.

@greggirwin
Created January 13, 2022 19:50
Show Gist options
  • Save greggirwin/9c32a31a366631ce159d2ac1d5fb89f8 to your computer and use it in GitHub Desktop.
Save greggirwin/9c32a31a366631ce159d2ac1d5fb89f8 to your computer and use it in GitHub Desktop.
Ren Datatype Survey (Dynamic GUI Example)
Red []
; We should give our survey a name so we can identify
; responses for it.
survey-name: "Ren datatype survey"
types: [
none
true
false
string
multi-line-string
object
map
date
time
money
percent
email
url
file
]
; This is a support function that helps reduce redundancy
; in the dynamic name-generation aspects of our GUI.
make-face-name: func [face-key [word!] key [word!] type [datatype!]] [
to type rejoin [face-key key]
]
make-fld-name: func [key [word!] type [datatype!]] [
make-face-name 'fld- key type
]
make-lbl-name: func [key [word!] type [datatype!]] [
make-face-name 'lbl- key type
]
; This gathers information from the screen. Our GUI has
; many dynamically generated elements; this approach uses
; a named face as a marker and finds related faces from
; its position.
gather-data: has [result pos sld-1 sld-2 fld-notes] [
result: copy []
foreach type types [
pos: find lay/pane get make-lbl-name type word!
sld-1: first skip pos 1
sld-2: first skip pos 2
fld-notes: first skip pos 3
append result reduce [
type
round/to sld-1/data .01
round/to sld-2/data .01
fld-notes/data
]
]
result
]
; VIEW-DATA is mainly for testing, but if you want to
; let the users preview what's being sent back, you can
; include it for them as well.
view-data: does [
view compose [
area 500 (mold gather-data)
button "Close" [unview]
]
]
;-------------------------------------------------------------------------------
lay-spec: [
across space 4x2
pad 0x8
text "Your name:" f-username: field 190
pad 40x0
hdr: text bold 600 "How strongly do you feel about what types Ren MUST and SHOULD support?"
return
pad 0x26
text 135 "Type / Support"
text 125 center "MUST"
text 125 center "SHOULD"
text "NOTES"
pad 200x0
style button: button 75x19
button "Save" #"^s" [save-results f-username/data survey-name gather-data]
button "Quit" #"^q" [quit]
button "View Data" #"^d" [view-data]
return pad 0x1
style sld: slider 125x19
style field: field 500x19
]
; Dynamic labels and sliders (using sld style above)
foreach type types [
append lay-spec compose [
(make-lbl-name type set-word!) text 135 (form type)
sld sld (make-fld-name type set-word!) field return
]
]
save-results: func [username survey-name data] [
if empty? username [
alert "You must enter a username (used to name your results file)."
exit
]
save rejoin [%survey-results/ survey-name "__" username %.dat] data
]
; Static buttons
;append lay-spec [
; pad 0x10
; button "Save" [save-results get-face f-username survey-name gather-data]
; button "Quit" #"^q" [quit]
; button "View Data" [view-data]
;]
;print mold lay-spec ;<< Uncomment to see generated spec
view/no-wait lay: layout lay-spec
set-focus f-username
do-events
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment