Minor tweaks to toolbar layout
This commit is contained in:
parent
d9f8ad637f
commit
3c57b71ed2
18
gui.rkt
18
gui.rkt
|
@ -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))
|
||||
|
|
Loading…
Reference in New Issue