Simplify transform composition

This commit is contained in:
Tony Garnock-Jones 2016-09-02 09:50:48 +01:00
parent b60fa8c755
commit a6f002c27d
1 changed files with 4 additions and 7 deletions

View File

@ -180,16 +180,13 @@
(match instr (match instr
[`(rotate ,(? number? deg)) [`(rotate ,(? number? deg))
(values `(glRotated ,deg 0 0 -1) '() '() (values `(glRotated ,deg 0 0 -1) '() '()
(compose-transformation (invert-transformation (rotation-transformation deg)) (compose-transformation xform (rotation-transformation deg)))]
xform))]
[`(scale ,(? number? x) ,(? number? y)) [`(scale ,(? number? x) ,(? number? y))
(values `(glScaled ,x ,y 1) '() '() (values `(glScaled ,x ,y 1) '() '()
(compose-transformation (invert-transformation (stretching-transformation x y)) (compose-transformation xform (stretching-transformation x y)))]
xform))]
[`(translate ,(? number? x) ,(? number? y)) [`(translate ,(? number? x) ,(? number? y))
(values `(glTranslated ,x ,y 0) '() '() (values `(glTranslated ,x ,y 0) '() '()
(compose-transformation (invert-transformation (translation-transformation x y)) (compose-transformation xform (translation-transformation x y)))]
xform))]
[`(color ,(? color-number? r) ,(? color-number? g) ,(? color-number? b) ,(? color-number? a)) [`(color ,(? color-number? r) ,(? color-number? g) ,(? color-number? b) ,(? color-number? a))
(values `(glColor4d ,r ,g ,b ,a) '() '() xform)] (values `(glColor4d ,r ,g ,b ,a) '() '() xform)]
[`(texture ,i) [`(texture ,i)
@ -301,7 +298,7 @@
(define (detect-touch* ci x y state) (define (detect-touch* ci x y state)
(for/or [(t (in-list (compiled-instructions-touchables ci)))] (for/or [(t (in-list (compiled-instructions-touchables ci)))]
(match-define (touchable id xform contains?) t) (match-define (touchable id xform contains?) t)
(define user-point (transform-point xform (make-rectangular x y))) (define user-point (untransform-point xform (make-rectangular x y)))
(define ux (real-part user-point)) (define ux (real-part user-point))
(define uy (imag-part user-point)) (define uy (imag-part user-point))
(and (contains? ux uy) (touching id ux uy state)))) (and (contains? ux uy) (touching id ux uy state))))