utilize define-spawns to clean up 7-GUIS examples

This commit is contained in:
Sam Caldwell 2019-07-25 15:02:48 -04:00
parent 0e44970bef
commit 8949193977
8 changed files with 10 additions and 25 deletions

View File

@ -5,9 +5,6 @@
;; a mouse-click counter ;; a mouse-click counter
(spawn
(on-start
(define frame (spawn-frame #:label "Counter")) (define frame (spawn-frame #:label "Counter"))
(define pane (spawn-horizontal-pane #:parent frame)) (define pane (spawn-horizontal-pane #:parent frame))
(define view (spawn-text-field #:parent pane #:label "" #:init-value "0" #:enabled #f #:min-width 100)) (define view (spawn-text-field #:parent pane #:label "" #:init-value "0" #:enabled #f #:min-width 100))
@ -19,7 +16,7 @@
(counter (add1 (counter))) (counter (add1 (counter)))
(send! (set-text-field view (~a (counter))))) (send! (set-text-field view (~a (counter)))))
(on-start (on-start
(send! (show frame #t)))))) (send! (show frame #t))))
(module+ main (module+ main
(void)) (void))

View File

@ -28,8 +28,6 @@
(send! (set-text-field-background to-field "white")) (send! (set-text-field-background to-field "white"))
(send! (set-text-field to-field (~a (~r *to #:precision 4) (if (eq? #\. last) "." ""))))) (send! (set-text-field to-field (~a (~r *to #:precision 4) (if (eq? #\. last) "." "")))))
(spawn
(on-start
(define frame (spawn-frame #:label "temperature converter")) (define frame (spawn-frame #:label "temperature converter"))
(define pane (spawn-horizontal-pane #:parent frame)) (define pane (spawn-horizontal-pane #:parent frame))
@ -58,4 +56,4 @@
(on (message (text-field-update F-field $val)) (on (message (text-field-update F-field $val))
(fahrenheit->celsius F-field val)) (fahrenheit->celsius F-field val))
(on-start (on-start
(send! (show frame #t)))))) (send! (show frame #t))))

View File

@ -19,7 +19,6 @@
(define RED "red") (define RED "red")
(define WHITE "white") (define WHITE "white")
(spawn
(define (make-field enabled) (define (make-field enabled)
(spawn-text-field #:parent frame (spawn-text-field #:parent frame
#:label "" #:label ""
@ -66,4 +65,3 @@
(on-start (send! (show frame #t)) (on-start (send! (show frame #t))
(enable-return-book (*kind-flight)))) (enable-return-book (*kind-flight))))
)

View File

@ -16,8 +16,6 @@
(define (next-time) (+ (current-milliseconds) INTERVAL)) (define (next-time) (+ (current-milliseconds) INTERVAL))
(spawn
(define frame (spawn-frame #:label "timer")) (define frame (spawn-frame #:label "timer"))
(define elapsed (spawn-gauge #:label "elapsed" #:parent frame #:enabled #f #:range 100)) (define elapsed (spawn-gauge #:label "elapsed" #:parent frame #:enabled #f #:range 100))
(define text (spawn-text-field #:parent frame #:init-value "0" #:label "")) (define text (spawn-text-field #:parent frame #:init-value "0" #:label ""))
@ -58,5 +56,3 @@
(duration-cb val)) (duration-cb val))
(on-start (elapsed-cb) (on-start (elapsed-cb)
(send! (show frame #t)))) (send! (show frame #t))))
)

View File

@ -8,7 +8,6 @@
;; a create-read-update-deleted MVC implementation ;; a create-read-update-deleted MVC implementation
;; --------------------------------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------------------------------
(spawn
(define frame (spawn-frame #:label "CRUD")) (define frame (spawn-frame #:label "CRUD"))
(define hpane1 (spawn-horizontal-pane #:parent frame #:border 10 #:alignment '(left bottom))) (define hpane1 (spawn-horizontal-pane #:parent frame #:border 10 #:alignment '(left bottom)))
(define vpane1 (spawn-vertical-pane #:parent hpane1)) (define vpane1 (spawn-vertical-pane #:parent hpane1))
@ -70,5 +69,3 @@
(on-start (prefix-cb "") (on-start (prefix-cb "")
(send! (show frame #t)))) (send! (show frame #t))))
)

View File

@ -193,7 +193,6 @@
(spawn-slider #:parent parent #:label "" #:min-value 10 #:max-value 100 #:init-value init-value)) (spawn-slider #:parent parent #:label "" #:min-value 10 #:max-value 100 #:init-value init-value))
;; --------------------------------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------------------------------
(spawn
(define frame (spawn-frame #:label "Circle Drawer" #:width 400)) (define frame (spawn-frame #:label "Circle Drawer" #:width 400))
(define hpane1 (spawn-horizontal-pane #:parent frame #:min-height 20 #:alignment '(center center))) (define hpane1 (spawn-horizontal-pane #:parent frame #:min-height 20 #:alignment '(center center)))
(define undo-but (spawn-button #:label "Undo" #:parent hpane1)) (define undo-but (spawn-button #:label "Undo" #:parent hpane1))
@ -201,6 +200,7 @@
(define hpane2 (spawn-horizontal-panel #:parent frame #:min-height 400 #:alignment '(center center))) (define hpane2 (spawn-horizontal-panel #:parent frame #:min-height 400 #:alignment '(center center)))
(define canvas (spawn-circle-canvas hpane2 frame undo-but redo-but)) (define canvas (spawn-circle-canvas hpane2 frame undo-but redo-but))
(on (asserted (frame@ frame)) (spawn
(send! (show frame #t))) (on (asserted (frame@ frame))
) (send! (show frame #t))
(stop-current-facet)))

View File

@ -86,11 +86,11 @@
)) ))
;; --------------------------------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------------------------------
(spawn
(define frame (spawn-frame #:label "Cells" #:width (/ WIDTH 2) #:height (/ HEIGHT 3))) (define frame (spawn-frame #:label "Cells" #:width (/ WIDTH 2) #:height (/ HEIGHT 3)))
(define canvas (spawn-cells-canvas frame WIDTH HEIGHT)) (define canvas (spawn-cells-canvas frame WIDTH HEIGHT))
(spawn-control frame) (spawn-control frame)
(on (asserted (frame@ frame)) (spawn
(send! (show frame #t))) (on (asserted (frame@ frame))
) (send! (show frame #t))
(stop-current-facet)))

View File

@ -197,7 +197,6 @@
(define parent-component (seal-contents parent)) (define parent-component (seal-contents parent))
(define (inject-text-field-update! _ evt) (define (inject-text-field-update! _ evt)
(printf "inject-text-field-update!\n")
(case (send evt get-event-type) (case (send evt get-event-type)
[(text-field) [(text-field)
(send-ground-message (text-field-update id (send tf get-value)))] (send-ground-message (text-field-update id (send tf get-value)))]