render: texture: Keep a rect for use with draw-sprite and friends.
authorDavid Thompson <dthompson2@worcester.edu>
Wed, 17 Jan 2018 19:20:14 +0000 (14:20 -0500)
committerDavid Thompson <dthompson2@worcester.edu>
Wed, 17 Jan 2018 19:20:14 +0000 (14:20 -0500)
Easier to calculate it once and hang onto it than to generate it each
time draw-sprite is called.

* chickadee/render/texture.scm (<texture>)[rect]: Delete field.
[x y width height gl-tex-rect]: New fields.
* chickadee/render/sprite.scm (draw-sprite*, draw-sprite,
draw-nine-patch*): Use proper accessors for texture rects.

chickadee/render/sprite.scm
chickadee/render/texture.scm

index 78a2ce5..9e96fc7 100644 (file)
@@ -329,7 +329,7 @@ void main (void) {
 
 (define* (draw-sprite* texture rect matrix #:key
                        (blend-mode 'alpha)
-                       (texcoords (texture-gl-rect texture))
+                       (texcoords (texture-gl-tex-rect texture))
                        (shader (force default-shader)))
   (if *batch?*
       (draw-sprite-batched texture rect matrix blend-mode
@@ -341,8 +341,7 @@ void main (void) {
 (define %default-scale (vec2 1.0 1.0))
 
 (define draw-sprite
-  (let ((matrix (make-null-matrix4))
-        (%rect (make-rect 0.0 0.0 0.0 0.0)))
+  (let ((matrix (make-null-matrix4)))
     (lambda* (texture
               position
               #:key
@@ -350,12 +349,7 @@ void main (void) {
               (scale %default-scale)
               (rotation 0.0)
               (blend-mode 'alpha)
-              ;; Default to an area that is the same size of the
-              ;; texture.  99% of the time that's what you want.
-              (rect (let ((r (texture-rect texture)))
-                      (set-rect-width! %rect (rect-width r))
-                      (set-rect-height! %rect (rect-height r))
-                      %rect))
+              (rect (texture-gl-rect texture))
               (shader (force default-shader)))
       "Draw TEXTURE at POSITION.
 
@@ -409,8 +403,8 @@ rendered entirely."
              (fill-y1 (+ border-y1 bottom-margin))
              (fill-x2 (- border-x2 right-margin))
              (fill-y2 (- border-y2 top-margin))
-             (prect (texture-rect texture))
-             (trect (texture-gl-rect texture))
+             (prect (texture-gl-rect texture))
+             (trect (texture-gl-tex-rect texture))
              (tw (rect-width prect))
              (th (rect-height prect))
              (border-s1 (rect-left trect))
index 63f5eaa..ba7233a 100644 (file)
             texture-mag-filter
             texture-wrap-s
             texture-wrap-t
-            texture-rect
+            texture-x
+            texture-y
+            texture-width
+            texture-height
             texture-gl-rect
+            texture-gl-tex-rect
             null-texture
             texture-set!
             texture-ref
@@ -62,7 +66,8 @@
 ;; The <texture> object is a simple wrapper around an OpenGL texture
 ;; id.
 (define-record-type <texture>
-  (%make-texture id parent min-filter mag-filter wrap-s wrap-t rect gl-rect)
+  (%make-texture id parent min-filter mag-filter wrap-s wrap-t
+                 x y width height gl-rect gl-tex-rect)
   texture?
   (id texture-id)
   (parent texture-parent)
   (mag-filter texture-mag-filter)
   (wrap-s texture-wrap-s)
   (wrap-t texture-wrap-t)
-  (rect texture-rect)
-  (gl-rect texture-gl-rect))
+  (x texture-x)
+  (y texture-y)
+  (width texture-width)
+  (height texture-height)
+  (gl-rect texture-gl-rect)
+  (gl-tex-rect texture-gl-tex-rect))
 
 (set-record-type-printer! <texture>
   (lambda (texture port)
     (format port
-            "#<texture region?: ~a rect: ~a min-filter: ~a mag-filter: ~a wrap-s: ~a wrap-t: ~a>"
+            "#<texture region?: ~a x: ~d y: ~d width: ~d height: ~d min-filter: ~a mag-filter: ~a wrap-s: ~a wrap-t: ~a>"
             (texture-region? texture)
-            (texture-rect texture)
+            (texture-x texture)
+            (texture-y texture)
+            (texture-width texture)
+            (texture-height texture)
             (texture-min-filter texture)
             (texture-mag-filter texture)
             (texture-wrap-s texture)
             (texture-wrap-t texture))))
 
 (define null-texture
-  (%make-texture 0 #f 'linear 'linear 'repeat 'repeat
+  (%make-texture 0 #f 'linear 'linear 'repeat 'repeat 0 0 0 0
                  (make-rect 0.0 0.0 0.0 0.0) (make-rect 0.0 0.0 0.0 0.0)))
 
 (define <<texture>> (class-of null-texture))
@@ -150,6 +162,7 @@ clamp-to-edge.  FORMAT specifies the pixel format.  Currently only
   (let ((texture (gpu-guard
                   (%make-texture (gl-generate-texture) #f
                                  min-filter mag-filter wrap-s wrap-t
+                                 0 0 width height
                                  (make-rect 0.0 0.0 width height)
                                  (make-rect 0.0 0.0 1.0 1.0)))))
     (texture-set! 0 texture)
@@ -180,22 +193,23 @@ clamp-to-edge.  FORMAT specifies the pixel format.  Currently only
 (define (make-texture-region texture rect)
   "Create a new texture region covering a section of TEXTURE defined
 by the bounding box RECT."
-  (let* ((parent-rect (texture-rect texture))
-         (pw (rect-width parent-rect))
-         (ph (rect-height parent-rect))
+  (let* ((pw (texture-width texture))
+         (ph (texture-height texture))
          (x (rect-x rect))
          (y (rect-y rect))
          (w (rect-width rect))
          (h (rect-height rect))
-         (gl-rect (make-rect (/ x pw) (/ y ph) (/ w pw) (/ h ph))))
+         (vert-rect (make-rect 0.0 0.0 w h))
+         (tex-rect (make-rect (/ x pw) (/ y ph) (/ w pw) (/ h ph))))
     (%make-texture (texture-id texture)
                    texture
                    (texture-min-filter texture)
                    (texture-mag-filter texture)
                    (texture-wrap-s texture)
                    (texture-wrap-t texture)
-                   rect
-                   gl-rect)))
+                   x y w h
+                   vert-rect
+                   tex-rect)))
 
 (define (flip-pixels-vertically pixels width height)
   "Create a new bytevector that reverses the rows in PIXELS, a WIDTH x
@@ -288,9 +302,8 @@ around its border.
 
 This type of texture atlas layout is very common for tile map
 terrain."
-  (let* ((r (texture-rect texture))
-         (w (inexact->exact (rect-width r)))
-         (h (inexact->exact (rect-height r)))
+  (let* ((w (texture-width texture))
+         (h (texture-height texture))
          (sw (/ tile-width w))
          (th (/ tile-height h))
          (rows (/ (- h margin) (+ tile-height spacing)))