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 CoordinateMap)
;; (Listof Resource)
;; (Option TransformationMatrix))
;; (Option TransformationMatrix)
;; TransformationMatrix)
;; A single compiled sprite. The resources and coordinate-maps aren't
;; in any particular order, but the touchables are: the leftmost
;; touchable is the first to check; that is, it is the *topmost*
;; touchable in this sprite. The child-xform, if present, is the
;; transformation needed to map between mouse coordinates and child
;; sprite space; if absent, no (render-children) instruction was found
;; in this sprite's render code.
(struct compiled-instructions (render-proc touchables coordinate-maps resources child-xform))
;; in this sprite's render code. The final-xform is the final
;; 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 ns (namespace-anchor->namespace ns-anchor))
@ -270,7 +273,8 @@
touchables
coordinate-maps
resources
child-xform))
child-xform
final-transformation))
;; (define (compile-instructions instrs)
;; (define touchables '())
@ -608,8 +612,10 @@
(define/override (on-event mouse)
(with-gl-context
(lambda ()
(define x (send mouse get-x))
(define y (send mouse get-y))
(define-values (x y)
(untransform-point* (compiled-instructions-final-xform prelude)
(send mouse get-x)
(send mouse get-y)))
(define s (mouse-state x
y
(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)
(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)))
;; (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)
(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 w (+ (*width i) (theme-button-x-padding)))
@ -172,6 +178,9 @@
size
rectangle) #:transparent)
;; ASSERTION. Describes the size of the desktop area.
(struct desktop (width height) #: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 2 "Third item" '(testmenu third)))
(during (window $width $height)
(during (desktop $width $height)
(on (message `(testmenu ,$which))
(define box-id (gensym 'box))
(message-box #:id box-id
@ -568,7 +577,7 @@
(spawn #:name 'toolbar
(field [window-width 0] [window-height 0])
(on (asserted (window $w $h))
(on (asserted (desktop $w $h))
(window-width w)
(window-height h))