blob: dfd747a7f5bf94f846b57da920b8b75f7548e8da (
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
134
135
136
137
138
139
140
141
142
143
|
;;; 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:
;;
;; Actions are composable procedures that perform an operation over a
;; period of game time.
;;
;;; Code:
(define-module (2d actions)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-1)
#:use-module (2d agenda)
#:use-module (2d coroutine)
#:export (<action>
make-action
action?
null-action
null-action?
action-duration
action-proc
perform-action
schedule-action
action-cons
action-list
action-parallel
action-repeat
idle
lerp))
;;;
;;; Action Procedures
;;;
;; Actions encapsulate a procedure that performs an action and the
;; duration of the action in game ticks.
(define-record-type <action>
(%make-action proc duration)
action?
(duration action-duration)
(proc action-proc))
(define (make-action proc duration)
"Returns a new action object. Throws an error if duration is 0."
(if (zero? duration)
(throw 'action-duration-zero)
(%make-action proc duration)))
(define (step-action action t)
"Run action proc with given delta t"
((action-proc action) t))
(define (perform-action action)
"Perform the given action."
(let ((duration (action-duration action)))
(define (step time)
(if (= duration time)
(step-action action 1)
(begin
(step-action action (/ time duration))
(wait)
(step (1+ time)))))
(step 1)))
(define (schedule-action action)
"Schedules a coroutine to run the given action."
(agenda-schedule (colambda () (perform-action action))))
(define (action-cons a1 a2)
"Returns an action that performs a1 first, followed by a2."
(define (real-cons)
(let* ((duration (+ (action-duration a1) (action-duration a2)))
(t1 (/ (action-duration a1) duration))
(t2 (/ (action-duration a2) duration)))
(make-action
(lambda (t)
(if (> t t1)
(step-action a2 (/ (- t t1) t2))
(step-action a1 (/ t t1))))
duration)))
;; a2 can be #f, if this is the last action-cons of an action-list.
(if a2 (real-cons) a1))
(define (action-list . actions)
"Returns an action that executes actions in sequence."
(if (null? actions)
#f
(action-cons (car actions) (apply action-list (cdr actions)))))
(define (action-parallel . actions)
"Perform the given actions in parallel."
(let ((max-duration (reduce max 0 (map action-duration actions))))
;; Add idle action to each action to fill the time
;; difference between the action's duration and the
;; max action duration.
(define (fill-action action)
(if (= (action-duration action) max-duration)
action
(action-cons action (idle (- max-duration (action-duration action))))))
(let ((filled-actions (map fill-action actions)))
(make-action
(lambda (t)
(for-each (lambda (a) (step-action a t)) filled-actions))
max-duration))))
(define (action-repeat n action)
"Repeat an action n times."
(apply action-list (make-list n action)))
;;;
;;; Simple Actions
;;;
(define (idle duration)
"Do nothing."
(make-action (lambda (t) #t) duration))
(define (lerp proc start end duration)
"Linearly interpolate a number from start to end. Calls proc with the
interpolated value every frame."
(let ((delta (- end start)))
(make-action
(lambda (t)
(if (= t 1)
(proc end)
(proc (+ start (* delta t)))))
duration)))
|
