render: texture: Keep a rect for use with draw-sprite and friends.
[chickadee.git] / chickadee / render / texture.scm
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)))