summaryrefslogtreecommitdiff
path: root/2d
diff options
context:
space:
mode:
Diffstat (limited to '2d')
-rw-r--r--2d/font.scm2
-rw-r--r--2d/texture.scm32
2 files changed, 23 insertions, 11 deletions
diff --git a/2d/font.scm b/2d/font.scm
index a9e178f..0917e66 100644
--- a/2d/font.scm
+++ b/2d/font.scm
@@ -143,7 +143,7 @@ the given position. Optional arguments are COLOR with a default of
white and ANCHOR with a default of 'top-left."
(let* ((texture (render-text font text))
(vertices (and texture (make-label-vertices texture)))
- (anchor (anchor-texture texture anchor)))
+ (anchor (if texture (anchor-texture texture anchor) null-vector2)))
(%make-label font text position anchor color texture vertices)))
(define (draw-label label)
diff --git a/2d/texture.scm b/2d/texture.scm
index 1ac3f05..8dcbf95 100644
--- a/2d/texture.scm
+++ b/2d/texture.scm
@@ -158,16 +158,28 @@ that will be rendered, in pixels."
(define (anchor-texture texture anchor)
"Return a vector2 of the coordinates for the center point of a
texture."
- (cond
- ((vector2? anchor)
- anchor)
- ((eq? anchor 'top-left)
- null-vector2)
- ((eq? anchor 'center)
- (vector2 (/ (texture-width texture) 2)
- (/ (texture-height texture) 2)))
- (else
- (error "Invalid anchor type!" anchor))))
+ (let ((w (texture-width texture))
+ (h (texture-height texture)))
+ (cond
+ ((vector2? anchor)
+ anchor)
+ ((eq? anchor 'center)
+ (vector2 (/ w 2)
+ (/ h 2)))
+ ((eq? anchor 'top-left)
+ null-vector2)
+ ((eq? anchor 'top-right)
+ (vector2 w 0))
+ ((eq? anchor 'bottom-left)
+ (vector2 0 h))
+ ((eq? anchor 'bottom-right)
+ (vector2 w h))
+ ((eq? anchor 'top-center)
+ (vector2 (/ w 2) 0))
+ ((eq? anchor 'bottom-center)
+ (vector2 (/ w 2) h))
+ (else
+ (error "Invalid anchor type!" anchor)))))
;;;
;;; Texture Vertices