From a20d05376cb2de636abebd64da3eeb6c7e8c7bac Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson@vistahigherlearning.com>
Date: Sat, 29 Oct 2022 21:40:09 -0400
Subject: Day 1 progress.

---
 apple-town-fair/time-display.scm | 21 ++++++++++++++++-----
 1 file changed, 16 insertions(+), 5 deletions(-)

(limited to 'apple-town-fair/time-display.scm')

diff --git a/apple-town-fair/time-display.scm b/apple-town-fair/time-display.scm
index c36618f..e79b0d1 100644
--- a/apple-town-fair/time-display.scm
+++ b/apple-town-fair/time-display.scm
@@ -22,16 +22,21 @@
   #:use-module (chickadee graphics path)
   #:use-module (chickadee math vector)
   #:use-module (oop goops)
-  #:export (<time-display>))
+  #:export (<time-display>
+            where))
 
 (define-class <time-display> (<node-2d>)
-  (day #:accessor day #:init-keyword #:day #:init-value 0 #:observe? #t)
-  (time #:accessor time #:init-keyword #:time #:init-value 0 #:observe? #t))
+  (where #:accessor where #:init-value "XXXXXXXXXXX" #:observe? #t)
+  (day #:accessor day #:init-value 0 #:observe? #t)
+  (time #:accessor time #:init-value 0 #:observe? #t))
 
 (define-method (on-boot (t <time-display>))
   (attach-to t
              (make <canvas>
                #:name 'background)
+             (make <label>
+               #:name 'place
+               #:font monogram-font)
              (make <label>
                #:name 'day
                #:font monogram-font)
@@ -44,15 +49,21 @@
   (let ((padding 4.0))
     (set! (text (& t day)) (day->string (day t)))
     (set! (text (& t time)) (time->string (time t)))
+    (set! (text (& t place)) (where t))
     (set! (position-x (& t day)) padding)
     (set! (position-x (& t time)) padding)
     (set! (position-y (& t time)) padding)
+    (set! (position-x (& t place)) padding)
     (place-above (& t time) (& t day) #:padding padding)
-    (set! (width t) (+ (max (width (& t day)) (width (& t time)))
+    (place-above (& t day) (& t place) #:padding padding)
+    (set! (width t) (+ (max (width (& t day))
+                            (width (& t time))
+                            (width (& t place)))
                        (* padding 2.0)))
     (set! (height t) (+ (height (& t day))
                         (height (& t time))
-                        (* padding 3.0)))
+                        (height (& t place))
+                        (* padding 4.0)))
     (unless (painter (& t background))
       (set! (painter (& t background))
             (with-style ((fill-color (make-color 1.0 0.0 0.0 0.25)))
-- 
cgit v1.2.3