From 1c9f242098b2282f5f00efd83ff3f85e3143bb73 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sun, 16 Feb 2014 10:10:19 -0500
Subject: Move texture anchor procedure.

* 2d/sprite.scm (make-anchor): Delete it.
* 2d/texture.scm (anchor-texture): New procedure.
---
 2d/sprite.scm  | 16 ++--------------
 2d/texture.scm | 15 ++++++++++++++-
 2 files changed, 16 insertions(+), 15 deletions(-)

(limited to '2d')

diff --git a/2d/sprite.scm b/2d/sprite.scm
index b8f62ee..6ad7a5c 100644
--- a/2d/sprite.scm
+++ b/2d/sprite.scm
@@ -85,18 +85,6 @@
   (vertices sprite-vertices)
   (animator sprite-animator))
 
-(define (make-anchor anchor texture)
-  "Return a vector2 of the coordinates for the center point of a
-sprite."
-  (cond
-   ((vector2? anchor)
-    anchor)
-   ((eq? anchor 'center)
-    (vector2 (/ (texture-width texture) 2)
-             (/ (texture-height texture) 2)))
-   (else
-    (error "Invalid sprite anchor!" anchor))))
-
 (define (update-sprite-vertices! sprite)
   (let ((texture (sprite-texture sprite)))
     (pack-texture-vertices (sprite-vertices sprite)
@@ -124,7 +112,7 @@ DRAWABLE.  Sprites are centered by default."
          (animator (if (animation? drawable)
                        (make-animator drawable)
                        #f))
-         (anchor (make-anchor anchor (drawable-texture drawable animator)))
+         (anchor (anchor-texture (drawable-texture drawable animator) anchor))
          (sprite (%make-sprite drawable position scale rotation color
                                anchor vertices animator)))
     (update-sprite-vertices! sprite)
@@ -159,7 +147,7 @@ optional keyword arguments."
                       (sprite-animator sprite))))
 
 (define (set-sprite-anchor! sprite anchor)
-  (%set-sprite-anchor! sprite (make-anchor anchor (sprite-texture sprite))))
+  (%set-sprite-anchor! sprite (anchor-texture (sprite-texture sprite) anchor)))
 
 (define (update-sprite-animator! sprite)
   (animator-update! (sprite-animator sprite))
diff --git a/2d/texture.scm b/2d/texture.scm
index 684ad42..5185368 100644
--- a/2d/texture.scm
+++ b/2d/texture.scm
@@ -28,6 +28,7 @@
   #:use-module (figl contrib packed-struct)
   #:use-module (2d color)
   #:use-module (2d helpers)
+  #:use-module (2d vector2)
   #:use-module (2d wrappers gl)
   #:use-module (2d wrappers freeimage)
   #:export (make-texture
@@ -42,7 +43,7 @@
             texture-t1
             texture-s2
             texture-t2
-            surface->texture
+            anchor-texture
             texture-vertex
             pack-texture-vertices
             draw-texture-vertices))
@@ -154,6 +155,18 @@ that will be rendered, in pixels."
     (freeimage-unload bitmap)
     texture))
 
+(define (anchor-texture texture anchor)
+  "Return a vector2 of the coordinates for the center point of a
+texture."
+  (cond
+   ((vector2? anchor)
+    anchor)
+   ((eq? anchor 'center)
+    (vector2 (/ (texture-width texture) 2)
+             (/ (texture-height texture) 2)))
+   (else
+    (error "Invalid anchor type!" anchor))))
+
 ;;;
 ;;; Texture Vertices
 ;;;
-- 
cgit v1.2.3