From 8fc01b81e0f95c8ea187d179b6f6a6b9afc4e79e Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson@vistahigherlearning.com>
Date: Sun, 25 Apr 2021 14:51:00 -0400
Subject: Break code up into modules.

---
 test-subject/device.scm | 42 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 42 insertions(+)
 create mode 100644 test-subject/device.scm

(limited to 'test-subject/device.scm')

diff --git a/test-subject/device.scm b/test-subject/device.scm
new file mode 100644
index 0000000..b15f270
--- /dev/null
+++ b/test-subject/device.scm
@@ -0,0 +1,42 @@
+(define-module (test-subject device)
+  #:use-module (chickadee graphics color)
+  #:use-module (chickadee graphics texture)
+  #:use-module (oop goops)
+  #:use-module (starling gui)
+  #:use-module (starling node)
+  #:use-module (starling node-2d)
+  #:export (<device>))
+
+(define %device-hover-tint (rgb #xff7777))
+
+;; An object you can interact with by clicking.
+(define-class <device> (<margin-container>)
+  (texture #:accessor texture #:init-keyword #:texture
+           #:init-value null-texture #:watch? #t))
+
+(define-method (refresh-hover-state (device <device>))
+  ;; A crude way of showing the user something is clickable.
+  (set! (tint (& device sprite))
+        (if (hover? device)
+            %device-hover-tint
+            white)))
+
+(define-method (on-change (device <device>) slot-name old new)
+  (case slot-name
+    ((hover?)
+     (refresh-hover-state device))
+    ((texture)
+     (let ((sprite (& device sprite)))
+       (when sprite
+         (set! (texture sprite) new))))
+    (else
+     (next-method))))
+
+(define-method (apply-theme (device <device>))
+  (next-method)
+  (replace device
+    (make <sprite>
+      #:name 'sprite
+      #:rank 1
+      #:texture (texture device)))
+  (refresh-hover-state device))
-- 
cgit v1.2.3