blob: df93b26b550f9581784e82c6ced59802e707debf (
about) (
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
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
|
;;; The Inevitable Game
;;; Copyright © 2018, 2021 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This program is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation, either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This program 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
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program. If not, see
;;; <http://www.gnu.org/licenses/>.
(define-module (utils)
#:use-module (chickadee)
#:use-module (chickadee audio)
#:use-module (chickadee math vector)
#:use-module (chickadee graphics color)
#:use-module (chickadee graphics text)
#:use-module (chickadee graphics path)
#:use-module (chickadee graphics sprite)
#:use-module (chickadee graphics texture)
#:use-module (chickadee graphics tile-map)
#:use-module (chickadee scripting)
#:use-module (config)
#:use-module (engine assets)
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:use-module (oop goops)
#:export (arrange-text
<label>
draw-label
visible?
<sprite>
agenda
position
texture
tint
draw
<animated-sprite>
atlas
draw-animated-sprite
update-animated-sprite
change-sprite-animation
<character>
name
velocity
walk-speed
direction
conversations
accepted-messages
speaking?
walk))
(define* (arrange-text text font #:key
(margin 0.0)
(max-width %width))
"Take the string TEXT and split it at spaces so that it fits in the
given MAX-WIDTH. Return a list of lines."
(match (fold (lambda (chunk acc)
(match acc
((#:width width #:result (and (current-line . tail) lines))
(let* ((new-line (string-append current-line " " chunk))
(new-width (font-line-width font new-line)))
(if (< (+ new-width margin) max-width)
`(#:width ,new-width
#:result ,(cons new-line tail))
`(#:width ,(font-line-width font chunk)
#:result ,(cons chunk lines)))))))
'(#:width 0 #:result (""))
(string-tokenize text))
((#:width _ #:result lines)
(reverse lines))))
(define-class <label> ()
(position #:accessor position #:init-keyword #:position)
(visible? #:accessor visible? #:init-keyword #:visible?)
(font #:accessor font #:init-keyword #:font)
(text #:accessor text #:init-form "" #:init-keyword #:text))
(define-method (draw-label label alpha)
(when (visible? label)
(draw-text (text label) (position label)
#:font (asset-ref (font label)))))
(define-class <sprite> ()
(agenda #:getter agenda #:init-form (make-agenda))
(position #:accessor position #:init-keyword #:position)
(texture #:accessor texture #:init-keyword #:texture)
(tint #:accessor tint #:init-keyword #:tint #:init-form white))
(define-method (draw (sprite <sprite>) alpha)
(draw-sprite (asset-ref (texture sprite))
(position sprite)
#:tint (tint sprite)))
(define-class <animated-sprite> (<sprite>)
(atlas #:accessor atlas #:init-keyword #:atlas)
(animations #:accessor animations #:init-keyword #:animations)
(frame-duration #:accessor frame-duration #:init-keyword #:frame-duration)
(current-animation #:accessor current-animation
#:init-keyword #:current-animation)
(start-time #:accessor start-time #:init-form 0))
(define (draw-animated-sprite sprite offset)
(draw-sprite (asset-ref (texture sprite))
(vec2+ offset (position sprite))
#:tint (tint sprite)))
(define (update-animated-sprite sprite)
(let* ((anim (assq-ref (animations sprite) (current-animation sprite)))
(frame-duration (frame-duration sprite))
(anim-duration (* frame-duration (vector-length anim)))
(time (floor-remainder (- (agenda-time) (start-time sprite))
anim-duration))
(frame (vector-ref anim (inexact->exact
(floor (/ time frame-duration)))))
(texture-region (texture-atlas-ref (asset-ref (atlas sprite)) frame)))
(set! (texture sprite) texture-region)))
(define (change-sprite-animation sprite name)
(set! (current-animation sprite) name)
(set! (start-time sprite) (with-agenda (agenda sprite) (agenda-time))))
(define-class <character> (<animated-sprite>)
(name #:getter name #:init-keyword #:name)
(velocity #:getter velocity #:init-form (vec2 0.0 0.0))
(walk-speed #:accessor walk-speed #:init-form 0.8)
(direction #:accessor direction #:init-form '(idle))
(conversations #:accessor conversations #:init-keyword #:conversations)
(accepted-messages #:accessor accepted-messages #:init-form '((hello "Hello there!")))
(speaking? #:accessor speaking? #:init-form #false))
(define-method (walk (character <character>) directions . rest)
(let ((stop? (member 'stop rest)))
(unless (and (equal? (direction character) directions)
(not stop?))
(let ((speed (if stop? 0.0 (walk-speed character))))
(change-sprite-animation character (last directions))
(for-each (lambda (dir)
(case dir
((right)
(set-vec2-x! (velocity character) speed))
((left)
(set-vec2-x! (velocity character) (* -1.0 speed)))
((up)
(set-vec2-y! (velocity character) speed))
((down)
(set-vec2-y! (velocity character) (* -1.0 speed)))
((idle)
(set-vec2-x! (velocity character) 0.0)
(set-vec2-y! (velocity character) 0.0)
(change-sprite-animation
character
(case (last (direction character))
((right) 'idle-right)
((left) 'idle-left)
((up) 'idle-back)
((down) 'idle-front))))))
directions)
(set! (direction character) directions)))))
|
