Minor tweaks to toolbar layout

This commit is contained in:
Tony Garnock-Jones 2016-09-26 16:02:36 -04:00
parent d9f8ad637f
commit 3c57b71ed2
1 changed files with 11 additions and 7 deletions

18
gui.rkt
View File

@ -2,6 +2,7 @@
(require racket/set)
(require data/order)
(require srfi/19)
(require (prefix-in i: 2htdp/image))
(require (prefix-in p: pict))
(require syndicate-gl/2d)
@ -285,7 +286,7 @@
;;---------------------------------------------------------------------------
(struct window-state (window-id state) #:transparent)
(struct window-state (window-id title state) #:transparent)
(struct raise-widget (id) #:transparent)
(define close-icon-i
@ -362,7 +363,7 @@
(z (- (current-inexact-milliseconds))))
(define/dataflow bounds (rectangle (x) (y) (width) (height)) #:default zero-rectangle)
(assert (window-state window-id (bounds)))
(assert (window-state window-id window-title (bounds)))
(assert (outbound (c (z) (bounds)))))
;;---------------------------------------------------------------------------
@ -423,7 +424,9 @@
(on (message `(testmenu ,$which))
(define box-id (gensym 'box))
(message-box #:id box-id
"Menu item selected" (random width) (random height)
(date->string (seconds->date (current-seconds))
"Selected at ~3")
(random width) (random height)
(format "~a" which))))
(pushbutton "Click me"
@ -465,7 +468,8 @@
(define pad2 (* pad 2))
(assert (requested-layout-size 'toolbar (box-size (sizing (- (window-width) pad2) 0 0) #f)))
(assert (observe (layout-solution 'toolbar (horizontal-layout 0) weak-fill-box-size _)))
(assert (observe
(layout-solution 'toolbar (horizontal-layout '(0.0 0.0)) weak-fill-box-size _)))
(during (computed-layout-size 'toolbar (box-size (sizing $w _ _) (sizing $h _ _)))
(assert (outbound
@ -485,7 +489,8 @@
(theme-button-min-height 0))
(pushbutton "Start" x y #:id 'start-button #:parent 'toolbar
#:trigger-event 'left-down)))
(during (layout-solution 'toolbar (horizontal-layout -10) reqsize (rectangle $l $t $w $h))
(during (layout-solution 'toolbar (horizontal-layout '(-10.0 0.0)) reqsize
(rectangle $l $t $w $h))
(x l)
(y t)
;; TODO: Some way of getting hold of various stages of
@ -500,10 +505,9 @@
(on (message (inbound (frame-event _ $timestamp _ _)))
(define new (current-seconds))
(when (not (= new (now))) (now new)))
(local-require srfi/19)
(define/dataflow now-im (system-text (date->string (seconds->date (now)) "~a ~b ~d, ~3"))
#:default i:empty-image)
(during (layout-solution 'toolbar (horizontal-layout 10)
(during (layout-solution 'toolbar (horizontal-layout '(10.0 0.0))
(box-size (sizing (*width (now-im)) 0 0)
(sizing (*height (now-im)) 0 0))
(rectangle $l $t $w $h))