PasteRack.org | ||
Paste # 61516 | ||
2018-04-08 23:23:57 | ||
Fork as a new paste. | ||
Paste viewed 367 times. | ||
Tweet | ||
Embed: | ||
#lang racket/gui (define bbgui ; main dialog for creation parameters (class object% (super-new) (define iTextVals ; text field defaults '([GalaxyName "Milky Way"] [OriginSystem "Sol"] [HomeWorld "Earth"] [Creator ""])) (define iSliderVals ; slider defaults '([GalaxySize 30 10 100] [SpiralArms 2 1 7] [Systems 700 100 1000] [Planets 7 3 13] [Chaos 17 3 42] [Variance 43 0 100])) (define (slNew Parent key) ; slider generator (new slider% [parent Parent] [label (symbol->string key)] [style '(vertical vertical-label)] [min-width 60] [init-value (car (dict-ref iSliderVals key))] [min-value (cadr (dict-ref iSliderVals key))] [max-value (caddr (dict-ref iSliderVals key))] [callback (λ (slider event) (send bbStatus set-label (~a (symbol->string key) " updated")))])) (define (txNew Parent key) ; Text field generator (new text-field% [parent Parent] [label (symbol->string key)] [style '(single vertical-label)] [min-width 100] [init-value (car (dict-ref iTextVals key))] [callback (λ (text-field event) (send bbStatus set-label (~a (symbol->string key) " updated")))])) (define/public (reset) ; reset everything to initial values (define ctrlset (append txts sliders)) (define ivset (append iTextVals iSliderVals)) (map (λ (control) (send control set-value (car (dict-ref ivset (string->symbol (send control get-label)))))) ctrlset) (send bbfrm refresh)) ; refresh needed to repaint text fields ; Stub output function (define/public (read) (map (λ (control) (cons (string->symbol (send control get-label)) (send control get-value))) (append txts sliders))) ; Begin Creating Objects (define bbfrm (new frame% [label "Big Bang"])) ; create the main frame (define bbTopStatus ; Make a top status field (new message% [parent bbfrm] [label ""])) (define mpanel (new horizontal-pane% [parent bbfrm])) ; main pane (define slpanel (new horizontal-pane% [parent mpanel])) ; slider pane (define txpanel (new vertical-pane% [parent mpanel])) ; text field pane (define bbar (new horizontal-pane% [parent bbfrm])) ; button bar pane (define sliders '()) ; generate the slider set (map (λ (key) (set! sliders (append sliders (list (slNew slpanel key))))) (map (λ (k) (car k)) iSliderVals)) (define txts '()) ; set up the text boxes (map (λ (key) (set! txts (append txts (list (txNew txpanel key))))) (map (λ (k) (car k)) iTextVals)) (new button% [parent bbar] [label "Run"] ; Add a Run button [callback (λ (button event) (send bbStatus set-label "Run was pressed") (displayln (read)))]) ; right now just output to console (new button% [parent bbar] [label "Reset"] ; Add a Reset button [callback (λ (button event) (reset) ; call the function defined above (send bbStatus set-label "Reset was pressed"))]) ; Make a status bar text message (define bbStatus (new message% [parent bbfrm] [label "Defaults Loaded"])) (send bbfrm show #t))) ; finish up and display the window. ; end of bbgui definition ; create an instance on startup (define bb (new bbgui))