syndicate-lang
/
syndicate-gui-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

"Clip" shrinkable pushbuttons better. Still needs lots of work.

This commit is contained in:
Tony Garnock-Jones 2016-09-27 00:21:02 -04:00
parent 105646be57
commit 9bae5a3536
1 changed files with 10 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
gui.rkt
View File

@ -387,7 +387,7 @@
;; TODO: figure out what it is about (define (f #:x x) x) that ;; TODO: figure out what it is about (define (f #:x x) x) that
;; mandates begin-for-declarations to hide it from syndicate/lang's ;; mandates begin-for-declarations to hide it from syndicate/lang's
;; local-expansion here :-( ;; local-expansion here :-(
(define (pushbutton label-str x y (define (pushbutton label-str x y [w #f] [h #f]
#:shrink-x [shrink-x 0] #:shrink-x [shrink-x 0]
#:id id #:id id
#:parent parent-id #:parent parent-id
@ -399,8 +399,11 @@
(define/query-value touching? #f (inbound (touching id)) #t) (define/query-value touching? #f (inbound (touching id)) #t)
(on #:when (touching?) (message (inbound (mouse-event trigger-event $s))) (on #:when (touching?) (message (inbound (mouse-event trigger-event $s)))
(send! (button-click id s))) (send! (button-click id s)))
(assert (outbound (c 0 (rectangle (x) (y) (*width i) (*height i))))) (assert (outbound (c 0 (rectangle (x)
(box-size (sizing (*width i) 0 shrink-x) (sizing (*height i) 0 0)))) (y)
(or (and w (w)) (*width i))
(or (and h (h)) (*height i))))))
(box-size (sizing (*width i) 0 (* shrink-x (*width i))) (sizing (*height i) 0 0))))
;;--------------------------------------------------------------------------- ;;---------------------------------------------------------------------------
@ -517,18 +520,17 @@
(actor #:name 'window-list-monitor (actor #:name 'window-list-monitor
(during/actor (window-state $id $title _) (during/actor (window-state $id $title _)
#:name (list 'window-list id) #:name (list 'window-list id)
(field [x 0] [y 0]) (field [x 0] [y 0] [width #f] [height #f])
(define reqsize (define reqsize
(parameterize ((theme-button-y-padding 8) (parameterize ((theme-button-y-padding 8)
(theme-button-min-height 0) (theme-button-min-height 0)
(theme-button-background-color (hsv->color 240 1 0.6))) (theme-button-background-color (hsv->color 240 1 0.6)))
(pushbutton title x y #:id (list 'window-list id) #:parent 'toolbar (pushbutton title x y width height #:id (list 'window-list id) #:parent 'toolbar
#:shrink-x weak-fill #:shrink-x 1
#:trigger-event 'left-down))) #:trigger-event 'left-down)))
(during (layout-solution 'toolbar (horizontal-layout `(-5.0 ,id)) reqsize (during (layout-solution 'toolbar (horizontal-layout `(-5.0 ,id)) reqsize
(rectangle $l $t $w $h)) (rectangle $l $t $w $h))
(x l) (begin (x l) (y t) (width w) (height h))
(y t)
(during (top-widget id) (during (top-widget id)
(assert (outbound (sprite #:id (list 'window-list id 'highlight) (assert (outbound (sprite #:id (list 'window-list id 'highlight)
#:parent (list 'window-list id) #:parent (list 'window-list id)