From cf4dc9bc6c33aee26e0a11cddeeaacbff8d1cc75 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Wed, 30 Oct 2013 22:54:50 -0400
Subject: Add observer to stage.

---
 2d/stage.scm | 17 ++++++++++++++---
 1 file changed, 14 insertions(+), 3 deletions(-)

(limited to '2d/stage.scm')

diff --git a/2d/stage.scm b/2d/stage.scm
index d46586d..306787b 100644
--- a/2d/stage.scm
+++ b/2d/stage.scm
@@ -24,10 +24,12 @@
 (define-module (2d stage)
   #:use-module (srfi srfi-9)
   #:use-module (2d agenda)
+  #:use-module (2d observer)
   #:use-module (2d scene)
   #:export (make-stage
             stage?
             stage-agenda
+            stage-observer
             stage-env
             stage-scene
             init-stage
@@ -38,21 +40,24 @@
             stage-trigger
             make-stage-variable
             define-stage-variable
+            stage-on
+            stage-off
             current-stage
             push-stage
             pop-stage
             replace-stage))
 
 (define-record-type <stage>
-  (%make-stage agenda env scene)
+  (%make-stage agenda observer env scene)
   stage?
   (agenda stage-agenda)
+  (observer stage-observer)
   (env stage-env)
   (scene stage-scene))
 
 (define (make-stage scene)
   "Create a new stage object for SCENE."
-  (%make-stage (make-agenda) (make-hash-table) scene))
+  (%make-stage (make-agenda) (make-observer) (make-hash-table) scene))
 
 ;;;
 ;;; Scene callbacks
@@ -85,7 +90,7 @@
     ((scene-draw (stage-scene stage)))))
 
 (define (stage-trigger stage event . args)
-  #f)
+  (apply observer-trigger (stage-observer stage) event args))
 
 ;;;
 ;;; Stage environment
@@ -137,6 +142,12 @@ thrown if there is no value associated with KEY."
 lazily evaluated the first time it is referenced in a stage object."
   (define name (make-stage-variable (lambda () value))))
 
+(define (stage-on event callback)
+  (observer-on (stage-observer (current-stage)) event callback))
+
+(define (stage-off event callback)
+  (observer-off (stage-observer (current-stage)) event callback))
+
 ;;;
 ;;; Stage management
 ;;;
-- 
cgit v1.2.3