Support transformations (e.g. rotation) in the scene prelude
This commit is contained in:
parent
cd290500e7
commit
bc5c26ba1d
|
@ -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)
|
||||
|
|
|
@ -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))
|
||||
|
||||
|
|
Loading…
Reference in New Issue