PasteRack.org
Paste # 60368
2018-04-08 23:26:35

Forked from paste # 61516.

Fork as a new paste.

Paste viewed 174 times.


Embed:

  1. #lang racket
  2.  
  3. (define bbgui ; main dialog for creation parameters
  4.   (class object%
  5.     (super-new)
  6.  
  7.     (define iTextVals ; text field defaults
  8.       '([GalaxyName   "Milky Way"]
  9.         [OriginSystem "Sol"]
  10.         [HomeWorld    "Earth"]
  11.         [Creator      ""]))
  12.  
  13.     (define iSliderVals ; slider defaults
  14.       '([GalaxySize   30  10  100]
  15.         [SpiralArms   2   1   7]
  16.         [Systems      700 100 1000]
  17.         [Planets      7   3   13]
  18.         [Chaos        17  3   42]
  19.         [Variance     43  0   100]))
  20.  
  21.     (define (slNew Parent key) ; slider generator
  22.       (new slider% [parent Parent]
  23.            [label (symbol->string key)]
  24.            [style '(vertical vertical-label)] [min-width 60]
  25.            [init-value (car (dict-ref iSliderVals key))]
  26.            [min-value (cadr (dict-ref iSliderVals key))]
  27.            [max-value (caddr (dict-ref iSliderVals key))]
  28.            [callback (λ (slider event)
  29.                        (send bbStatus set-label (~a (symbol->string key) " updated")))]))
  30.  
  31.     (define (txNew Parent key) ; Text field generator
  32.       (new text-field% [parent Parent]
  33.            [label (symbol->string key)]
  34.            [style '(single vertical-label)] [min-width 100]
  35.            [init-value (car (dict-ref iTextVals key))]
  36.            [callback (λ (text-field event)
  37.                        (send bbStatus set-label (~a (symbol->string key) " updated")))]))
  38.  
  39.     (define/public (reset) ; reset everything to initial values
  40.       (define ctrlset (append txts sliders))
  41.       (define ivset (append iTextVals iSliderVals))
  42.       (map (λ (control)
  43.              (send control set-value
  44.                    (car (dict-ref ivset (string->symbol (send control get-label))))))
  45.            ctrlset)
  46.       (send bbfrm refresh)) ; refresh needed to repaint text fields
  47.  
  48.     ; Stub output function
  49.     (define/public (read)
  50.       (map (λ (control)
  51.              (cons (string->symbol (send control get-label)) (send control get-value)))
  52.            (append txts sliders)))
  53.  
  54.     ; Begin Creating Objects
  55.     (define bbfrm (new frame% [label "Big Bang"])) ; create the main frame
  56.     (define bbTopStatus ; Make a top status field
  57.       (new message% [parent bbfrm] [label ""]))
  58.     (define mpanel (new horizontal-pane% [parent bbfrm])) ; main pane
  59.     (define slpanel (new horizontal-pane% [parent mpanel])) ; slider pane
  60.     (define txpanel (new vertical-pane% [parent mpanel])) ; text field pane
  61.     (define bbar (new horizontal-pane% [parent bbfrm])) ; button bar pane
  62.  
  63.     (define sliders '()) ; generate the slider set
  64.     (map (λ (key) (set! sliders (append sliders (list (slNew slpanel key)))))
  65.          (map (λ (k) (car k)) iSliderVals))
  66.  
  67.     (define txts '()) ; set up the text boxes
  68.     (map (λ (key) (set! txts (append txts (list (txNew txpanel key)))))
  69.          (map (λ (k) (car k)) iTextVals))
  70.  
  71.     (new button% [parent bbar] [label "Run"] ; Add a Run button
  72.          [callback (λ (button event)
  73.                      (send bbStatus set-label "Run was pressed")
  74.                      (displayln (read)))]) ; right now just output to console
  75.  
  76.     (new button% [parent bbar] [label "Reset"] ; Add a Reset button
  77.          [callback (λ (button event)
  78.                      (reset) ; call the function defined above
  79.                      (send bbStatus set-label "Reset was pressed"))])
  80.  
  81.     ; Make a status bar text message
  82.     (define bbStatus (new message% [parent bbfrm] [label "Defaults Loaded"]))
  83.  
  84.     (send bbfrm show #t))) ; finish up and display the window.
  85. ; end of bbgui definition
  86.  
  87. ; create an instance on startup
  88. (define bb (new bbgui))

=>

frame%: undefined;

 cannot reference an identifier before its definition

  in module: 'm