Remove stage stuff from game module and use signals.

Moving my work to another machine so this commit is ugly.

2 files changed, 92 insertions, 89 deletions

diff --git a/2d/game.scm b/2d/game.scm
index aa19e44..b59ddee 100644
--- a/2d/game.scm
+++ b/2d/game.scm
@@ -32,8 +32,7 @@
   #:use-module (2d mvars)
   #:use-module (2d repl server)
   #:use-module (2d repl repl)
-  #:use-module (2d scene)
-  #:use-module (2d stage)
+  #:use-module (2d signals)
   #:use-module (2d vector2)
   #:use-module (2d window)
   #:export (<game>
@@ -42,7 +41,6 @@
             game-title
             game-resolution
             game-fullscreen?
-            game-first-scene
             current-fps
             run-game
             quit-game
@@ -56,21 +54,27 @@
 ;;;
 
 (define-record-type <game>
-  (%make-game title resolution fullscreen? first-scene)
+  (%make-game title resolution fullscreen? draw)
   game?
   (title game-title)
   (resolution game-resolution)
   (fullscreen? game-fullscreen?)
-  (first-scene game-first-scene))
+  (draw game-draw))
+
+(define (default-draw)
+  #f)
 
 (define* (make-game #:optional #:key
                     (title "A Guile-2D Game")
                     (resolution (vector2 640 480))
                     (fullscreen? #f)
-                    (first-scene #f))
+                    (draw default-draw))
   "Return a new game. All game properties have some reasonable default
 value."
-  (%make-game title resolution fullscreen? first-scene))
+  (%make-game title resolution fullscreen? draw))
+
+(define (draw-game game)
+  ((game-draw game)))
 
 (define (run-game game)
   "Open a window and start the game loop for GAME."
@@ -79,9 +83,8 @@ value."
                (game-fullscreen? game))
   (set! running? #t)
   (resume-game)
-  (push-scene (game-first-scene game))
   (spawn-server)
-  (game-loop (SDL:get-ticks) 0)
+  (game-loop game (SDL:get-ticks) 0)
   (close-window))
 
 ;;;
@@ -91,13 +94,13 @@ value."
 (define running? #f)
 (define paused? #f)
 
-(define (update-and-render stage dt accumulator)
-  (let ((remainder (update stage accumulator)))
+(define (update-and-render game dt accumulator)
+  (let ((remainder (update accumulator)))
     (run-repl)
-    (render stage dt)
+    (draw game dt)
     remainder))
 
-(define (tick dt accumulator)
+(define (tick game dt accumulator)
   "Advance the game by one frame."
   (if paused?
       (begin
@@ -106,10 +109,7 @@ value."
         accumulator)
       (catch #t
         (lambda ()
-          (let ((stage (current-stage)))
-            (if stage
-                (update-and-render stage dt accumulator)
-                (quit-game))))
+          (update-and-render game dt accumulator))
         (lambda (key . args)
           (pause-game)
           accumulator)
@@ -117,7 +117,7 @@ value."
           (display-backtrace (make-stack #t)
                              (current-output-port))))))
 
-(define (game-loop last-time accumulator)
+(define (game-loop game last-time accumulator)
   "Update game state, and render. LAST-TIME is the time in
 milliseconds of the last iteration of the loop. ACCUMULATOR is the
 time in milliseconds that has passed since the last game update."
@@ -125,13 +125,13 @@ time in milliseconds that has passed since the last game update."
     (let* ((current-time (SDL:get-ticks))
            (dt (- current-time last-time))
            (accumulator (+ accumulator dt)))
-      (game-loop current-time (tick dt accumulator)))))
+      (game-loop game current-time (tick game dt accumulator)))))
 
 (define (game-running?)
-  (running?))
+  running?)
 
 (define (game-paused?)
-  (paused?))
+  paused?)
 
 (define (pause-game)
   "Pauses the game loop. Useful when developing."
@@ -158,63 +158,66 @@ time in milliseconds that has passed since the last game update."
 
 ;; By default, pressing the escape key will pop the current scene, and
 ;; closing the window will quit the game.
-(default-events `((key-down . ,(lambda (state key mod unicode)
-                                 (when (eq? key 'escape)
-                                   (pop-scene))))
-                  (quit . ,(lambda (state)
-                             (quit-game)))))
+;; (default-events `((key-down . ,(lambda (state key mod unicode)
+;;                                  (when (eq? key 'escape)
+;;                                    (pop-scene))))
+;;                   (quit . ,(lambda (state)
+;;                              (quit-game)))))
 
 (define handle-events
   (let ((e (SDL:make-event)))
-    (lambda (stage)
+    (lambda ()
       "Handle all events in the SDL event queue."
       (while (SDL:poll-event e)
-        (handle-event stage e)))))
-
-(define (handle-event stage e)
-  "Call the relevant callbacks for the event, E."
+        (handle-event e)))))
+
+(define-public window-size (signal-identity (vector2 0 0)))
+(define-public key-down (signal-identity))
+(define-public key-up (signal-identity))
+(define-public mouse-position (signal-identity (vector2 0 0)))
+(define-public mouse-down (signal-identity))
+(define-public mouse-up (signal-identity))
+
+(define-public (key-is-down key)
+  (make-signal (lambda (value prev from)
+                 (cond ((and (eq? from key-down)
+                             (eq? value key))
+                        #t)
+                       ((and (eq? from key-up)
+                             (eq? value key))
+                        #f)
+                       (else
+                        prev)))
+               #:connectors (list key-down key-up)))
+
+(define (handle-event e)
+  "Call the relevant callbacks for the event E."
   (case (SDL:event:type e)
     ((active)
-     (stage-trigger stage 'active))
+     #f)
     ((video-resize)
-     (stage-trigger stage
-                    'resize
-                    (SDL:event:resize:w e)
-                    (SDL:event:resize:h e)))
+     (signal-set! window-size (vector2 (SDL:event:resize:w e)
+                                       (SDL:event:resize:h e))))
     ((quit)
-     (stage-trigger stage 'quit))
+     (quit-game))
     ((key-down)
-     (stage-trigger stage
-                    'key-down
-                    (SDL:event:key:keysym:sym e)
-                    (SDL:event:key:keysym:mod e)
-                    (SDL:event:key:keysym:unicode e)))
+     (signal-set! key-down (SDL:event:key:keysym:sym e)))
     ((key-up)
-     (stage-trigger stage
-                    'key-up
-                    (SDL:event:key:keysym:sym e)
-                    (SDL:event:key:keysym:mod e)
-                    (SDL:event:key:keysym:unicode e)))
+     (signal-set! key-up (SDL:event:key:keysym:sym e)))
     ((mouse-motion)
-     (stage-trigger stage
-                    'mouse-motion
-                    (SDL:event:motion:state e)
-                    (SDL:event:motion:x e)
-                    (SDL:event:motion:y e)
-                    (SDL:event:motion:xrel e)
-                    (SDL:event:motion:yrel e)))
+     (signal-set! mouse-position
+                  (vector2 (SDL:event:motion:x e)
+                           (SDL:event:motion:y e))))
     ((mouse-button-down)
-     (stage-trigger stage
-                    'mouse-press
-                    (SDL:event:button:button e)
-                    (SDL:event:button:x e)
-                    (SDL:event:button:y e)))
+     (signal-set! mouse-down
+                  (list (SDL:event:button:button e)
+                        (SDL:event:button:x e)
+                        (SDL:event:button:y e))))
     ((mouse-button-up)
-     (stage-trigger stage
-                    'mouse-click
-                    (SDL:event:button:button e)
-                    (SDL:event:button:x e)
-                    (SDL:event:button:y e)))))
+     (signal-set! mouse-up
+                  (list (SDL:event:button:button e)
+                        (SDL:event:button:x e)
+                        (SDL:event:button:y e))))))
 
 ;;;
 ;;; Frames Per Second
@@ -244,28 +247,28 @@ second."
   game-fps)
 
 ;;;
-;;; Update and Render
+;;; Update and Draw
 ;;;
 
-(define (render stage dt)
+(define (draw game dt)
   "Render a frame."
   (set-gl-matrix-mode (matrix-mode modelview))
   (gl-load-identity)
   (gl-clear (clear-buffer-mask color-buffer depth-buffer))
-  (draw-stage stage)
+  (draw-game game)
   (SDL:gl-swap-buffers)
   (accumulate-fps! dt))
 
-(define (update stage accumulator)
+(define (update accumulator)
   "Call the update callback. The update callback will be called as
 many times as `tick-interval` can divide ACCUMULATOR. The return value
 is the unused accumulator time."
   (if (>= accumulator tick-interval)
       (begin
-        (handle-events stage)
+        (handle-events)
         (update-agenda)
-        (update-stage stage)
-        (update stage (- accumulator tick-interval)))
+        ;; (update-stage stage)
+        (update (- accumulator tick-interval)))
       accumulator))
 
 ;;;
diff --git a/2d/signals.scm b/2d/signals.scm
index c55c0ba..4a455c2 100644
--- a/2d/signals.scm
+++ b/2d/signals.scm
@@ -72,9 +72,9 @@ signals in the list CONNECTORS."
     (for-each (cut signal-connect! <> signal) connectors)
     signal))
 
-(define (%signal-transform signal value)
+(define (%signal-transform signal value from)
   "Call the transform procedure for SIGNAL with VALUE."
-  ((signal-transformer signal) value (signal-ref signal)))
+  ((signal-transformer signal) value (signal-ref signal) from))
 
 (define (signal-connect! signal listener)
   "Attach LISTENER to SIGNAL. When the value of SIGNAL changes, the
@@ -94,12 +94,12 @@ value will be propagated to LISTENER."
   "Detach all listeners from SIGNAL."
   (%set-signal-listeners! signal '()))
 
-(define (signal-set! signal value)
-  "Modify SIGNAL to store VALUE and propagate VALUE to all listening
-signals."
-  (let ((value (%signal-transform signal value)))
+(define* (signal-set! signal value #:optional (from #f))
+  "Receive new VALUE for SIGNAL from the connected signal FROM and
+propagate VALUE to all listening signals. "
+  (let ((value (%signal-transform signal value from)))
     (%signal-set! signal value)
-    (for-each (cut signal-set! <> value)
+    (for-each (cut signal-set! <> value signal)
               (signal-listeners signal))))
 
 ;;;
@@ -109,13 +109,13 @@ signals."
 (define* (signal-identity #:optional (init #f))
   "Create a new signal with initial value INIT whose transformer procedure
 returns values unchanged."
-  (make-signal (lambda (value old-value)
+  (make-signal (lambda (value prev from)
                  value)
                #:init init))
 
 (define (signal-constant constant)
   "Create a new signal with a value CONSTANT that cannot be changed."
-  (make-signal (lambda (value old-value signal)
+  (make-signal (lambda (value prev from)
                  constant)
                #:init constant))
 
@@ -123,14 +123,14 @@ returns values unchanged."
 (define (signal-lift transformer signal)
   "Create a new signal that lifts the procedure TRANSFORMER of arity 1
 onto SIGNAL."
-  (make-signal (lambda (value old-value)
+  (make-signal (lambda (value prev from)
                  (transformer value))
                #:connectors (list signal)))
 
 (define (signal-lift2 transformer signal1 signal2)
   "Create a new signal that lifts the procedure TRANSFORMER of arity 2
 onto SIGNAL1 and SIGNAL2."
-  (make-signal (lambda (value old-value)
+  (make-signal (lambda (value prev from)
                  (transformer (signal-ref signal1)
                               (signal-ref signal2)))
                #:connectors (list signal1 signal2)))
@@ -139,29 +139,29 @@ onto SIGNAL1 and SIGNAL2."
   "Create a new signal that merges SIGNAL1 and SIGNAL2 into one. The
 value of the new signal is the value of the most recently changed
 parent signal."
-  (make-signal (lambda (value old-value)
+  (make-signal (lambda (value prev from)
                  value)
                #:connectors (list signal1 signal2)))
 
 (define (signal-combine . signals)
   "Create a new signal that combines the values of SIGNALS into a
 list."
-  (make-signal (lambda (value old-value)
+  (make-signal (lambda (value prev from)
                  (map signal-ref signals))
                #:connectors signals))
 
 (define (signal-count signal)
   "Create a new signal that increments a counter every time the value
 of SIGNAL changes."
-  (make-signal (lambda (value old-value)
-                 (1+ old-value))
+  (make-signal (lambda (value prev from)
+                 (1+ prev))
                #:connectors (list signal)))
 
 (define (signal-if predicate consequent alternate)
   "Create a new signal that emits the value of the signal CONSEQUENT
 when the value of the signal PREDICATE is true and the value of the
 signal ALTERNATE otherwise."
-  (make-signal (lambda (value old-value)
+  (make-signal (lambda (value prev from)
                  (if (signal-ref predicate)
                      (signal-ref consequent)
                      (signal-ref alternate)))
@@ -172,7 +172,7 @@ signal ALTERNATE otherwise."
 (define (signal-and . signals)
   "Create a new signal that performs a logical AND operation on the
 values of SIGNALS."
-  (make-signal (lambda (value old-value)
+  (make-signal (lambda (value prev from)
                  (let loop ((signals signals)
                             (prev #t))
                    (cond ((null? signals)
@@ -186,7 +186,7 @@ values of SIGNALS."
 (define (signal-or . signals)
   "Create a new signal that performs a logicla OR operation the values
 of SIGNALS."
-  (make-signal (lambda (value old-value)
+  (make-signal (lambda (value prev from)
                  (let loop ((signals signals))
                    (cond ((null? signals)
                           #f)