summaryrefslogtreecommitdiff
path: root/2d/stage.scm
blob: 29a94454a6c6013bedfa9838ebc57ec99ec2fad6 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
;;; guile-2d
;;; Copyright (C) 2013 David Thompson <dthompson2@worcester.edu>
;;;
;;; Guile-2d is free software: you can redistribute it and/or modify it
;;; under the terms of the GNU Lesser General Public License as
;;; published by the Free Software Foundation, either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; Guile-2d is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; Lesser General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with this program.  If not, see
;;; <http://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; Stages represent the game state at the present time.
;;
;;; Code:

(define-module (2d stage)
  #:use-module (srfi srfi-9)
  #:use-module (2d agenda)
  #:use-module (2d scene)
  #:export (make-stage
            stage?
            stage-agenda
            stage-observer
            stage-env
            stage-scene
            set-stage-scene!
            enter-stage
            exit-stage
            draw-stage
            update-stage
            stage-trigger
            make-stage-variable
            define-stage-variable
            stage-on
            stage-off
            current-stage
            push-scene
            pop-scene
            replace-scene))

(define-record-type <stage>
  (%make-stage agenda scene state)
  stage?
  (agenda stage-agenda)
  (scene stage-scene set-stage-scene!)
  (state stage-state))

(define (make-stage scene)
  "Create a new stage object for SCENE."
  (%make-stage (make-agenda) scene (init-scene scene)))

;;;
;;; Scene callbacks
;;;

(define (enter-stage stage)
  "Call the scene enter callback for STAGE."
  (with-agenda (stage-agenda stage)
    (enter-scene (stage-scene stage)
                 (stage-state stage))))

(define (exit-stage stage)
  "Call the scene exit callback for STAGE."
  (with-agenda (stage-agenda stage)
    (exit-scene (stage-scene stage)
                (stage-state stage))))

(define (update-stage stage)
  "Call the scene update callback for STAGE."
  (with-agenda (stage-agenda stage)
    (update-agenda)
    (update-scene (stage-scene stage)
                  (stage-state stage))))

(define (draw-stage stage)
  "Call the scene draw callback for STAGE."
  (with-agenda (stage-agenda stage)
    (draw-scene (stage-scene stage)
                (stage-state stage))))

(define (stage-trigger stage event . args)
  (with-agenda (stage-agenda stage)
    (apply scene-trigger
           (stage-scene stage)
           (stage-state stage)
           event
           args)))

;;;
;;; Stage management
;;;

(define stack '())

(define (current-stage)
  "Return the top of the stage stack or #f if the stack is empty."
  (if (null? stack) #f (car stack)))

(define (push-scene scene)
  "Make STAGE active and push it to the top of the stack."
  (let ((prev-stage (current-stage))
        (stage (make-stage scene)))
    (when prev-stage
      (exit-stage prev-stage))
    (set! stack (cons stage stack))
    (enter-stage stage)))

(define (pop-scene)
  "Replace the current stage with the next one on the stack, if
present."
  (let ((prev-stage (current-stage)))
    (when prev-stage
      (exit-stage prev-stage))
    (set! stack (cdr stack))
    (when (current-stage)
      (enter-stage (current-stage)))))

(define (replace-scene scene)
  "Replace the current stage with STAGE."
  (let ((prev-stage (current-stage))
        (stage (make-stage scene)))
    (when prev-stage
      (exit-stage prev-stage))
    (set! stack (cons stage (cdr stack)))
    (enter-stage stage)))