| PasteRack.org | ||
| Paste # 61516 | ||
| 2018-04-08 23:23:57 | ||
Fork as a new paste. | ||
Paste viewed 396 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))