diff options
author | David Thompson <dthompson@vistahigherlearning.com> | 2021-04-25 14:51:00 -0400 |
---|---|---|
committer | David Thompson <dthompson@vistahigherlearning.com> | 2021-04-25 14:51:00 -0400 |
commit | 8fc01b81e0f95c8ea187d179b6f6a6b9afc4e79e (patch) | |
tree | 3ff4f1250699e4006d584b8562992499e9643d4a /test-subject/device.scm | |
parent | 4ea611de4efe34a0f193572979c20372d4202b9f (diff) |
Break code up into modules.
Diffstat (limited to 'test-subject/device.scm')
-rw-r--r-- | test-subject/device.scm | 42 |
1 files changed, 42 insertions, 0 deletions
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)) |