summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--sly/math/vector.scm29
-rw-r--r--sly/render/texture.scm22
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)))