Ren Datatype Survey (Dynamic GUI Example)

ren-type-survey.red

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