diff options
| -rw-r--r-- | 2d/font.scm | 2 | ||||
| -rw-r--r-- | 2d/texture.scm | 32 |
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 |