Clean up raise protocol
This commit is contained in:
parent
0400385142
commit
1e9c90abd7
8
gui.rkt
8
gui.rkt
|
@ -73,14 +73,14 @@
|
||||||
))
|
))
|
||||||
(render-children)))))
|
(render-children)))))
|
||||||
|
|
||||||
(define (draggable-mixin touching? x y z)
|
(define (draggable-mixin touching? x y id-to-raise)
|
||||||
(define (idle)
|
(define (idle)
|
||||||
(react (stop-when #:when (touching?)
|
(react (stop-when #:when (touching?)
|
||||||
(message (inbound (mouse-event 'left-down (mouse-state $mx $my _ _ _))))
|
(message (inbound (mouse-event 'left-down (mouse-state $mx $my _ _ _))))
|
||||||
(dragging (- mx (x)) (- my (y))))))
|
(dragging (- mx (x)) (- my (y))))))
|
||||||
|
|
||||||
(define (dragging dx dy)
|
(define (dragging dx dy)
|
||||||
(z (- (current-inexact-milliseconds)))
|
(when id-to-raise (send! (raise-widget id-to-raise)))
|
||||||
(react (on (message (inbound (mouse-event 'motion (mouse-state $mx $my _ _ _))))
|
(react (on (message (inbound (mouse-event 'motion (mouse-state $mx $my _ _ _))))
|
||||||
(x (- mx dx))
|
(x (- mx dx))
|
||||||
(y (- my dy)))
|
(y (- my dy)))
|
||||||
|
@ -348,12 +348,12 @@
|
||||||
(field [z (- (current-inexact-milliseconds))])
|
(field [z (- (current-inexact-milliseconds))])
|
||||||
(define/query-value touching-title-bar?
|
(define/query-value touching-title-bar?
|
||||||
#f (inbound (touching `(,window-id title-bar))) #t)
|
#f (inbound (touching `(,window-id title-bar))) #t)
|
||||||
(on-start (draggable-mixin touching-title-bar? x y z))
|
(on-start (draggable-mixin touching-title-bar? x y window-id))
|
||||||
|
|
||||||
(when resizable?
|
(when resizable?
|
||||||
(define/query-value touching-resize-corner?
|
(define/query-value touching-resize-corner?
|
||||||
#f (inbound (touching `(,window-id resize-corner))) #t)
|
#f (inbound (touching `(,window-id resize-corner))) #t)
|
||||||
(on-start (draggable-mixin touching-resize-corner? width height z)))
|
(on-start (draggable-mixin touching-resize-corner? width height window-id)))
|
||||||
|
|
||||||
(define/query-value touching-close-icon?
|
(define/query-value touching-close-icon?
|
||||||
#f (inbound (touching `(,window-id close-icon))) #t)
|
#f (inbound (touching `(,window-id close-icon))) #t)
|
||||||
|
|
Loading…
Reference in New Issue