From a22ab92aea1c54322b5c5d46ea33c09f7975f4c7 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Sun, 31 Jul 2022 12:43:44 -0400 Subject: node: Rewrite asset subscription code to avoid use of is-a? --- starling/node.scm | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/starling/node.scm b/starling/node.scm index 0872c19..3dabcd0 100644 --- a/starling/node.scm +++ b/starling/node.scm @@ -66,6 +66,17 @@ blink) #:replace (pause)) +;; Allows for non-asset values to be used in asset slots below, such +;; as textures and fonts that are built in to Chickadee. +(define-method (add-subscriber thing subscriber slot-name) + #f) + +(define-method (remove-subscriber thing subscriber slot-name) + #f) + +(define-method (asset-ref thing) + thing) + (define-class ()) (define-method (asset-slot? (slot )) @@ -83,10 +94,7 @@ #:procedure (let ((slot-name (slot-definition-name slot)) (proc (method-procedure (next-method)))) (lambda (obj) - (let ((value (proc obj))) - (if (is-a? value ) - (asset-ref value) - value))))) + (asset-ref (proc obj))))) (next-method))) (define-generic on-change) @@ -119,10 +127,8 @@ (lambda (obj new) (let ((old (and (slot-bound? obj slot-name) (slot-ref obj slot-name)))) - (when (is-a? old ) - (remove-subscriber old obj slot-name)) - (when (is-a? new ) - (add-subscriber new obj slot-name)) + (remove-subscriber old obj slot-name) + (add-subscriber new obj slot-name) (proc obj new))))) (next-method))) -- cgit v1.2.3