diff options
| -rw-r--r-- | 2d/texture.scm | 38 |
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))) |