/
editor.lisp
298 lines (258 loc) · 11.5 KB
/
editor.lisp
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
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
(in-package #:org.shirakumo.fraf.ld45)
(defparameter +grid-size+ 32)
(defparameter +editable-items+ '(wall guard player goal gun radar bionic-eye))
(define-subject editor (located-entity)
((name :initform :editor)
(entity :initform nil :accessor entity)
(mode :initform :select :accessor mode)
(vel :initform (vec 0 0) :accessor vel)
(start-location :initform nil :accessor start-location)
(visible-path :initform nil :accessor visible-path)
(to-place :initform 'wall :accessor to-place)))
(define-subject inactive-editor (editor)
())
(defmethod active-p ((_ inactive-editor)) NIL)
(define-handler (inactive-editor toggle-editor) (ev)
(change-class inactive-editor 'active-editor))
(define-subject active-editor (editor)
())
(defmethod active-p ((_ active-editor)) T)
(define-handler (active-editor toggle-editor) (ev)
(change-class active-editor 'inactive-editor))
(define-handler (active-editor save-world) (ev)
(unless (packet +world+)
(with-packet (packet (merge-pathnames
(query "Please enter the world save path" :parse #'uiop:native-namestring)
(pool-path 'ld45 NIL))
:direction :input)
(setf (packet +world+) packet)))
(save-world +world+ T :version T))
(define-handler (active-editor load-world) (ev)
(change-scene (handler *context*) (load-world +world+)))
;;; Mode switching
(define-handler (active-editor select-entity) (ev)
(setf (mode active-editor) :select))
(define-handler (active-editor delete-entity) (ev)
(setf (mode active-editor) :delete))
(define-handler (active-editor place) (ev)
(case (to-place active-editor)
(wall (setf (mode active-editor) :place-wall))
(player (setf (mode active-editor) :place-player))
(guard (setf (mode active-editor) :place-guard))
(T (setf (mode active-editor) :place))))
;;; Entity manipulation
(defgeneric contained-p (point thing)
(:method (point thing) nil))
(defun world-location (screen-position)
(let ((camera (unit :camera t))
(loc (vcopy screen-position)))
(nv+ (nv/ loc (view-scale camera)) (location camera))
(nv- loc (v/ (target-size camera) (zoom camera)))
(decf (vy loc) (/ (vy (target-size camera)) 1/2 (zoom camera)))
loc))
(defun entity-at-point (point world)
(for:for ((entity over world))
(when (contained-p point entity)
(return entity))))
(define-handler (active-editor mouse-press) (ev pos button)
(case (mode active-editor)
(:select
(let ((entity (entity-at-point (world-location pos) +world+)))
(if (typep entity 'guard)
(show-path active-editor entity)
(hide-path active-editor))
(cond
((and (eq button :left) (typep entity 'located-entity))
(setf (entity active-editor) entity)
(setf (mode active-editor) :moving)))))
(:delete
(let ((entity (entity-at-point (world-location pos) +world+)))
(leave entity +world+)
(setf (mode active-editor) :select)
(update-scene-cache +world+ +world+)))
(:place-wall
(let* ((location (nvalign (world-location pos) +grid-size+))
(wall (make-instance 'wall
:location location
:size (vec2 0 0))))
(setf (start-location active-editor) location)
(transition wall +world+)
(enter wall +world+)
(setf (entity active-editor) wall)
(setf (mode active-editor) :placing-wall)))
(:place-player
(let* ((location (nvalign (world-location pos) +grid-size+))
(player (make-instance 'player
:location location)))
(enter player +world+)
(setf (mode active-editor) :select)))
(:place-guard
(handle-place-guard-press active-editor pos button))
(:placing-guard
(handle-placing-guard-press active-editor pos button))
(:place
(let* ((location (nvalign (world-location pos) +grid-size+))
(goal (make-instance (to-place active-editor)
:location location)))
(transition goal +world+)
(enter goal +world+)
(setf (mode active-editor) :select)))))
(define-handler (active-editor mouse-release) (ev pos button)
(case (mode active-editor)
(:moving
(setf (mode active-editor) :select))
(:placing-wall
(let* ((entity (entity active-editor))
(size (size entity)))
(when (or (zerop (vx size))
(zerop (vy size)))
(leave entity +world+)
(update-scene-cache +world+ +world+)))
(setf (mode active-editor) :select))))
(define-handler (active-editor mouse-move) (ev pos)
(case (mode active-editor)
(:placing-wall
(let* ((entity (entity active-editor))
(location (nvalign (world-location pos) +grid-size+))
(start-location (start-location active-editor))
(size (v- location start-location)))
(setf (size entity) (vabs size))
(setf (location entity) (v- location (v/ size 2)))
(update-scene-cache +world+ +world+)))
(:moving
(let* ((entity (entity active-editor))
(bsize (bsize entity)))
(setf (location (entity active-editor))
(v+ (nvalign (v- (world-location pos) bsize) +grid-size+)
bsize)))
(update-scene-cache +world+ +world+))))
(define-handler (active-editor mouse-scroll) (ev delta)
(cond ((or (retained 'key :control)
(retained 'key :left-control) (retained 'key :control-l)
(retained 'key :right-control) (retained 'key :control-r))
(handle-editor-zoom delta))
((eq :placing-guard (mode active-editor))
(handle-modify-guard-delay active-editor (if (< 0 delta) 1 -1)))
(T
(let ((pos (position (to-place active-editor) +editable-items+)))
(setf (to-place active-editor) (elt +editable-items+ (mod (+ pos (round delta)) (length +editable-items+))))
(v:info :editor "Now placing ~s." (to-place active-editor))))))
(define-handler (active-editor tick) (ev)
(update-visible-path active-editor)
(update-editor-location active-editor))
;;; Placing guards
(defun handle-place-guard-press (editor pos button)
(declare (ignore button))
(let* ((location (nvalign (world-location pos) +grid-size+))
(guard (make-instance 'guard :location location)))
(transition guard +world+)
(enter guard +world+)
(setf (entity editor) guard)
(setf (mode editor) :placing-guard)))
(defun handle-placing-guard-press (editor pos button)
(let ((location (nvalign (world-location pos) +grid-size+))
(guard (entity editor)))
(case button
(:left
(vector-push-extend (route-node location 0) (route guard))
(show-path editor guard))
(:right
(when (plusp (length (route guard)))
(vector-pop (route guard)))))))
(defun handle-modify-guard-delay (editor change)
(let* ((route (route (entity editor))))
(when (plusp (length route))
(let ((node (elt route (1- (fill-pointer route)))))
(setf (delay node) (max 0 (+ change (delay node))))))))
(define-handler (active-editor loop-guard-path) (ev)
(when (eq :placing-guard (mode active-editor))
(setf (end-action (entity active-editor)) :loop)))
(define-handler (active-editor reverse-guard-path) (ev)
(when (eq :placing-guard (mode active-editor))
(setf (end-action (entity active-editor)) :reverse)))
(define-handler (active-editor finish-guard-path) (ev)
(when (eq :placing-guard (mode active-editor))
(let ((guard (entity active-editor)))
(setf (mode active-editor) :select)
(when (plusp (length (route guard)))
(setf (state guard) :patrol)))))
;;; Zooming and moving the camera
(defun handle-editor-zoom (delta)
(let ((camera (unit :camera +world+)))
(setf (zoom camera) (* (zoom camera) (if (< 0 delta) 1.5 (/ 1.5))))))
(defun update-editor-location (editor)
(let ((speed (/ 20 (zoom (unit :camera +world+)))))
(cond ((retained 'movement :left) (setf (vx (vel editor)) (- speed)))
((retained 'movement :right) (setf (vx (vel editor)) (+ speed)))
(T (setf (vx (vel editor)) 0)))
(cond ((retained 'movement :up) (setf (vy (vel editor)) (+ speed)))
((retained 'movement :down) (setf (vy (vel editor)) (- speed)))
(T (setf (vy (vel editor)) 0))))
(nv+ (location editor) (vel editor))
(setf (location (unit :camera +world+)) (location editor)))
;;; Route visualization
(define-shader-entity visible-path (vertex-entity)
((mesh :initform nil :accessor mesh)))
(defmethod (setf mesh) :after (mesh (entity visible-path))
(if (slot-boundp entity 'vertex-array)
(let ((vbo (car (second (bindings (vertex-array entity)))))
(ebo (first (bindings (vertex-array entity)))))
(trial::replace-vertex-data (buffer-data vbo) mesh)
(setf (buffer-data ebo) (faces mesh))
(trial:resize-buffer vbo (* (length (buffer-data vbo)) (gl-type-size :float))
:data (buffer-data vbo))
(trial:resize-buffer ebo (* (length (buffer-data ebo)) (gl-type-size :float))
:data (buffer-data ebo))
(setf (size (vertex-array entity)) (length (faces mesh))))
(setf (vertex-array entity) (change-class mesh 'vertex-array))))
(defun route-vertices (guard)
(with-vertex-filling ((make-instance 'vertex-mesh :vertex-type 'colored-vertex :face-length 2))
(let ((route (route guard))
(route-index (route-index guard)))
(loop for node across route
for previous-location = nil then location
for location = (location node)
for i from 0
when previous-location
do (vertex :position (vxy_ previous-location)
:color (vec 1 0 0 1))
and do (vertex :position (vxy_ location)
:color (vec 1 0 0 1))
;; Render a line proportionate to the delay
do (loop
repeat (delay node)
for i from 1
do (vertex :position (vxy_ (v+ location (vec 0 (* 5 (- i)))))
:color (vec 1 1 1 1))
(vertex :position (vxy_ (v+ location (vec 7 (* 5 (- i)))))
:color (vec 1 1 1 1))))
;; Close the loop if necessary
(when (and (eq :loop (end-action guard))
(< 2 (length route)))
(vertex :position (vxy_ (location (elt route (1- (length route)))))
:color (vec 0 0 1 1))
(vertex :position (vxy_ (location (elt route 0)))
:color (vec 0 0 1 1)))
;; Draw a line from the guard to its current destination
(when (< route-index (length route))
(vertex :position (vxy_ (location guard))
:color (vec 0 1 0 1))
(vertex :position (vxy_ (vxy_ (location (elt route route-index))))
:color (vec 0 1 0 1))))))
(defun show-path (editor guard)
(when (plusp (length (route guard)))
(if (visible-path editor)
(setf (mesh (visible-path editor)) (route-vertices guard))
(let ((visible-path (make-instance 'visible-path)))
(setf (mesh visible-path) (route-vertices guard))
(transition visible-path +world+)
(enter visible-path +world+)
(setf (visible-path editor) visible-path)))))
(defun hide-path (editor)
(when (visible-path editor)
(leave (visible-path editor) +world+)
(setf (visible-path editor) nil)))
(defun update-visible-path (editor)
(when (and (visible-path editor)
(typep (entity editor) 'guard))
(setf (mesh (visible-path editor)) (route-vertices (entity editor)))))