Show More
@@ -1,9 +1,5 b'' | |||
|
1 | 1 | |
|
2 | * Use Parenscript's packages | |
|
3 | * Use Parenscript's minifier | |
|
4 | * Remove dots | |
|
5 | 2 | * MENU with async/await |
|
6 | * Find a way to minify syntax (extra returns at least) | |
|
7 | 3 | * Special locations |
|
8 | 4 | * Special variables |
|
9 | 5 | * CLI build for Linux |
@@ -125,7 +125,7 b'' | |||
|
125 | 125 | (defun enable-frame (key enable) |
|
126 | 126 | (let ((obj (get-frame key))) |
|
127 | 127 | (setf (@ obj style display) (if enable "block" "none")) |
|
128 |
(v |
|
|
128 | (void))) | |
|
129 | 129 | |
|
130 | 130 | ;;; Actions |
|
131 | 131 | |
@@ -167,7 +167,7 b'' | |||
|
167 | 167 | (setf (@ this indexes) (create)) |
|
168 | 168 | ;; From numbers to {num: 0, str: ""} objects |
|
169 | 169 | (setf (@ this values) (list)) |
|
170 |
(v |
|
|
170 | (void)) | |
|
171 | 171 | |
|
172 | 172 | (defun new-value () |
|
173 | 173 | (create :num 0 :str "")) |
@@ -202,7 +202,7 b'' | |||
|
202 | 202 | (setf (getprop (@ this values) |
|
203 | 203 | (chain this (index-num index)) |
|
204 | 204 | slot) value) |
|
205 |
(v |
|
|
205 | (void))) | |
|
206 | 206 | |
|
207 | 207 | (setf (@ *var prototype kill) |
|
208 | 208 | (lambda (index) |
@@ -220,7 +220,7 b'' | |||
|
220 | 220 | (defun ensure-var (name) |
|
221 | 221 | (let ((store (var-ref name))) |
|
222 | 222 | (unless store |
|
223 |
(setf store (new ( |
|
|
223 | (setf store (new (*var name))) | |
|
224 | 224 | (setf (getprop (root vars) name) store)) |
|
225 | 225 | store)) |
|
226 | 226 | |
@@ -237,7 +237,7 b'' | |||
|
237 | 237 | |
|
238 | 238 | (defun set-var (name index slot value) |
|
239 | 239 | (chain (ensure-var name) (set index slot value)) |
|
240 |
(v |
|
|
240 | (void)) | |
|
241 | 241 | |
|
242 | 242 | (defun get-array (name) |
|
243 | 243 | (var-ref name)) |
@@ -246,13 +246,13 b'' | |||
|
246 | 246 | (let ((store (var-ref name))) |
|
247 | 247 | (setf (@ store values) (@ value values)) |
|
248 | 248 | (setf (@ store indexes) (@ value indexes))) |
|
249 |
(v |
|
|
249 | (void)) | |
|
250 | 250 | |
|
251 | 251 | (defun kill-var (name &optional index) |
|
252 | 252 | (if (and index (not (= 0 index))) |
|
253 | 253 | (chain (getprop (root vars) name) (kill index)) |
|
254 | 254 | (delete (getprop (root vars) name))) |
|
255 |
(v |
|
|
255 | (void)) | |
|
256 | 256 | |
|
257 | 257 | (defun array-size (name) |
|
258 | 258 | (getprop (var-ref name) 'length)) |
@@ -261,11 +261,11 b'' | |||
|
261 | 261 | |
|
262 | 262 | (defun push-local-frame () |
|
263 | 263 | (chain (root locals) (push (create))) |
|
264 |
(v |
|
|
264 | (void)) | |
|
265 | 265 | |
|
266 | 266 | (defun pop-local-frame () |
|
267 | 267 | (chain (root locals) (pop)) |
|
268 |
(v |
|
|
268 | (void)) | |
|
269 | 269 | |
|
270 | 270 | (defun current-local-frame () |
|
271 | 271 | (elt (root locals) (1- (length (root locals))))) |
@@ -274,7 +274,7 b'' | |||
|
274 | 274 | (let ((frame (current-local-frame))) |
|
275 | 275 | (unless (in name frame) |
|
276 | 276 | (setf (getprop frame name) (create))) |
|
277 |
(v |
|
|
277 | (void))) | |
|
278 | 278 | |
|
279 | 279 | ;;; Objects |
|
280 | 280 | |
@@ -357,35 +357,37 b'' | |||
|
357 | 357 | (call-serv-loc "ONGSAVE") |
|
358 | 358 | (setf (root state-stash) |
|
359 | 359 | (chain *j-s-o-n (stringify |
|
360 | (create vars (root vars) | |
|
361 | objs (root objs) | |
|
362 | loc-args args | |
|
363 | msecs (- (chain *date (now)) (root started-at)) | |
|
364 |
|
|
|
360 | (create :vars (root vars) | |
|
361 | :objs (root objs) | |
|
362 | :loc-args args | |
|
363 | :msecs (- (chain *date (now)) (root started-at)) | |
|
364 | :timer-interval (root timer-interval) | |
|
365 | :main-html (inner-html | |
|
365 | 366 | (by-id :qsp-main)) |
|
366 | stat-html (inner-html | |
|
367 | :stat-html (inner-html | |
|
367 | 368 | (by-id :qsp-stat)) |
|
368 | next-location (root current-location))))) | |
|
369 |
(v |
|
|
369 | :next-location (root current-location))))) | |
|
370 | (void)) | |
|
370 | 371 | |
|
371 | 372 | (defun unstash-state () |
|
372 | 373 | (let ((data (chain *j-s-o-n (parse (root state-stash))))) |
|
373 | 374 | (clear-act) |
|
374 | (setf (root vars) (@ data vars)) | |
|
375 | (setf (root vars) (@ data :vars)) | |
|
375 | 376 | (loop :for k :in (chain *object (keys (root vars))) |
|
376 | 377 | :do (chain *object (set-prototype-of (getprop (root vars) k) |
|
377 | 378 | (@ *var prototype)))) |
|
378 | (setf (root started-at) (- (chain *date (now)) (@ data msecs))) | |
|
379 | (setf (root objs) (@ data objs)) | |
|
380 | (setf (root current-location) (@ data next-location)) | |
|
379 | (setf (root started-at) (- (chain *date (now)) (@ data :msecs))) | |
|
380 | (setf (root objs) (@ data :objs)) | |
|
381 | (setf (root current-location) (@ data :next-location)) | |
|
381 | 382 | (setf (inner-html (by-id :qsp-main)) |
|
382 | (@ data main-html)) | |
|
383 | (@ data :main-html)) | |
|
383 | 384 | (setf (inner-html (by-id :qsp-stat)) |
|
384 | (@ data stat-html)) | |
|
385 | (@ data :stat-html)) | |
|
385 | 386 | (update-objs) |
|
387 | (set-timer (@ data :timer-interval)) | |
|
386 | 388 | (call-serv-loc "ONGLOAD") |
|
387 | (call-loc (root current-location) (@ data loc-args)) | |
|
388 |
(v |
|
|
389 | (call-loc (root current-location) (@ data :loc-args)) | |
|
390 | (void))) | |
|
389 | 391 | |
|
390 | 392 | (defun state-to-base64 () |
|
391 | 393 | (btoa (encode-u-r-i-component (root state-stash)))) |
@@ -10,7 +10,7 b'' | |||
|
10 | 10 | (defun goto (target args) |
|
11 | 11 | (api:clear-text :main) |
|
12 | 12 | (funcall xgoto target (or args (list))) |
|
13 |
(v |
|
|
13 | (void)) | |
|
14 | 14 | |
|
15 | 15 | (defun xgoto (target args) |
|
16 | 16 | (api:clear-act) |
@@ -18,7 +18,7 b'' | |||
|
18 | 18 | (api:stash-state args) |
|
19 | 19 | (funcall (getprop (root locs) (root current-location)) |
|
20 | 20 | (or args (list))) |
|
21 |
(v |
|
|
21 | (void)) | |
|
22 | 22 | |
|
23 | 23 | ;;; 2var |
|
24 | 24 | |
@@ -100,7 +100,7 b'' | |||
|
100 | 100 | |
|
101 | 101 | (defun gosub (target &rest args) |
|
102 | 102 | (funcall (getprop (root locs) target) args) |
|
103 |
(v |
|
|
103 | (void)) | |
|
104 | 104 | |
|
105 | 105 | (defun func (target &rest args) |
|
106 | 106 | (funcall (getprop (root locs) target) args)) |
@@ -111,14 +111,14 b'' | |||
|
111 | 111 | |
|
112 | 112 | (defun dynamic (block &rest args) |
|
113 | 113 | (when (stringp block) |
|
114 | (api:report-error "DYNAMIC can't evaluate arbitrary strings.\nUse {braces} to create blocks for DYNAMIC.")) | |
|
114 | (api:report-error "DYNAMIC can't evaluate arbitrary strings.\\nUse {braces} to create blocks for DYNAMIC.")) | |
|
115 | 115 | (api:with-call-args args |
|
116 | 116 | (funcall block args)) |
|
117 |
(v |
|
|
117 | (void)) | |
|
118 | 118 | |
|
119 | 119 | (defun dyneval (block &rest args) |
|
120 | 120 | (when (stringp block) |
|
121 | (api:report-error "DYNEVAL can't evaluate arbitrary strings.\nUse {braces} to create blocks for DYNEVAL.")) | |
|
121 | (api:report-error "DYNEVAL can't evaluate arbitrary strings.\\nUse {braces} to create blocks for DYNEVAL.")) | |
|
122 | 122 | (api:with-call-args args |
|
123 | 123 | (funcall block args))) |
|
124 | 124 | |
@@ -126,21 +126,21 b'' | |||
|
126 | 126 | |
|
127 | 127 | (defun main-p (s) |
|
128 | 128 | (api:add-text :main s) |
|
129 |
(v |
|
|
129 | (void)) | |
|
130 | 130 | |
|
131 | 131 | (defun main-pl (s) |
|
132 | 132 | (api:add-text :main s) |
|
133 | 133 | (api:newline :main) |
|
134 |
(v |
|
|
134 | (void)) | |
|
135 | 135 | |
|
136 | 136 | (defun main-nl (s) |
|
137 | 137 | (api:newline :main) |
|
138 | 138 | (api:add-text :main s) |
|
139 |
(v |
|
|
139 | (void)) | |
|
140 | 140 | |
|
141 | 141 | (defun maintxt (s) |
|
142 | 142 | (api:get-text :main) |
|
143 |
(v |
|
|
143 | (void)) | |
|
144 | 144 | |
|
145 | 145 | ;; For clarity (it leaves a lib.desc() call in JS) |
|
146 | 146 | (defun desc (s) |
@@ -148,38 +148,38 b'' | |||
|
148 | 148 | |
|
149 | 149 | (defun main-clear () |
|
150 | 150 | (api:clear-text :main) |
|
151 |
(v |
|
|
151 | (void)) | |
|
152 | 152 | |
|
153 | 153 | ;;; 12stat |
|
154 | 154 | |
|
155 | 155 | (defun stat-p (s) |
|
156 | 156 | (api:add-text :stat s) |
|
157 |
(v |
|
|
157 | (void)) | |
|
158 | 158 | |
|
159 | 159 | (defun stat-pl (s) |
|
160 | 160 | (api:add-text :stat s) |
|
161 | 161 | (api:newline :stat) |
|
162 |
(v |
|
|
162 | (void)) | |
|
163 | 163 | |
|
164 | 164 | (defun stat-nl (s) |
|
165 | 165 | (api:newline :stat) |
|
166 | 166 | (api:add-text :stat s) |
|
167 |
(v |
|
|
167 | (void)) | |
|
168 | 168 | |
|
169 | 169 | (defun stattxt (s) |
|
170 | 170 | (api:get-text :stat) |
|
171 |
(v |
|
|
171 | (void)) | |
|
172 | 172 | |
|
173 | 173 | (defun stat-clear () |
|
174 | 174 | (api:clear-text :stat) |
|
175 |
(v |
|
|
175 | (void)) | |
|
176 | 176 | |
|
177 | 177 | (defun cls () |
|
178 | 178 | (stat-clear) |
|
179 | 179 | (main-clear) |
|
180 | 180 | (cla) |
|
181 | 181 | (cmdclear) |
|
182 |
(v |
|
|
182 | (void)) | |
|
183 | 183 | |
|
184 | 184 | ;;; 13diag |
|
185 | 185 | |
@@ -189,27 +189,27 b'' | |||
|
189 | 189 | (let ((acts (root acts))) |
|
190 | 190 | (lambda () |
|
191 | 191 | (setf (root acts) acts) |
|
192 |
(v |
|
|
192 | (void)))) | |
|
193 | 193 | |
|
194 | 194 | ;;; 15objs |
|
195 | 195 | |
|
196 | 196 | (defun addobj (name) |
|
197 | 197 | (chain (root objs) (push name)) |
|
198 | 198 | (api:update-objs) |
|
199 |
(v |
|
|
199 | (void)) | |
|
200 | 200 | |
|
201 | 201 | (defun delobj (name) |
|
202 | 202 | (let ((index (chain (root objs) (index-of name)))) |
|
203 | 203 | (when (> index -1) |
|
204 | 204 | (killobj (1+ index)))) |
|
205 |
(v |
|
|
205 | (void)) | |
|
206 | 206 | |
|
207 | 207 | (defun killobj (&optional (num nil)) |
|
208 | 208 | (if (eq nil num) |
|
209 | 209 | (setf (root objs) (list)) |
|
210 | 210 | (chain (root objs) (splice (1- num) 1))) |
|
211 | 211 | (api:update-objs) |
|
212 |
(v |
|
|
212 | (void)) | |
|
213 | 213 | |
|
214 | 214 | ;;; 16menu |
|
215 | 215 | |
@@ -232,7 +232,7 b'' | |||
|
232 | 232 | loc loc |
|
233 | 233 | icon icon)))))))) |
|
234 | 234 | (api:menu menu-data) |
|
235 |
(v |
|
|
235 | (void))) | |
|
236 | 236 | |
|
237 | 237 | ;;; 17sound |
|
238 | 238 | |
@@ -244,7 +244,8 b'' | |||
|
244 | 244 | |
|
245 | 245 | (defun close (filename) |
|
246 | 246 | (funcall (root playing filename) stop) |
|
247 |
(delete (root playing filename)) |
|
|
247 | (delete (root playing filename)) | |
|
248 | (void)) | |
|
248 | 249 | |
|
249 | 250 | (defun closeall () |
|
250 | 251 | (loop :for k :in (chain *object (keys (root playing))) |
@@ -58,3 +58,12 b'' | |||
|
58 | 58 | (ps-print body)) |
|
59 | 59 | |
|
60 | 60 | (cl:export '=>) |
|
61 | ||
|
62 | ;;; Actually return nothing (with no empty return) | |
|
63 | (defvar *old-return-result-of* (function return-result-of)) | |
|
64 | ||
|
65 | (defun return-result-of (tag form) | |
|
66 | (if (equal form '(void)) | |
|
67 | nil | |
|
68 | (funcall *old-return-result-of* tag form))) | |
|
69 | (export 'void) |
@@ -9,16 +9,14 b'' | |||
|
9 | 9 | |
|
10 | 10 | ;;; Common |
|
11 | 11 | |
|
12 |
(defpsmacro label-block (( |
|
|
12 | (defpsmacro label-block (() &body body) | |
|
13 | 13 | (let ((has-labels (some #'keywordp body))) |
|
14 | 14 | `(block nil |
|
15 | 15 | ,@(when has-labels |
|
16 | 16 | '((defvar __labels))) |
|
17 | ,@(if locals | |
|
18 |
|
|
|
19 |
|
|
|
20 | `((tagbody | |
|
21 | ,@body)))))) | |
|
17 | (tagbody | |
|
18 | ,@body | |
|
19 | (void))))) | |
|
22 | 20 | |
|
23 | 21 | (defpsmacro str (&rest forms) |
|
24 | 22 | (cond ((zerop (length forms)) |
General Comments 0
You need to be logged in to leave comments.
Login now