vector: Factorize anchor function.

* sly/math/vector.scm (anchor-vector): New procedure.
* sly/render/texture.scm (anchor-texture): Define in terms of
anchor-vector.

2 files changed, 30 insertions, 21 deletions

diff --git a/sly/math/vector.scm b/sly/math/vector.scm
index cc03e4e..52e8c70 100644
--- a/sly/math/vector.scm
+++ b/sly/math/vector.scm
@@ -34,7 +34,8 @@
             polar2
             vx vy vz vw
             vmap v+ v- v* vdot vcross
-            magnitude normalize vlerp)
+            magnitude normalize vlerp
+            anchor-vector)
   #:replace (magnitude))
 
 (define-record-type <vector2>
@@ -174,3 +175,29 @@ element of the 2D/3D/4D vector V."
            (vector4 (/ x m) (/ y m) (/ z m) (/ w m)))))))
 
 (define vlerp (make-lerp v+ v*))
+
+(define (anchor-vector width height anchor)
+  "Create an anchor point vector from the description ANCHOR within
+the rectangular defined by WIDTH and HEIGHT.  Valid values for ANCHOR
+are: 'center', 'top-left', 'top-right', 'bottom-left', 'bottom-right',
+'top-center', 'bottom-center', or any 2D vector.  When ANCHOR is a 2D
+vector, the return value is simply the same vector."
+  (match anchor
+    ((? vector2? anchor)
+     anchor)
+    ('center
+     (vector2 (/ width 2)
+              (/ height 2)))
+    ('top-left
+     (vector2 0 height))
+    ('top-right
+     (vector2 width height))
+    ('bottom-left
+     (vector2 0 0))
+    ('bottom-right
+     (vector2 width 0))
+    ('top-center
+     (vector2 (/ width 2) height))
+    ('bottom-center
+     (vector2 (/ width 2) 0))
+    (_ (error "Invalid anchor type: " anchor))))
diff --git a/sly/render/texture.scm b/sly/render/texture.scm
index bda6ed1..6e59337 100644
--- a/sly/render/texture.scm
+++ b/sly/render/texture.scm
@@ -183,29 +183,11 @@ magnification.  Valid values are 'nearest and 'linear.  By default,
       (surface->texture surface min-filter mag-filter))))
 
 (define (anchor-texture texture anchor)
-  "Translate ANCHOR into a vector that represents the desired centtral
+  "Translate ANCHOR into a vector that represents the desired central
 point for TEXTURE.  Valid values for ANCHOR are: 'center, 'top-left,
 'top-right, 'bottom-left, 'bottom-right, 'top-center, 'bottom-center,
 or any 2D vector.  Passing a 2D vector will simply cause the same
 vector to be returned."
   (let ((w (texture-width texture))
         (h (texture-height texture)))
-    (match anchor
-      ((? vector2? anchor)
-       anchor)
-      ('center
-       (vector2 (/ w 2)
-                (/ h 2)))
-      ('top-left
-       (vector2 0 h))
-      ('top-right
-       (vector2 w h))
-      ('bottom-left
-       (vector2 0 0))
-      ('bottom-right
-       (vector2 w 0))
-      ('top-center
-       (vector2 (/ w 2) h))
-      ('bottom-center
-       (vector2 (/ w 2) 0))
-      (_ (error "Invalid anchor type: " anchor)))))
+    (anchor-vector w h anchor)))