Show More
@@ -68,19 +68,19 b'' | |||||
68 | (defun call-serv-loc (var-name &rest args) |
|
68 | (defun call-serv-loc (var-name &rest args) | |
69 | (let ((loc-name (get-global var-name 0))) |
|
69 | (let ((loc-name (get-global var-name 0))) | |
70 | (when loc-name |
|
70 | (when loc-name | |
71 |
(let ((loc (getprop |
|
71 | (let ((loc (getprop *locs loc-name))) | |
72 | (when loc |
|
72 | (when loc | |
73 | (call-loc loc-name args)))))) |
|
73 | (call-loc loc-name args)))))) | |
74 |
|
74 | |||
75 | (defun filename-game (filename) |
|
75 | (defun filename-game (filename) | |
76 | (let ((game-name (chain filename (match "(.*/)?([^.]+)(\\.[a-zA-Z]+)?") 2)))) |
|
76 | (let ((game-name (chain filename (match "(.*/)?([^.]+)(\\.[a-zA-Z]+)?") 2)))) | |
77 |
(getprop |
|
77 | (getprop *games game-name)) | |
78 |
|
78 | |||
79 | (defun run-game (name) |
|
79 | (defun run-game (name) | |
80 | (let ((game (filename-game name))) |
|
80 | (let ((game (filename-game name))) | |
81 |
(setf |
|
81 | (setf *main-game name) | |
82 | ;; Replace locations with the new game's |
|
82 | ;; Replace locations with the new game's | |
83 |
(setf |
|
83 | (setf *locs game) | |
84 | (funcall (getprop game |
|
84 | (funcall (getprop game | |
85 | (chain *object (keys game) 0)) |
|
85 | (chain *object (keys game) 0)) | |
86 | (list)))) |
|
86 | (list)))) | |
@@ -139,11 +139,11 b'' | |||||
139 | (setf name (chain name (to-upper-case))) |
|
139 | (setf name (chain name (to-upper-case))) | |
140 | (with-frame |
|
140 | (with-frame | |
141 | (with-call-args args |
|
141 | (with-call-args args | |
142 |
(funcall (getprop |
|
142 | (funcall (getprop *locs name))))) | |
143 |
|
143 | |||
144 | (defun call-act (title) |
|
144 | (defun call-act (title) | |
145 | (with-frame |
|
145 | (with-frame | |
146 |
(funcall (getprop |
|
146 | (funcall (getprop *acts title :act)))) | |
147 |
|
147 | |||
148 | ;;; Text windows |
|
148 | ;;; Text windows | |
149 |
|
149 | |||
@@ -179,29 +179,29 b'' | |||||
179 | ;;; Actions |
|
179 | ;;; Actions | |
180 |
|
180 | |||
181 | (defun add-act (title img act) |
|
181 | (defun add-act (title img act) | |
182 |
(setf (getprop |
|
182 | (setf (getprop *acts title) | |
183 | (create :title title :img img :act act :selected nil)) |
|
183 | (create :title title :img img :act act :selected nil)) | |
184 | (update-acts)) |
|
184 | (update-acts)) | |
185 |
|
185 | |||
186 | (defun del-act (title) |
|
186 | (defun del-act (title) | |
187 |
(delete (getprop |
|
187 | (delete (getprop *acts title)) | |
188 | (update-acts)) |
|
188 | (update-acts)) | |
189 |
|
189 | |||
190 | (defun clear-act () |
|
190 | (defun clear-act () | |
191 |
(setf |
|
191 | (setf *acts (create)) | |
192 | (update-acts)) |
|
192 | (update-acts)) | |
193 |
|
193 | |||
194 | (defun update-acts () |
|
194 | (defun update-acts () | |
195 | (clear-id "qsp-acts") |
|
195 | (clear-id "qsp-acts") | |
196 | (let ((elt (by-id "qsp-acts"))) |
|
196 | (let ((elt (by-id "qsp-acts"))) | |
197 |
(for-in (title |
|
197 | (for-in (title *acts) | |
198 |
(let ((obj (getprop |
|
198 | (let ((obj (getprop *acts title))) | |
199 | (incf (inner-html elt) (make-act-html title (getprop obj :img))))))) |
|
199 | (incf (inner-html elt) (make-act-html title (getprop obj :img))))))) | |
200 |
|
200 | |||
201 | (defun select-act (title) |
|
201 | (defun select-act (title) | |
202 |
(loop :for (k v) :of |
|
202 | (loop :for (k v) :of *acts | |
203 | :do (setf (getprop v :selected) nil)) |
|
203 | :do (setf (getprop v :selected) nil)) | |
204 |
(setf (getprop |
|
204 | (setf (getprop *acts title :selected) t) | |
205 | (call-serv-loc "$ONACTSEL")) |
|
205 | (call-serv-loc "$ONACTSEL")) | |
206 |
|
206 | |||
207 | ;;; "Syntax" |
|
207 | ;;; "Syntax" | |
@@ -244,13 +244,13 b'' | |||||
244 | (elt slot (getprop slot :indexes index)))) |
|
244 | (elt slot (getprop slot :indexes index)))) | |
245 |
|
245 | |||
246 | (defun get-global (name index) |
|
246 | (defun get-global (name index) | |
247 |
(elt (getprop |
|
247 | (elt (getprop *globals name) index)) | |
248 |
|
248 | |||
249 | (defun kill-var (store name &optional index) |
|
249 | (defun kill-var (store name &optional index) | |
250 | (setf name (chain name (to-upper-case))) |
|
250 | (setf name (chain name (to-upper-case))) | |
251 | (if (and index (not (= 0 index))) |
|
251 | (if (and index (not (= 0 index))) | |
252 |
(chain (getprop |
|
252 | (chain (getprop *vars name) (kill index)) | |
253 |
(delete (getprop |
|
253 | (delete (getprop *vars name))) | |
254 | (void)) |
|
254 | (void)) | |
255 |
|
255 | |||
256 | (defun array-size (name) |
|
256 | (defun array-size (name) | |
@@ -259,28 +259,28 b'' | |||||
259 | ;;; Locals |
|
259 | ;;; Locals | |
260 |
|
260 | |||
261 | (defun push-local-frame () |
|
261 | (defun push-local-frame () | |
262 |
(chain |
|
262 | (chain *locals (push (create))) | |
263 | (void)) |
|
263 | (void)) | |
264 |
|
264 | |||
265 | (defun pop-local-frame () |
|
265 | (defun pop-local-frame () | |
266 |
(chain |
|
266 | (chain *locals (pop)) | |
267 | (void)) |
|
267 | (void)) | |
268 |
|
268 | |||
269 | (defun current-local-frame () |
|
269 | (defun current-local-frame () | |
270 |
(elt |
|
270 | (elt *locals (1- (length *locals)))) | |
271 |
|
271 | |||
272 | ;;; Objects |
|
272 | ;;; Objects | |
273 |
|
273 | |||
274 | (defun select-obj (title img) |
|
274 | (defun select-obj (title img) | |
275 |
(loop :for (k v) :of |
|
275 | (loop :for (k v) :of *objs | |
276 | :do (setf (getprop v :selected) nil)) |
|
276 | :do (setf (getprop v :selected) nil)) | |
277 |
(setf (getprop |
|
277 | (setf (getprop *objs title :selected) t) | |
278 | (call-serv-loc "$ONOBJSEL" title img)) |
|
278 | (call-serv-loc "$ONOBJSEL" title img)) | |
279 |
|
279 | |||
280 | (defun update-objs () |
|
280 | (defun update-objs () | |
281 | (let ((elt (by-id "qsp-objs"))) |
|
281 | (let ((elt (by-id "qsp-objs"))) | |
282 | (setf (inner-html elt) "<ul>") |
|
282 | (setf (inner-html elt) "<ul>") | |
283 |
(loop :for (name obj) :of |
|
283 | (loop :for (name obj) :of *objs | |
284 | :do (incf (inner-html elt) |
|
284 | :do (incf (inner-html elt) | |
285 | (make-obj name (@ obj :img) (@ obj :selected)))) |
|
285 | (make-obj name (@ obj :img) (@ obj :selected)))) | |
286 | (incf (inner-html elt) "</ul>"))) |
|
286 | (incf (inner-html elt) "</ul>"))) | |
@@ -312,12 +312,12 b'' | |||||
312 | (setf (@ elt style display) "block"))) |
|
312 | (setf (@ elt style display) "block"))) | |
313 |
|
313 | |||
314 | (defun finish-menu (loc) |
|
314 | (defun finish-menu (loc) | |
315 |
(when |
|
315 | (when *menu-resume | |
316 | (let ((elt (get-frame :dropdown))) |
|
316 | (let ((elt (get-frame :dropdown))) | |
317 | (setf (inner-html elt) "") |
|
317 | (setf (inner-html elt) "") | |
318 | (setf (@ elt style display) "none") |
|
318 | (setf (@ elt style display) "none") | |
319 |
(funcall |
|
319 | (funcall *menu-resume) | |
320 |
(setf |
|
320 | (setf *menu-resume nil)) | |
321 | (when loc |
|
321 | (when loc | |
322 | (call-loc loc))) |
|
322 | (call-loc loc))) | |
323 | (void)) |
|
323 | (void)) | |
@@ -325,16 +325,16 b'' | |||||
325 | (defun menu (menu-data) |
|
325 | (defun menu (menu-data) | |
326 | (with-sleep (resume) |
|
326 | (with-sleep (resume) | |
327 | (open-menu menu-data) |
|
327 | (open-menu menu-data) | |
328 |
(setf |
|
328 | (setf *menu-resume resume)) | |
329 | (void)) |
|
329 | (void)) | |
330 |
|
330 | |||
331 | ;;; Content |
|
331 | ;;; Content | |
332 |
|
332 | |||
333 | (defun clean-audio () |
|
333 | (defun clean-audio () | |
334 |
(loop :for k :in (chain *object (keys |
|
334 | (loop :for k :in (chain *object (keys *playing)) | |
335 |
:for v := (getprop |
|
335 | :for v := (getprop *playing k) | |
336 | :do (when (@ v ended) |
|
336 | :do (when (@ v ended) | |
337 |
(delete (@ |
|
337 | (delete (@ *playing k))))) | |
338 |
|
338 | |||
339 | (defun show-image (path) |
|
339 | (defun show-image (path) | |
340 | (let ((img (get-frame :image))) |
|
340 | (let ((img (get-frame :image))) | |
@@ -406,30 +406,30 b'' | |||||
406 |
|
406 | |||
407 | (defun stash-state (args) |
|
407 | (defun stash-state (args) | |
408 | (call-serv-loc "$ONGSAVE") |
|
408 | (call-serv-loc "$ONGSAVE") | |
409 |
(setf |
|
409 | (setf *state-stash | |
410 | (chain *j-s-o-n (stringify |
|
410 | (chain *j-s-o-n (stringify | |
411 |
(create :vars |
|
411 | (create :vars *vars | |
412 |
:objs |
|
412 | :objs *objs | |
413 | :loc-args args |
|
413 | :loc-args args | |
414 |
:msecs (- (chain *date (now)) |
|
414 | :msecs (- (chain *date (now)) *started-at) | |
415 |
:timer-interval |
|
415 | :timer-interval *timer-interval | |
416 | :main-html (inner-html |
|
416 | :main-html (inner-html | |
417 | (get-frame :main)) |
|
417 | (get-frame :main)) | |
418 | :stat-html (inner-html |
|
418 | :stat-html (inner-html | |
419 | (get-frame :stat)) |
|
419 | (get-frame :stat)) | |
420 |
:next-location |
|
420 | :next-location *current-location)))) | |
421 | (void)) |
|
421 | (void)) | |
422 |
|
422 | |||
423 | (defun unstash-state () |
|
423 | (defun unstash-state () | |
424 |
(let ((data (chain *j-s-o-n (parse |
|
424 | (let ((data (chain *j-s-o-n (parse *state-stash)))) | |
425 | (clear-act) |
|
425 | (clear-act) | |
426 |
(setf |
|
426 | (setf *vars (@ data :vars)) | |
427 |
(loop :for k :in (chain *object (keys |
|
427 | (loop :for k :in (chain *object (keys *vars)) | |
428 |
:do (chain *object (set-prototype-of (getprop |
|
428 | :do (chain *object (set-prototype-of (getprop *vars k) | |
429 | (@ *var prototype)))) |
|
429 | (@ *var prototype)))) | |
430 |
(setf |
|
430 | (setf *started-at (- (chain *date (now)) (@ data :msecs))) | |
431 |
(setf |
|
431 | (setf *objs (@ data :objs)) | |
432 |
(setf |
|
432 | (setf *current-location (@ data :next-location)) | |
433 | (setf (inner-html (get-frame :main)) |
|
433 | (setf (inner-html (get-frame :main)) | |
434 | (@ data :main-html)) |
|
434 | (@ data :main-html)) | |
435 | (setf (inner-html (get-frame :stat)) |
|
435 | (setf (inner-html (get-frame :stat)) | |
@@ -437,21 +437,21 b'' | |||||
437 | (update-objs) |
|
437 | (update-objs) | |
438 | (set-timer (@ data :timer-interval)) |
|
438 | (set-timer (@ data :timer-interval)) | |
439 | (call-serv-loc "$ONGLOAD") |
|
439 | (call-serv-loc "$ONGLOAD") | |
440 |
(call-loc |
|
440 | (call-loc *current-location (@ data :loc-args)) | |
441 | (void))) |
|
441 | (void))) | |
442 |
|
442 | |||
443 | (defun state-to-base64 () |
|
443 | (defun state-to-base64 () | |
444 |
(btoa (encode-u-r-i-component |
|
444 | (btoa (encode-u-r-i-component *state-stash))) | |
445 |
|
445 | |||
446 | (defun base64-to-state (data) |
|
446 | (defun base64-to-state (data) | |
447 |
(setf |
|
447 | (setf *state-stash (decode-u-r-i-component (atob data)))) | |
448 |
|
448 | |||
449 | ;;; Timers |
|
449 | ;;; Timers | |
450 |
|
450 | |||
451 | (defun set-timer (interval) |
|
451 | (defun set-timer (interval) | |
452 |
(setf |
|
452 | (setf *timer-interval interval) | |
453 |
(clear-interval |
|
453 | (clear-interval *timer-obj) | |
454 |
(setf |
|
454 | (setf *timer-obj | |
455 | (set-interval |
|
455 | (set-interval | |
456 | (lambda () |
|
456 | (lambda () | |
457 | (call-serv-loc "$COUNTER")) |
|
457 | (call-serv-loc "$COUNTER")) |
@@ -17,10 +17,10 b'' | |||||
17 | ;;; 3expr |
|
17 | ;;; 3expr | |
18 |
|
18 | |||
19 | (defpsmacro obj (name) |
|
19 | (defpsmacro obj (name) | |
20 |
`(in ,name |
|
20 | `(in ,name objs)) | |
21 |
|
21 | |||
22 | (defpsmacro loc (name) |
|
22 | (defpsmacro loc (name) | |
23 |
`(in ,name |
|
23 | `(in ,name locs)) | |
24 |
|
24 | |||
25 | (defpsmacro no (arg) |
|
25 | (defpsmacro no (arg) | |
26 | `(- -1 ,arg)) |
|
26 | `(- -1 ,arg)) | |
@@ -31,7 +31,7 b'' | |||||
31 | "0.0.1") |
|
31 | "0.0.1") | |
32 |
|
32 | |||
33 | (defpsmacro curloc () |
|
33 | (defpsmacro curloc () | |
34 |
` |
|
34 | `current-location) | |
35 |
|
35 | |||
36 | (defpsmacro rnd () |
|
36 | (defpsmacro rnd () | |
37 | `(funcall rand 1 1000)) |
|
37 | `(funcall rand 1 1000)) | |
@@ -123,17 +123,17 b'' | |||||
123 | `(api-call enable-frame :objs ,enable)) |
|
123 | `(api-call enable-frame :objs ,enable)) | |
124 |
|
124 | |||
125 | (defpsmacro countobj () |
|
125 | (defpsmacro countobj () | |
126 |
`(length |
|
126 | `(length objs)) | |
127 |
|
127 | |||
128 | (defpsmacro getobj (index) |
|
128 | (defpsmacro getobj (index) | |
129 |
`(or (elt |
|
129 | `(or (elt objs ,index) "")) | |
130 |
|
130 | |||
131 | ;;; 16menu |
|
131 | ;;; 16menu | |
132 |
|
132 | |||
133 | ;;; 17sound |
|
133 | ;;; 17sound | |
134 |
|
134 | |||
135 | (defpsmacro isplay (filename) |
|
135 | (defpsmacro isplay (filename) | |
136 |
`(funcall ( |
|
136 | `(funcall (@ playing includes) ,filename)) | |
137 |
|
137 | |||
138 | ;;; 18img |
|
138 | ;;; 18img | |
139 |
|
139 |
@@ -15,9 +15,9 b'' | |||||
15 | (defun xgoto (target args) |
|
15 | (defun xgoto (target args) | |
16 | (setf args (or args (list))) |
|
16 | (setf args (or args (list))) | |
17 | (api:clear-act) |
|
17 | (api:clear-act) | |
18 |
(setf |
|
18 | (setf *current-location (chain target (to-upper-case))) | |
19 | (api:stash-state args) |
|
19 | (api:stash-state args) | |
20 |
(api:call-loc |
|
20 | (api:call-loc *current-location args) | |
21 | (api:call-serv-loc "ONNEWLOC") |
|
21 | (api:call-serv-loc "ONNEWLOC") | |
22 | (void)) |
|
22 | (void)) | |
23 |
|
23 | |||
@@ -186,35 +186,35 b'' | |||||
186 | ;;; 14act |
|
186 | ;;; 14act | |
187 |
|
187 | |||
188 | (defun curacts () |
|
188 | (defun curacts () | |
189 |
(let ((acts |
|
189 | (let ((acts *acts)) | |
190 | (lambda () |
|
190 | (lambda () | |
191 |
(setf |
|
191 | (setf *acts acts) | |
192 | (void)))) |
|
192 | (void)))) | |
193 |
|
193 | |||
194 | ;;; 15objs |
|
194 | ;;; 15objs | |
195 |
|
195 | |||
196 | (defun addobj (name img) |
|
196 | (defun addobj (name img) | |
197 | (setf img (or img "")) |
|
197 | (setf img (or img "")) | |
198 |
(setf (getprop |
|
198 | (setf (getprop *objs name) | |
199 | (create :name name :img img :selected nil)) |
|
199 | (create :name name :img img :selected nil)) | |
200 | (api:update-objs) |
|
200 | (api:update-objs) | |
201 | (api-call call-serv-loc "ONOBJADD" name img) |
|
201 | (api-call call-serv-loc "ONOBJADD" name img) | |
202 | (void)) |
|
202 | (void)) | |
203 |
|
203 | |||
204 | (defun delobj (name) |
|
204 | (defun delobj (name) | |
205 |
(delete (getprop |
|
205 | (delete (getprop *objs name)) | |
206 | (api-call call-serv-loc "ONOBJDEL" name) |
|
206 | (api-call call-serv-loc "ONOBJDEL" name) | |
207 | (void)) |
|
207 | (void)) | |
208 |
|
208 | |||
209 | (defun killobj (&optional (num nil)) |
|
209 | (defun killobj (&optional (num nil)) | |
210 | (if (eq nil num) |
|
210 | (if (eq nil num) | |
211 |
(setf |
|
211 | (setf *objs (create)) | |
212 |
(delobj (elt (chain *object (keys |
|
212 | (delobj (elt (chain *object (keys *objs)) num))) | |
213 | (api:update-objs) |
|
213 | (api:update-objs) | |
214 | (void)) |
|
214 | (void)) | |
215 |
|
215 | |||
216 | (defun selobj () |
|
216 | (defun selobj () | |
217 |
(loop :for (k v) :of |
|
217 | (loop :for (k v) :of *objs | |
218 | :do (when (@ v :selected) |
|
218 | :do (when (@ v :selected) | |
219 | (return-from selobj (@ v :name))))) |
|
219 | (return-from selobj (@ v :name))))) | |
220 |
|
220 | |||
@@ -246,20 +246,20 b'' | |||||
246 |
|
246 | |||
247 | (defun play (filename &optional (volume 100)) |
|
247 | (defun play (filename &optional (volume 100)) | |
248 | (let ((audio (new (*audio filename)))) |
|
248 | (let ((audio (new (*audio filename)))) | |
249 |
(setf (getprop |
|
249 | (setf (getprop *playing filename) audio) | |
250 | (setf (@ audio volume) (* volume 0.01)) |
|
250 | (setf (@ audio volume) (* volume 0.01)) | |
251 | (chain audio (play)))) |
|
251 | (chain audio (play)))) | |
252 |
|
252 | |||
253 | (defun close (filename) |
|
253 | (defun close (filename) | |
254 |
(funcall ( |
|
254 | (funcall (getprop *playing filename) stop) | |
255 |
(delete ( |
|
255 | (delete (getprop *playing filename)) | |
256 | (void)) |
|
256 | (void)) | |
257 |
|
257 | |||
258 | (defun closeall () |
|
258 | (defun closeall () | |
259 |
(loop :for k :in (chain *object (keys |
|
259 | (loop :for k :in (chain *object (keys *playing)) | |
260 |
:for v := (getprop |
|
260 | :for v := (getprop *playing k) | |
261 | :do (funcall v stop)) |
|
261 | :do (funcall v stop)) | |
262 |
(setf |
|
262 | (setf *playing (create))) | |
263 |
|
263 | |||
264 | ;;; 18img |
|
264 | ;;; 18img | |
265 |
|
265 | |||
@@ -284,7 +284,7 b'' | |||||
284 | ;;; 20time |
|
284 | ;;; 20time | |
285 |
|
285 | |||
286 | (defun msecscount () |
|
286 | (defun msecscount () | |
287 |
(- (chain *date (now)) |
|
287 | (- (chain *date (now)) *started-at)) | |
288 |
|
288 | |||
289 | ;;; 21local |
|
289 | ;;; 21local | |
290 |
|
290 | |||
@@ -303,12 +303,12 b'' | |||||
303 | (defun addqst (name) |
|
303 | (defun addqst (name) | |
304 | (let ((game (api-call filename-game name))) |
|
304 | (let ((game (api-call filename-game name))) | |
305 | ;; Add the game's locations |
|
305 | ;; Add the game's locations | |
306 |
(chain *object (assign |
|
306 | (chain *object (assign *locs | |
307 |
(getprop |
|
307 | (getprop *games name))))) | |
308 |
|
308 | |||
309 | (defun killqst () |
|
309 | (defun killqst () | |
310 | ;; Delete all locations not from the current main game |
|
310 | ;; Delete all locations not from the current main game | |
311 |
(loop :for (k v) :in |
|
311 | (loop :for (k v) :in *games | |
312 |
:do (unless (string= k |
|
312 | :do (unless (string= k *main-game) | |
313 |
(delete (getprop |
|
313 | (delete (getprop *locs k))))) | |
314 |
|
314 |
@@ -8,8 +8,5 b'' | |||||
8 | (defmacro+ps api-call (name &rest args) |
|
8 | (defmacro+ps api-call (name &rest args) | |
9 | `(,(intern (string-upcase name) "API") ,@args)) |
|
9 | `(,(intern (string-upcase name) "API") ,@args)) | |
10 |
|
10 | |||
11 | (defpsmacro root (&rest path) |
|
|||
12 | `(@ data ,@path)) |
|
|||
13 |
|
||||
14 | (defpsmacro in (key obj) |
|
11 | (defpsmacro in (key obj) | |
15 | `(chain ,obj (has-own-property ,key))) |
|
12 | `(chain ,obj (has-own-property ,key))) |
@@ -1,51 +1,48 b'' | |||||
1 |
|
1 | |||
2 | (in-package sugar-qsp.main) |
|
2 | (in-package sugar-qsp.main) | |
3 |
|
3 | |||
4 | (setf (root) |
|
|||
5 | (create |
|
|||
6 |
|
|
4 | ;;; Game session state (saved in savegames) | |
7 |
|
|
5 | ;; Variables | |
8 |
|
|
6 | (var *globals (create)) | |
9 |
|
|
7 | ;; Inventory (objects) | |
10 |
|
|
8 | (var *objs (create)) | |
11 |
|
|
9 | (var *current-location nil) | |
12 |
|
|
10 | ;; Game time | |
13 |
|
|
11 | (var *started-at (chain *date (now))) | |
14 |
|
|
12 | ;; Timers | |
15 |
|
|
13 | (var *timer-interval 500) | |
16 |
|
|
14 | (var *timer-obj nil) | |
17 |
|
|
15 | ;; Games | |
18 |
|
|
16 | (var *loaded-games (list)) | |
19 |
|
17 | |||
20 |
|
|
18 | ;;; Transient state | |
21 |
|
|
19 | ;; ACTions | |
22 |
|
|
20 | (var *acts (create)) | |
23 |
|
|
21 | ;; Savegame data | |
24 |
|
|
22 | (var *state-stash (create)) | |
25 |
|
|
23 | ;; List of audio files being played | |
26 |
|
|
24 | (var *playing (create)) | |
27 |
|
|
25 | ;; Local variables stack (starts with an empty frame) | |
28 |
|
|
26 | (var *locals (list)) | |
29 |
|
27 | |||
30 |
|
|
28 | ;;; Game data | |
31 |
|
|
29 | ;; Games (filename -> [locations]) | |
32 |
|
|
30 | (var *games (list)) | |
33 |
|
|
31 | ;; The main (non library) game. Updated by openqst | |
34 |
|
|
32 | (var *main-game nil) | |
35 |
|
|
33 | ;; Active locations | |
36 |
|
|
34 | (var *locs (create)) | |
37 |
|
35 | |||
38 | ;; Launch the game from the first location |
|
36 | ;; Launch the game from the first location | |
39 | (setf (@ window onload) |
|
37 | (setf (@ window onload) | |
40 | (lambda () |
|
38 | (lambda () | |
41 | (#.(intern "INIT-DOM" "SUGAR-QSP.API")) |
|
39 | (#.(intern "INIT-DOM" "SUGAR-QSP.API")) | |
42 | ;; For MSECCOUNT |
|
40 | ;; For MSECCOUNT | |
43 |
(setf |
|
41 | (setf *started-at (chain *date (now))) | |
44 | ;; For $COUNTER and SETTIMER |
|
42 | ;; For $COUNTER and SETTIMER | |
45 | (#.(intern "SET-TIMER" "SUGAR-QSP.API") |
|
43 | (#.(intern "SET-TIMER" "SUGAR-QSP.API") | |
46 |
|
|
44 | *timer-interval) | |
47 | ;; Start the first game |
|
45 | ;; Start the first game | |
48 | (#.(intern "RUN-GAME" "SUGAR-QSP.API") |
|
46 | (#.(intern "RUN-GAME" "SUGAR-QSP.API") | |
49 |
(chain *object (keys |
|
47 | (chain *object (keys *games) 0)) | |
50 | (values))) |
|
48 | (values))) | |
51 |
|
@@ -6,11 +6,15 b'' | |||||
6 | (defpackage :sugar-qsp.main |
|
6 | (defpackage :sugar-qsp.main | |
7 | (:use :cl :ps :sugar-qsp.js) |
|
7 | (:use :cl :ps :sugar-qsp.js) | |
8 | (:export #:api-call #:by-id |
|
8 | (:export #:api-call #:by-id | |
9 |
|
|
9 | #:in | |
10 | #:vars #:objs #:current-location |
|
10 | ||
11 | #:started-at #:timer-interval #:timer-obj |
|
11 | #:*globals #:*objs #:*current-location | |
12 | #:state-stash #:playing #:locals |
|
12 | #:*started-at #:*timer-interval #:*timer-obj #:*loaded-games | |
13 | #:acts #:locs #:games)) |
|
13 | ||
|
14 | #:*acts #:*state-stash #:*playing #:*locals | |||
|
15 | ||||
|
16 | #:*games #:*main-game #:*locs | |||
|
17 | )) | |||
14 |
|
18 | |||
15 | (defpackage :code-walker |
|
19 | (defpackage :code-walker | |
16 | (:use :cl) |
|
20 | (:use :cl) |
@@ -65,13 +65,13 b'' | |||||
65 | (walker:walk 'globals body) |
|
65 | (walker:walk 'globals body) | |
66 | `(progn |
|
66 | `(progn | |
67 | ;; Game object |
|
67 | ;; Game object | |
68 |
(setf ( |
|
68 | (setf (@ *games ,name) | |
69 | (create)) |
|
69 | (create)) | |
70 | ;; Global variables from this game |
|
70 | ;; Global variables from this game | |
71 | (create-globals ,*globals*) |
|
71 | (create-globals ,*globals*) | |
72 | ;; Locations |
|
72 | ;; Locations | |
73 | ,@(loop :for location :in body |
|
73 | ,@(loop :for location :in body | |
74 |
:collect `(setf ( |
|
74 | :collect `(setf (@ *games ,name ,(caadr location)) | |
75 | ,location)))) |
|
75 | ,location)))) | |
76 |
|
76 | |||
77 | (defpsmacro location ((name) &body body) |
|
77 | (defpsmacro location ((name) &body body) | |
@@ -104,7 +104,7 b'' | |||||
104 | :test-not #'eq)))))) |
|
104 | :test-not #'eq)))))) | |
105 | (let ((names (remove-duplicates (mapcar #'first globals)))) |
|
105 | (let ((names (remove-duplicates (mapcar #'first globals)))) | |
106 | `(chain *object |
|
106 | `(chain *object | |
107 |
(assign |
|
107 | (assign *globals | |
108 | (create |
|
108 | (create | |
109 | ,@(loop :for sym :in names |
|
109 | ,@(loop :for sym :in names | |
110 | :for indexes := (indexes sym) |
|
110 | :for indexes := (indexes sym) | |
@@ -169,7 +169,7 b'' | |||||
169 | (declare (ignore qspvar)) |
|
169 | (declare (ignore qspvar)) | |
170 | (let ((slot `(getprop |
|
170 | (let ((slot `(getprop | |
171 | ,(if (member name *locals* :key #'first) |
|
171 | ,(if (member name *locals* :key #'first) | |
172 |
'locals ' |
|
172 | 'locals '*globals) | |
173 | ,(string-upcase name)))) |
|
173 | ,(string-upcase name)))) | |
174 | (cond |
|
174 | (cond | |
175 | ((null index) |
|
175 | ((null index) | |
@@ -192,7 +192,7 b'' | |||||
192 |
|
192 | |||
193 | (walker:deftransform apply-vars qspvar (name index) |
|
193 | (walker:deftransform apply-vars qspvar (name index) | |
194 | (let ((slot `(getprop |
|
194 | (let ((slot `(getprop | |
195 |
,(if (member name *locals* :key #'first) 'locals ' |
|
195 | ,(if (member name *locals* :key #'first) 'locals '*globals) | |
196 | ,(string-upcase name)))) |
|
196 | ,(string-upcase name)))) | |
197 | (cond |
|
197 | (cond | |
198 | ((null index) |
|
198 | ((null index) |
General Comments 0
You need to be logged in to leave comments.
Login now