summaryrefslogtreecommitdiff
path: root/2d
diff options
context:
space:
mode:
Diffstat (limited to '2d')
-rw-r--r--2d/texture.scm38
1 files changed, 37 insertions, 1 deletions
diff --git a/2d/texture.scm b/2d/texture.scm
index 9f53966..0db72a2 100644
--- a/2d/texture.scm
+++ b/2d/texture.scm
@@ -32,7 +32,16 @@
texture-height
surface->texture
load-texture
- texture-quad))
+ texture-quad
+ make-texture-region
+ texture-region?
+ texture-region-texture
+ texture-region-width
+ texture-region-height
+ texture-region-u
+ texture-region-v
+ texture-region-u2
+ texture-region-v2))
;; The <texture> object is a simple wrapper around an OpenGL texture
;; id.
@@ -114,3 +123,30 @@ Currently only works with RGBA format surfaces."
(gl-vertex x2 y2)
(gl-texture-coordinates 0 1)
(gl-vertex x y2)))))
+
+;;;
+;;; Texture Regions
+;;;
+
+;; Texture regions represent a segment of a texture.
+
+(define-record-type <texture-region>
+ (%make-texture-region texture width height u v u2 v2)
+ texture-region?
+ (texture texture-region-texture)
+ (width texture-region-width)
+ (height texture-region-height)
+ (u texture-region-u)
+ (v texture-region-v)
+ (u2 texture-region-u2)
+ (v2 texture-region-v2))
+
+(define (make-texture-region texture x y width height)
+ "Creates a new texture region given a texture and a pixel region."
+ (let* ((w (texture-width texture))
+ (h (texture-height texture))
+ (u (/ x w))
+ (v (/ y h))
+ (u2 (/ (+ x width) w))
+ (v2 (/ (+ y height) h)))
+ (%make-texture-region texture width height u v u2 v2)))