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

Support transformations (e.g. rotation) in the scene prelude

This commit is contained in:
Tony Garnock-Jones 2019-04-25 12:58:30 +01:00
parent 759bbdf1c3
commit 419bd093d1
2 changed files with 24 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
syndicate/drivers/gl-2d.rkt
View File

@ -188,15 +188,18 @@
;; (Listof Touchable) ;; (Listof Touchable)
;; (Listof CoordinateMap) ;; (Listof CoordinateMap)
;; (Listof Resource) ;; (Listof Resource)
;; (Option TransformationMatrix)) ;; (Option TransformationMatrix)
;; TransformationMatrix)
;; A single compiled sprite. The resources and coordinate-maps aren't ;; A single compiled sprite. The resources and coordinate-maps aren't
;; in any particular order, but the touchables are: the leftmost ;; in any particular order, but the touchables are: the leftmost
;; touchable is the first to check; that is, it is the *topmost* ;; touchable is the first to check; that is, it is the *topmost*
;; touchable in this sprite. The child-xform, if present, is the ;; touchable in this sprite. The child-xform, if present, is the
;; transformation needed to map between mouse coordinates and child ;; transformation needed to map between mouse coordinates and child
;; sprite space; if absent, no (render-children) instruction was found ;; sprite space; if absent, no (render-children) instruction was found
;; in this sprite's render code. ;; in this sprite's render code. The final-xform is the final
(struct compiled-instructions (render-proc touchables coordinate-maps resources child-xform)) ;; transformation after the render instructions have completed.
(struct compiled-instructions
(render-proc touchables coordinate-maps resources child-xform final-xform))
(define-namespace-anchor ns-anchor) (define-namespace-anchor ns-anchor)
(define ns (namespace-anchor->namespace ns-anchor)) (define ns (namespace-anchor->namespace ns-anchor))
@ -270,7 +273,8 @@
touchables touchables
coordinate-maps coordinate-maps
resources resources
child-xform)) child-xform
final-transformation))
;; (define (compile-instructions instrs) ;; (define (compile-instructions instrs)
;; (define touchables '()) ;; (define touchables '())
@ -608,8 +612,10 @@
(define/override (on-event mouse) (define/override (on-event mouse)
(with-gl-context (with-gl-context
(lambda () (lambda ()
(define x (send mouse get-x)) (define-values (x y)
(define y (send mouse get-y)) (untransform-point* (compiled-instructions-final-xform prelude)
(send mouse get-x)
(send mouse get-y)))
(define s (mouse-state x (define s (mouse-state x
y y
(send mouse get-left-down) (send mouse get-left-down)

15
syndicate/examples/gui/gui.rkt
View File

@ -102,8 +102,14 @@
(define/query-value touching? #f (touching 'root) #t) (define/query-value touching? #f (touching 'root) #t)
(on #:when (touching?) (message (mouse-event 'right-down (mouse-state $x $y _ _ _))) (on #:when (touching?) (message (mouse-event 'right-down (mouse-state $x $y _ _ _)))
(send! (pop-up-menu-trigger 'system-menu x y 0 0.5 'right-up))) (send! (pop-up-menu-trigger 'system-menu x y 0 0.5 'right-up)))
;; (during (window $width $height)
;; (assert-scene `((translate ,width 0) (rotate -90)) `())
;; (assert (desktop height width))
;; (assert (c 0 (rectangle 0 0 height width))))
(during (window $width $height) (during (window $width $height)
(assert (c 0 (rectangle 0 0 width height))))) (assert (desktop width height))
(assert (c 0 (rectangle 0 0 width height))))
)
(define (button-underlay i) (define (button-underlay i)
(define w (+ (*width i) (theme-button-x-padding))) (define w (+ (*width i) (theme-button-x-padding)))
@ -172,6 +178,9 @@
size size
rectangle) #:transparent) rectangle) #:transparent)
;; ASSERTION. Describes the size of the desktop area.
(struct desktop (width height) #:transparent)
;;--------------------------------------------------------------------------- ;;---------------------------------------------------------------------------
(struct layout-item (spec size) #:transparent) (struct layout-item (spec size) #:transparent)
@ -528,7 +537,7 @@
(assert (menu-item/text 'testmenu 1 "Second item" '(testmenu second))) (assert (menu-item/text 'testmenu 1 "Second item" '(testmenu second)))
(assert (menu-item/text 'testmenu 2 "Third item" '(testmenu third))) (assert (menu-item/text 'testmenu 2 "Third item" '(testmenu third)))
(during (window $width $height) (during (desktop $width $height)
(on (message `(testmenu ,$which)) (on (message `(testmenu ,$which))
(define box-id (gensym 'box)) (define box-id (gensym 'box))
(message-box #:id box-id (message-box #:id box-id
@ -568,7 +577,7 @@
(spawn #:name 'toolbar (spawn #:name 'toolbar
(field [window-width 0] [window-height 0]) (field [window-width 0] [window-height 0])
(on (asserted (window $w $h)) (on (asserted (desktop $w $h))
(window-width w) (window-width w)
(window-height h)) (window-height h))