diff options
| -rw-r--r-- | sly/math/vector.scm | 29 | ||||
| -rw-r--r-- | sly/render/texture.scm | 22 |
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))) |