summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--2d/game.scm145
-rw-r--r--2d/signals.scm36
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)