diff options
| author | David Thompson <dthompson2@worcester.edu> | 2022-07-31 12:43:44 -0400 |
|---|---|---|
| committer | David Thompson <dthompson2@worcester.edu> | 2022-07-31 12:43:44 -0400 |
| commit | a22ab92aea1c54322b5c5d46ea33c09f7975f4c7 (patch) | |
| tree | f9bb2f7080a9cf6294e0e01332418c60909f1523 | |
| parent | b75edd152f20a5a8ff88149e7cd2b182040b27f6 (diff) | |
node: Rewrite asset subscription code to avoid use of is-a?
| -rw-r--r-- | starling/node.scm | 22 |
1 files 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 <meta-node> (<class>)) (define-method (asset-slot? (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>) - (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 <asset>) - (remove-subscriber old obj slot-name)) - (when (is-a? new <asset>) - (add-subscriber new obj slot-name)) + (remove-subscriber old obj slot-name) + (add-subscriber new obj slot-name) (proc obj new))))) (next-method))) |