summaryrefslogtreecommitdiff
path: root/lisparuga/node-2d.scm
diff options
context:
space:
mode:
Diffstat (limited to 'lisparuga/node-2d.scm')
-rw-r--r--lisparuga/node-2d.scm26
1 files changed, 25 insertions, 1 deletions
diff --git a/lisparuga/node-2d.scm b/lisparuga/node-2d.scm
index 0baef54..b6753ef 100644
--- a/lisparuga/node-2d.scm
+++ b/lisparuga/node-2d.scm
@@ -605,7 +605,31 @@
(define-class <label> (<node-2d>)
(font #:accessor font #:init-keyword #:font #:init-thunk default-font)
- (text #:accessor text #:init-form "" #:init-keyword #:text))
+ (text #:accessor text #:init-form "" #:init-keyword #:text)
+ (align #:accessor align #:init-value 'left #:init-keyword #:align)
+ (vertical-align #:accessor vertical-align #:init-value 'bottom
+ #:init-keyword #:vertical-align))
+
+(define-method (initialize (label <label>) initargs)
+ (next-method)
+ (realign label))
+
+(define-method ((setter text) (label <label>) s)
+ (slot-set! label 'text s)
+ (realign label))
+
+(define-method (realign (label <label>))
+ (let ((font (asset-ref (font label))))
+ (set-vec2! (origin label)
+ (match (align label)
+ ('left 0.0)
+ ('right (font-line-width font (text label)))
+ ('center (/ (font-line-width font (text label)) 2.0)))
+ (match (vertical-align label)
+ ('bottom 0.0)
+ ('top (font-line-height font))
+ ('center (/ (font-line-height font) 2.0)))))
+ (dirty! label))
(define-method (render (label <label>) alpha)
(draw-text* (asset-ref (font label)) (text label) (world-matrix label)))