summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2013-10-30 21:16:06 -0400
committerDavid Thompson <dthompson2@worcester.edu>2013-10-30 21:16:06 -0400
commitecc7e2324140dc2dec61316ad3a584d8e34898df (patch)
treed6a26007e1c0bed7789c9051eb7d9db4da4fd95e
parent698cc6d76de71a737f1d443001ca87a1faa42e4b (diff)
Rewrite stage variables.
Stage variables now act a lot like parameters and their initial values are lazily evaluated.
-rw-r--r--2d/stage.scm62
1 files changed, 34 insertions, 28 deletions
diff --git a/2d/stage.scm b/2d/stage.scm
index 3126115..d46586d 100644
--- a/2d/stage.scm
+++ b/2d/stage.scm
@@ -36,9 +36,8 @@
draw-stage
update-stage
stage-trigger
- stage-define
- stage-ref
- stage-set!
+ make-stage-variable
+ define-stage-variable
current-stage
push-stage
pop-stage
@@ -92,22 +91,32 @@
;;; Stage environment
;;;
-(define (%stage-define stage key value)
- "Define a new variable on STAGE with the specified symbolic name KEY
-and arbitrary VALUE. An error is thrown when there is already a value
-associated with KEY."
- (let ((env (stage-env stage)))
- (if (hash-get-handle env key)
- (error 'stage-already-defined-variable key)
- (hash-set! env key value))))
-
-(define (%stage-ref stage key)
- "Return the value stored in STAGE associated with KEY. An error is
-thrown if there is no value associated with KEY."
- (let ((handle (hash-get-handle (stage-env stage) key)))
+(define uuid-counter 1)
+
+(define (next-uuid)
+ "Return the next available uuid and increment the uuid counter."
+ (let ((uuid uuid-counter))
+ (set! uuid-counter (1+ uuid-counter))
+ uuid))
+
+(define (make-stage-variable init-thunk)
+ "Create a new stage variable that is initialized by INIT-THUNK."
+ (let ((uuid (next-uuid)))
+ (case-lambda
+ (()
+ (stage-ref-or-init uuid init-thunk))
+ ((new-value)
+ (stage-set! uuid new-value)))))
+
+(define (%stage-ref-or-init stage key init-thunk)
+ "Return the value stored in STAGE associated with KEY. If there is
+no association for KEY then create it and set the value returned by
+INIT-THUNK."
+ (let* ((env (stage-env stage))
+ (handle (hash-get-handle env key)))
(if handle
(cdr handle)
- (error 'stage-unbound-variable key))))
+ (cdr (hash-create-handle! env key (init-thunk))))))
(define (%stage-set! stage key value)
"Associate KEY with VALUE in the STAGE environment. An error is
@@ -117,19 +126,16 @@ thrown if there is no value associated with KEY."
(set-cdr! handle value)
(error 'stage-unbound-variable key))))
-(define-syntax-rule (stage-define key value)
- "Define the variable KEY with VALUE in the current stage
-environment."
- (%stage-define (current-stage) 'key value))
+(define (stage-ref-or-init key init)
+ (%stage-ref-or-init (current-stage) key init))
-(define-syntax-rule (stage-ref key)
- "Return the value bound to KEY in the current stage environment."
- (%stage-ref (current-stage) 'key))
+(define (stage-set! key value)
+ (%stage-set! (current-stage) key value))
-(define-syntax-rule (stage-set! key value)
- "Assign VALUE to the variable bound to KEY in the current stage
-environment."
- (%stage-set! (current-stage) 'key value))
+(define-syntax-rule (define-stage-variable name value)
+ "Define a stage variable named NAME with value VALUE. VALUE is
+lazily evaluated the first time it is referenced in a stage object."
+ (define name (make-stage-variable (lambda () value))))
;;;
;;; Stage management