##// END OF EJS Templates
u » naryl » qsp-txt2web
RSS

Clone from https://hg.sr.ht/~naryl/qsp-txt2web

Apply some new changes to libqsp
naryl -
r61:544aa655 default
parent child Browse files
Show More
Show file before | Show file after | Hide comments
@@ -1,14 +1,17 b''
1
2 * @ for literal strings
3 * LOOP
1
4
2 * Save-load game in slots
5 * Save-load game in slots
3
6
4 * Reporting error lines in the parser
7 * Reporting error lines in the parser
5 * Report duplicate label (in the parser)
8 * Report duplicate label (in the parser)
6 * reporting error lines at runtime (by storing them in every form in the parser
9 * reporting error lines at runtime (by storing them in every form in the parser
7 * Report JUMP with missing label (in tagbody)
10 * Report JUMP with missing label (in tagbody)
8 * Localizing parser errors...
11 * Localizing parser errors...
9
12
10 * Build Istreblenie
13 * Build Istreblenie
11 * Build Цветохимия
14 * Build Цветохимия
12
15
13 * Windows GUI (for the compiler)
16 * Windows GUI (for the compiler)
14 * Resizable frames
17 * Resizable frames
Show file before | Show file after | Hide comments
This diff has been collapsed as it changes many lines, (1156 lines changed) Show them Hide them
@@ -1,1134 +1,28 b''
1 <!DOCTYPE html>
2 <html><head><title>txt2web</title></head><body>
3 <div id="qsp">
4 <div class="qsp-col qsp-col1">
5 <div id="qsp-main" class="qsp-frame">&zwnj;</div>
6 <div id="qsp-acts" class="qsp-frame">&zwnj;</div>
7 <input id="qsp-input" class="qsp-frame">
8 </div>
9 <div class="qsp-col qsp-col2">
10 <div id="qsp-stat" class="qsp-frame">&zwnj;</div>
11 <div id="qsp-objs" class="qsp-frame">&zwnj;</div>
12 </div>
13 <div class="qsp-col qsp-col3">
14 <a id="qsp-btn-save"><img></a>
15 <a id="qsp-btn-open"><img></a>
16 </div>
17 </div>
18
1
19 <div id="qsp-dropdown">
2 # loops
20 </div>
3 jump 'КонеЦ'
21
4 p 'Это сообщение не будет выведено'
22 <div id="qsp-image-container" class="center-on-screen">
5 :конец
23 <img id="qsp-image">
6 p 'А это сообщение пользователь увидит'
24 </div>
25
26 <style id="qsp-style">
27 </style>
28 <style>
29 .qsp-frame {
30 border: 1px solid black;
31 overflow: auto;
32 padding: 5px;
33 box-sizing: border-box;
34 }
35
36 #qsp {
37 position: absolute;
38 display: flex;
39 flex-flow: row;
40 top: 0;
41 left: 0;
42 width: 100%;
43 height: 100%;
44 }
45
46 .qsp-col {
47 display: flex;
48 flex-flow: column;
49 }
50
51 .qsp-col1 {
52 flex: 7 7 70px;
53 }
54
55 .qsp-col2 {
56 flex: 3 3 30px;
57 }
58
59 .qsp-col3 {
60 flex: 0 0 40px;
61 }
62
63 #qsp-main {
64 flex: 6 6 60px;
65 background-repeat: no-repeat;
66 background-position: right top;
67 background-attachment: fixed;
68 }
69
70 #qsp-acts {
71 flex: 4 4 40px;
72 }
73
74 #qsp-input {
75 }
76
77 #qsp-stat {
78 flex: 5 5 50px;
79 }
80
81 #qsp-objs {
82 flex: 5 5 50px;
83 }
84
85 .qsp-act {
86 display: block;
87 padding: 2px;
88 font-size: large;
89 }
90
91 .qsp-act:hover {
92 outline: #9E9E9E outset 3px
93 }
94
95 /* Dropdown */
96
97 #qsp-dropdown {
98 display: none;
99 position: absolute;
100 background-color: #f1f1f1;
101 min-width: 160px;
102 overflow: auto;
103 box-shadow: 0px 8px 16px 0px rgba(0,0,0,0.2);
104 z-index: 1;
105 margin: auto;
106 }
107
108 #qsp-dropdown a {
109 color: black;
110 padding: 12px 16px;
111 text-decoration: none;
112 display: block;
113 }
114
115 #qsp-dropdown a:hover {
116 background-color: #ddd;
117 }
118
119 /* Buttons */
120
121 .qsp-col3 a, .qsp-col3 img {
122 width: 50px;
123 height: 50px;
124 }
125
126 #qsp-btn-save img {
127 background: url('data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAADIAAAAyCAYAAAAeP4ixAAAABmJLR0QA/wD/AP+gvaeTAAACSklEQVRoge3ZPWgUQRjG8V/iRRFU/GoEQdSohSgWWqQSooVgK9iJFiKCnYV2BkFQsBRBQQwWVsHKIoWxEOzEwmhhogbRMhhFicTvYm+JCUlmZzabRLN/OPaWeZ+ZeW7feXf2lpqampqamnRaImKP4hA2VjCP27hbpoNGwbib2IPreB+IPYY7M7SvxWYM4QNO4QqWyQxVRgdeYnnB+K5A+wUcbB7z+O14hxPx08toLRDTgfv4mjrIJFrwwMS0HsABXMTxlE6LpNYqfE7pPJIBdOKhLM1uxIiLrpG5YtC4GSLMVGGkLdD+GpfxAuvxaVL7oCzN+jCG7iKDVmHkKS5hSSBuJ3bg6hRt+Zrpa553z8bEuoQrUVXk1exwKLBI1ZpPBnAL+0KBqanVim1Ykaifji+yNfIrVphipB1n8BgjCfqZ2IrTuIZXMcIUIydxFj8TtEW4JysW52JEKWtkVHUm4EdzjChSrkgLlmJXghb6m8ep9MN4K25XjvTF3sCaElrT6McS+0w2Mirb+JWhrH4CC/0+UpjUK7Ia5/86f4IeHMHeEvPJ+4km1chHE43k9KROpCyLPrViym8/vjW/b5Jt3acjL7/RzEX5bRg3sjKg+2fK7/PmZ9aZzdTqxwYzp06IBZFaDeHUCbFgUquy1Anx35TfRWXkd+WzCBOcQxEjQ7JH0PmiHW9CQUWM9Mr+Y+osO6ME8nF7Q4FFn8T2y14VDMt2vsFfqCRbZBvTdbLXFI9CgphHyjbsVu4+EcMInuH7HI1XU1NTU7OI+QMFe2N82rtssgAAAABJRU5ErkJggg==');
128 }
129
130 #qsp-btn-open img {
131 background: url('data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAADIAAAAyCAYAAAAeP4ixAAAABmJLR0QA/wD/AP+gvaeTAAACCklEQVRoge3Yz6sNYRzH8deVexNxSaEoroWFUuomOceSPVnIwsbSxs6Psrgphf9AsrZR7kJWsroUlrZKKZRSl4USGouZk9Npzp1n5pm5x4/nXdNzpvP9Pp/v95nv82OGRCKRSCQS/w8zuIn3yGpe37CEQ6sedQk38BA7G/jO4BQ+YEebQZUxVfH/OxzGVSxX2D4o2mO4jmt4jpNFe6d5mPFkRbvQ0H9h6OqUtR33/xXr0celGn4/sYjXoQ5dJ3ILB7AOW2r4bcIj7GsrkEFpXWyrwwbaf15nXWqv6SqK1abuHDmPjV0EMobhBWIZt8cZVu0j2ZDNHF7gblRozdiO49g1zqDOEzmKJ7gcGVQTzmLDSgZ1Eunh2dD9aewpsXtctH3cwzn5ALysoVWlXZvhleMV5ovfU8J363mciAliRLsRg0Q244vfT3A/zgT2cQHbImIY1S4ldPk9Ii+NH8V9H08DfbfiY6BtiHYpoYmMBr4bbwN9YzfVoEELnew9+blpwBv5u0oI9wPtQrUbkWFaXqOzsZ01IFg7pLQOyp/A58igmhCsHZJInYndNsHa/0wiVWTy9/a5NjprQGvag0Qmwd462iGltdQ8lihqlVVIIn/9/CAvrajDWgTRB8VhMt1/aSljVr4RToc6hJTWioe1jujJD4rfQx2qRvuTyX1JuTIh3UQikUgkEhPnF+1xZ9hHnLjAAAAAAElFTkSuQmCC');
132 }
133
134 .center-on-screen {
135 position: absolute;
136 top: 0;
137 left: 0;
138 height: 100%;
139 width: 100%;
140 pointer-events: none;
141 display: flex;
142 justify-content: center;
143 align-items: center;
144 }
145
146 .center-on-screen > * {
147 pointer-events: auto;
148 }
149
150 #qsp-image-container {
151 display: none;
152 }
153
154 /* misc */
155
156 .disable a {
157 pointer-events: none;
158 cursor: default;
159 }
160
161 .qsp-objs li.qsp-obj-selected {
162 background-color: blue;
163 }
164 </style><script>var qsp_Globals = { };
165 var qsp_Objs = { };
166 var qsp_CurrentLocation = null;
167 var qsp_StartedAt = Date.now();
168 var qsp_TimerInterval = 500;
169 var qsp_TimerObj = null;
170 var qsp_LoadedGames = [];
171 var qsp_Acts = { };
172 var qsp_StateStash = { };
173 var qsp_Playing = { };
174 var qsp_Locals = [];
175 var qsp_MenuResume = null;
176 var qsp_Games = [];
177 var qsp_MainGame = null;
178 var qsp_Locs = { };
179 window.onload = qsp_start;
180 function qsp_start() {
181 qsp_api_initDom();
182 qsp_StartedAt = Date.now();
183 qsp_api_setTimer(qsp_TimerInterval);
184 qsp_api_runGame(Object.keys(qsp_Games)[0]);
185 __PS_MV_REG = [];
186 return;
187 };
188 function qsp_byId(qsp_id) {
189 return document.getElementById(qsp_id);
190 };
191
7
192 function qsp_api_makeActHtml(qsp_api_title, qsp_api_img) {
8 s=0
193 return '<a class=\'qsp-act\' href=\'' + ('javascript:' + ('qsp_api_callAct' + '(\"' + qsp_api_title + '\");')) + '\' onmouseover=\'' + ('qsp_api_selectAct' + '(\"' + qsp_api_title + '\");') + '\'>' + (qsp_api_img ? '<img src=\'' + qsp_api_img + '\'>' : '') + qsp_api_title + '</a>';
9 :loop1
194 };
10 if s<9:
195 function qsp_api_makeMenuItemHtml(qsp_api_num, qsp_api_title, qsp_api_img, qsp_api_loc) {
11 s=s+1
196 return '<a href=\'' + ('javascript:' + ('qsp_api_finishMenu' + '(\"' + qsp_api_loc + '\");')) + '\'>' + (qsp_api_img ? '<img src=\'' + qsp_api_img + '\'>' : '') + qsp_api_title + '</a>';
12 pl s
197 };
13 jump 'loop1'
198 function qsp_api_makeObj(qsp_api_title, qsp_api_img, qsp_api_selected) {
14 end
199 return '<li onclick=\'' + ('qsp_api_selectObj' + '(\"' + qsp_api_title + '\", \"' + qsp_api_img + '\");') + '\'>' + '<a class=\'qsp-obj' + (qsp_api_selected ? ' qsp-obj-selected' : '') + '\'>' + (qsp_api_img ? '<img src=\'' + qsp_api_img + '\'>' : '') + qsp_api_title + '</a>';
15 p 'Всё!'
200 };
201 function qsp_api_makeMenuDelimiter() {
202 return '<hr>';
203 };
204 function qsp_api_copyObj(qsp_api_obj) {
205 return JSON.parse(JSON.stringify(qsp_api_obj));
206 };
207 function qsp_api_reportError(qsp_api_text) {
208 __PS_MV_REG = [];
209 return alert(qsp_api_text);
210 };
211 function qsp_api_startSleeping() {
212 __PS_MV_REG = [];
213 return qsp_byId('qsp').classList.add('disable');
214 };
215 function qsp_api_finishSleeping() {
216 __PS_MV_REG = [];
217 return qsp_byId('qsp').classList.remove('disable');
218 };
219 function sleep(qsp_api_msec) {
220 __PS_MV_REG = [];
221 return new Promise(function (qsp_api_resolve) {
222 qsp_api_startSleeping();
223 var qsp_api_resume = function () {
224 qsp_api_finishSleeping();
225 __PS_MV_REG = [];
226 return qsp_api_resolve();
227 };
228 __PS_MV_REG = [];
229 return setTimeout(qsp_api_resume, qsp_api_msec);
230 });
231 };
232 function qsp_api_initDom() {
233 var qsp_api_btn = qsp_byId('qsp-btn-save');
234 qsp_api_btn.onclick = qsp_api_savegame;
235 qsp_api_btn.href = '#';
236 var btn1 = qsp_byId('qsp-btn-open');
237 btn1.onclick = qsp_api_opengame;
238 btn1.href = '#';
239 qsp_byId('qsp-image-container').onclick = qsp_api_showImage;
240 qsp_api_getFrame('input').qsp_api_onkeyup = qsp_api_onInputKey;
241 __PS_MV_REG = [];
242 return window.onclick = function (qsp_api_event) {
243 window.qsp_api_mouse = [qsp_api_event.pageX, qsp_api_event.pageY];
244 __PS_MV_REG = [];
245 return qsp_api_finishMenu(null);
246 };
247 };
248 function qsp_api_callServLoc(qsp_api_varName) {
249 var qsp_api_args = Array.prototype.slice.call(arguments, 1);
250 var qsp_api_locName = qsp_api_getGlobal(qsp_api_varName, 0);
251 if (qsp_api_locName) {
252 var qsp_api_loc = qsp_Locs[qsp_api_locName];
253 __PS_MV_REG = [];
254 return qsp_api_loc ? qsp_api_callLoc(qsp_api_locName, qsp_api_args) : null;
255 };
256 };
257 function qsp_api_filenameGame(qsp_api_filename) {
258 var qsp_api_gameName = qsp_api_filename.match('(.*/)?([^.]+)(\\.[a-zA-Z]+)?')[2];
259 return qsp_Games[qsp_api_gameName];
260 };
261 function qsp_api_runGame(qsp_api_name) {
262 var qsp_api_game = qsp_api_filenameGame(qsp_api_name);
263 qsp_MainGame = qsp_api_name;
264 qsp_Locs = qsp_api_game;
265 __PS_MV_REG = [];
266 return qsp_api_game[Object.keys(qsp_api_game)[0]]([]);
267 };
268 function qsp_api_newline(qsp_api_key) {
269 __PS_MV_REG = [];
270 return qsp_api_appendId(qsp_api_keyToId(qsp_api_key), '<br>', true);
271 };
272 function qsp_api_clearId(qsp_api_id) {
273 __PS_MV_REG = [];
274 return qsp_byId(qsp_api_id).innerHTML = '';
275 };
276 function qsp_api_escapeHtml(qsp_api_text) {
277 return qsp_api_text.replace(/&/g, '&amp;').replace(/</g, '&lt;').replace(/>/g, '&gt;').replace(/"/g, '&quot;').replace(/'/g, '&apos;');
278 };
279 function qsp_api_prepareContents(qsp_api_s, qsp_api_forceHtml) {
280 qsp_api_s = qsp_api_s.toString();
281 __PS_MV_REG = [];
282 return qsp_api_forceHtml || qsp_api_getGlobal('USEHTML', 0) ? qsp_api_s : qsp_api_escapeHtml(qsp_api_s);
283 };
284 function qsp_api_getId(qsp_api_id, qsp_api_forceHtml) {
285 __PS_MV_REG = [];
286 return qsp_byId(qsp_api_id).innerHTML;
287 };
288 function qsp_api_setId(qsp_api_id, qsp_api_contents, qsp_api_forceHtml) {
289 __PS_MV_REG = [];
290 return qsp_byId(qsp_api_id).innerHTML = qsp_api_prepareContents(qsp_api_contents, qsp_api_forceHtml);
291 };
292 function qsp_api_appendId(qsp_api_id, qsp_api_contents, qsp_api_forceHtml) {
293 __PS_MV_REG = [];
294 return qsp_api_contents ? (qsp_byId(qsp_api_id).innerHTML += qsp_api_prepareContents(qsp_api_contents, qsp_api_forceHtml)) : null;
295 };
296 function qsp_api_onInputKey(qsp_api_ev) {
297 if (13 === qsp_api_ev.qsp_api_keyCode) {
298 qsp_api_ev.qsp_api_preventDefault();
299 __PS_MV_REG = [];
300 return qsp_api_callServLoc('$USERCOM');
301 };
302 };
303 function qsp_api_initArgs(qsp_api_args) {
304 for (var qsp_api_i = 0; qsp_api_i < qsp_api_args.length; qsp_api_i += 1) {
305 var qsp_api_arg = qsp_api_args[qsp_api_i];
306 if (typeof qsp_api_arg === 'number') {
307 qsp_api_setVar(qsp_api_args, qsp_api_i, 'num', qsp_api_arg);
308 } else {
309 qsp_api_setVar(qsp_api_args, qsp_api_i, 'str', qsp_api_arg);
310 };
311 };
312 };
313 function qsp_api_getResult() {
314 __PS_MV_REG = [];
315 return qsp_api_getGlobal('$RESULT', 0) || qsp_api_getGlobal('RESULT', 0);
316 };
317 function qsp_api_callLoc(qsp_api_name, qsp_api_args) {
318 qsp_api_name = qsp_api_name.toUpperCase();
319 qsp_api_pushLocalFrame();
320 try {
321 qsp_api_initArgs(qsp_api_args);
322 qsp_Locs[qsp_api_name]();
323 qsp_api_getResult();
324 } finally {
325 qsp_api_popLocalFrame();
326 };
327 };
328 function qsp_api_callAct(qsp_api_title) {
329 qsp_api_pushLocalFrame();
330 try {
331 qsp_Acts[qsp_api_title]['act']();
332 } finally {
333 qsp_api_popLocalFrame();
334 };
335 };
336 function qsp_api_keyToId(qsp_api_key) {
337 switch (qsp_api_key) {
338 case 'all':
339 return 'qsp';
340 case 'main':
341 return 'qsp-main';
342 case 'stat':
343 return 'qsp-stat';
344 case 'objs':
345 return 'qsp-objs';
346 case 'acts':
347 return 'qsp-acts';
348 case 'input':
349 return 'qsp-input';
350 case 'image':
351 return 'qsp-image';
352 case 'dropdown':
353 return 'qsp-dropdown';
354 default:
355 __PS_MV_REG = [];
356 return qsp_api_reportError('Internal error!');
357 };
358 };
359 function qsp_api_getFrame(qsp_api_key) {
360 __PS_MV_REG = [];
361 return qsp_byId(qsp_api_keyToId(qsp_api_key));
362 };
363 function qsp_api_addText(qsp_api_key, qsp_api_text) {
364 __PS_MV_REG = [];
365 return qsp_api_appendId(qsp_api_keyToId(qsp_api_key), qsp_api_text);
366 };
367 function qsp_api_getText(qsp_api_key) {
368 __PS_MV_REG = [];
369 return qsp_api_getId(qsp_api_keyToId(qsp_api_key));
370 };
371 function qsp_api_clearText(qsp_api_key) {
372 __PS_MV_REG = [];
373 return qsp_api_clearId(qsp_api_keyToId(qsp_api_key));
374 };
375 function qsp_api_enableFrame(qsp_api_key, qsp_api_enable) {
376 var qsp_api_obj = qsp_api_getFrame(qsp_api_key);
377 qsp_api_obj.style.display = qsp_api_enable ? 'block' : 'none';
378 };
379 function qsp_api_addAct(qsp_api_title, qsp_api_img, qsp_api_act) {
380 qsp_Acts[qsp_api_title] = { 'title' : qsp_api_title,
381 'img' : qsp_api_img,
382 'act' : qsp_api_act,
383 'selected' : null
384 };
385 __PS_MV_REG = [];
386 return qsp_api_updateActs();
387 };
388 function qsp_api_delAct(qsp_api_title) {
389 delete qsp_Acts[qsp_api_title];
390 __PS_MV_REG = [];
391 return qsp_api_updateActs();
392 };
393 function qsp_api_clearAct() {
394 qsp_Acts = { };
395 __PS_MV_REG = [];
396 return qsp_api_updateActs();
397 };
398 function qsp_api_updateActs() {
399 qsp_api_clearId('qsp-acts');
400 var elt = qsp_byId('qsp-acts');
401 for (var qsp_api_title in qsp_Acts) {
402 var qsp_api_obj = qsp_Acts[qsp_api_title];
403 elt.innerHTML += qsp_api_makeActHtml(qsp_api_title, qsp_api_obj['img']);
404 };
405 };
406 function qsp_api_selectAct(qsp_api_title) {
407 for (var qsp_api_k in qsp_Acts) {
408 var qsp_api_v = qsp_Acts[qsp_api_k];
409 qsp_api_v['selected'] = null;
410 };
411 qsp_Acts[qsp_api_title]['selected'] = true;
412 __PS_MV_REG = [];
413 return qsp_api_callServLoc('$ONACTSEL');
414 };
415 function qsp_api_qspfor(qsp_api_name, qsp_api_index, qsp_api_from, qsp_api_to, step, body) {
416 for (var qsp_api_i = qsp_api_from; qsp_api_i <= qsp_api_to; qsp_api_i += step) {
417 qsp_api_setVar(qsp_api_name, qsp_api_index, 'num', qsp_api_i);
418 if (!await (body())) {
419 __PS_MV_REG = [];
420 return;
421 };
422 };
423 };
424 function qsp_api_newVar(qsp_api_slot) {
425 var qsp_api_indexes = Array.prototype.slice.call(arguments, 1);
426 var qsp_api_v = [];
427 for (var qsp_api_index = null, _js_idx2 = 0; _js_idx2 < qsp_api_indexes.length; _js_idx2 += 1) {
428 qsp_api_index = qsp_api_indexes[_js_idx2];
429 qsp_api_v[qsp_api_index] = '$' === qsp_api_slot[0] ? '' : 0;
430 };
431 qsp_api_v['indexes'] = { };
432 __PS_MV_REG = [];
433 return qsp_api_v;
434 };
435 function qsp_api_setStrElement(qsp_api_slot, qsp_api_index, qsp_api_value) {
436 if (qsp_api_slot['indexes'].hasOwnProperty(qsp_api_index)) {
437 qsp_api_slot[null][qsp_api_slot['indexes'][qsp_api_index]] = qsp_api_value;
438 } else {
439 qsp_api_slot.push(qsp_api_value);
440 qsp_api_slot[qsp_api_index] = qsp_api_slot.length;
441 };
442 };
443 function qsp_api_setAnyElement(qsp_api_slot, qsp_api_index, qsp_api_value) {
444 if (qsp_api_index == null) {
445 qsp_api_slot.push(qsp_api_value);
446 } else if (typeof qsp_api_index === 'number') {
447 qsp_api_slot[qsp_api_index] = qsp_api_value;
448 } else if (typeof qsp_api_index === 'string') {
449 qsp_api_setStrElement(qsp_api_slot, qsp_api_index, qsp_api_value);
450 } else {
451 qsp_api_reportError('INTERNAL ERROR');
452 };
453 };
454 function qsp_api_setServVar(qsp_api_name, qsp_api_index, qsp_api_value) {
455 var qsp_api_slot = qsp_Globals[qsp_api_name];
456 qsp_api_setAnyElement(qsp_api_slot, qsp_api_index, qsp_api_value);
457 qsp_api_servVars[qsp_api_name]['body'](qsp_api_value, qsp_api_index);
458 };
459 function qsp_api_getElement(qsp_api_slot, qsp_api_index) {
460 return typeof qsp_api_index === 'number' ? qsp_api_slot[qsp_api_index] : qsp_api_slot[qsp_api_slot['indexes'][qsp_api_index]];
461 };
462 function qsp_api_getGlobal(qsp_api_name, qsp_api_index) {
463 return qsp_Globals[qsp_api_name][qsp_api_index];
464 };
465 function qsp_api_killVar(qsp_api_store, qsp_api_name, qsp_api_index) {
466 qsp_api_name = qsp_api_name.toUpperCase();
467 if (qsp_api_index && 0 !== qsp_api_index) {
468 qsp_Globals[qsp_api_name].qsp_api_kill(qsp_api_index);
469 } else {
470 delete qsp_Globals[qsp_api_name];
471 };
472 };
473 function qsp_api_arraySize(qsp_api_name) {
474 __PS_MV_REG = [];
475 return qsp_api_varRef(qsp_api_name)['values'].length;
476 };
477 function qsp_api_pushLocalFrame() {
478 qsp_Locals.push({ });
479 };
480 function qsp_api_popLocalFrame() {
481 qsp_Locals.pop();
482 };
483 function qsp_api_currentLocalFrame() {
484 return qsp_Locals[qsp_Locals.length - 1];
485 };
486 function qsp_api_selectObj(qsp_api_title, qsp_api_img) {
487 for (var qsp_api_k in qsp_Objs) {
488 var qsp_api_v = qsp_Objs[qsp_api_k];
489 qsp_api_v['selected'] = null;
490 };
491 qsp_Objs[qsp_api_title]['selected'] = true;
492 __PS_MV_REG = [];
493 return qsp_api_callServLoc('$ONOBJSEL', qsp_api_title, qsp_api_img);
494 };
495 function qsp_api_updateObjs() {
496 var elt = qsp_byId('qsp-objs');
497 elt.innerHTML = '<ul>';
498 for (var qsp_api_name in qsp_Objs) {
499 var qsp_api_obj = qsp_Objs[qsp_api_name];
500 elt.innerHTML += qsp_api_makeObj(qsp_api_name, qsp_api_obj['img'], qsp_api_obj['selected']);
501 };
502 __PS_MV_REG = [];
503 return elt.innerHTML += '</ul>';
504 };
505 function qsp_api_openMenu(qsp_api_menuData) {
506 var elt = qsp_api_getFrame('dropdown');
507 var qsp_api_i = 0;
508 var _js4 = qsp_api_menuData.length;
509 for (var _js3 = 0; _js3 < _js4; _js3 += 1) {
510 var qsp_api_item = qsp_api_menuData[_js3];
511 ++qsp_api_i;
512 elt.innerHTML += qsp_api_item === 'delimiter' ? qsp_api_makeMenuDelimiter(qsp_api_i) : qsp_api_makeMenuItemHtml(qsp_api_i, qsp_api_item['text'], qsp_api_item['icon'], qsp_api_item['loc']);
513 };
514 var mouse5 = window.qsp_api_mouse;
515 elt.style.left = mouse5[0] + 'px';
516 elt.style.top = mouse5[1] + 'px';
517 if (document.body.qsp_api_innerWidth > mouse5[0] + elt.qsp_api_innerWidth) {
518 elt.style.left += elt.qsp_api_innerWidth;
519 };
520 if (document.body.qsp_api_innerHeight > mouse5[0] + elt.qsp_api_innerHeight) {
521 elt.style.top += elt.qsp_api_innerHeight;
522 };
523 __PS_MV_REG = [];
524 return elt.style.display = 'block';
525 };
526 function qsp_api_finishMenu(qsp_api_loc) {
527 if (qsp_MenuResume) {
528 var elt = qsp_api_getFrame('dropdown');
529 elt.innerHTML = '';
530 elt.style.display = 'none';
531 qsp_MenuResume();
532 qsp_MenuResume = null;
533 if (qsp_api_loc) {
534 qsp_api_callLoc(qsp_api_loc);
535 };
536 };
537 };
538 function qsp_api_menu(qsp_api_menuData) {
539 new Promise(function (qsp_api_resolve) {
540 qsp_api_startSleeping();
541 var qsp_api_resume = function () {
542 qsp_api_finishSleeping();
543 __PS_MV_REG = [];
544 return qsp_api_resolve();
545 };
546 qsp_api_openMenu(qsp_api_menuData);
547 __PS_MV_REG = [];
548 return qsp_MenuResume = qsp_api_resume;
549 });
550 };
551 function qsp_api_cleanAudio() {
552 var _js6 = Object.keys(qsp_Playing);
553 var _js8 = _js6.length;
554 for (var _js7 = 0; _js7 < _js8; _js7 += 1) {
555 var qsp_api_k = _js6[_js7];
556 var qsp_api_v = qsp_Playing[qsp_api_k];
557 if (qsp_api_v.qsp_api_ended) {
558 delete qsp_Playing.qsp_api_k;
559 };
560 };
561 };
562 function qsp_api_showImage(qsp_api_path) {
563 var qsp_api_img = qsp_api_getFrame('image');
564 if (qsp_api_path) {
565 qsp_api_img.src = qsp_api_path;
566 __PS_MV_REG = [];
567 return qsp_api_img.style.display = 'flex';
568 } else {
569 qsp_api_img.src = '';
570 __PS_MV_REG = [];
571 return qsp_api_img.style.display = 'hidden';
572 };
573 };
574 function qsp_api_showInlineImages(qsp_api_frameName, qsp_api_images) {
575 var qsp_api_frame = qsp_api_getFrame(qsp_api_frameName);
576 var qsp_api_text = '';
577 qsp_api_text += '<div style=\'position:relative; display: inline-block\'>';
578 qsp_api_text += '<img src=\'' + qsp_api_images[0] + '\'>';
579 var _js9 = qsp_api_images.slice(1);
580 var _js11 = _js9.length;
581 for (var _js10 = 0; _js10 < _js11; _js10 += 1) {
582 var qsp_api_image = _js9[_js10];
583 qsp_api_text += '<img style=\'position:absolute\' src=\'' + qsp_api_image + '\'>';
584 };
585 qsp_api_text += '</div>';
586 __PS_MV_REG = [];
587 return qsp_api_frame.innerHTML += qsp_api_text;
588 };
589 function qsp_api_rgbString(qsp_api_rgb) {
590 var qsp_api_red = qsp_api_rgb >> 16;
591 var qsp_api_green = qsp_api_rgb >> 8 & 255;
592 var qsp_api_blue = qsp_api_rgb & 255;
593 var qsp_api_rgbToHex = function (qsp_api_comp) {
594 var qsp_api_hex = Number(qsp_api_comp).toString(16);
595 __PS_MV_REG = [];
596 return qsp_api_hex.length < 2 ? '0' + qsp_api_hex : qsp_api_hex;
597 };
598 __PS_MV_REG = [];
599 return '#' + qsp_api_rgbToHex(qsp_api_red) + qsp_api_rgbToHex(qsp_api_green) + qsp_api_rgbToHex(qsp_api_blue);
600 };
601 function qsp_api_storeObj(qsp_api_key, qsp_api_obj) {
602 qsp_api_storeStr(qsp_api_key, btoa(encodeURIComponent(JSON.stringify(qsp_api_obj))));
603 };
604 function qsp_api_storeStr(qsp_api_key, qsp_api_str) {
605 localStorage.setItem('qsp_' + qsp_api_key, qsp_api_str);
606 };
607 function qsp_api_loadObj(qsp_api_key) {
608 __PS_MV_REG = [];
609 return JSON.parse(encodeURIComponent(atob(qsp_api_loadStr(qsp_api_key))));
610 };
611 function qsp_api_loadStr(qsp_api_key) {
612 return localStorage.getItem('qsp_' + qsp_api_key);
613 };
614 function qsp_api_slotSavegame(qsp_api_slot, qsp_api_comment) {
615 var qsp_api_saves = qsp_api_loadObj('saves');
616 qsp_api_saves.qsp_api_slot = qsp_api_comment;
617 qsp_api_storeObj(qsp_api_saves);
618 qsp_api_storeStr(qsp_api_slot, qsp_api_stateToBase64());
619 };
620 function qsp_api_slotLoadgame(qsp_api_slot) {
621 qsp_api_base64ToState(qsp_api_loadStr(qsp_api_slot));
622 };
623 function qsp_api_slotDeletegame(qsp_api_slot) {
624 var qsp_api_saves = qsp_api_loadObj('saves');
625 qsp_api_saves.qsp_api_slot = undefined;
626 qsp_api_storeObj(qsp_api_saves);
627 qsp_api_storeStr(qsp_api_slot, undefined);
628 };
629 function qsp_api_slotListgames() {
630 __PS_MV_REG = [];
631 return qsp_api_loadObj('saves');
632 };
633 function qsp_api_opengame() {
634 var qsp_api_element = document.createElement('input');
635 qsp_api_element.setAttribute('type', 'file');
636 qsp_api_element.setAttribute('id', 'qsp-opengame');
637 qsp_api_element.setAttribute('tabindex', -1);
638 qsp_api_element.setAttribute('aria-hidden', true);
639 qsp_api_element.style.display = 'block';
640 qsp_api_element.style.qsp_api_visibility = 'hidden';
641 qsp_api_element.style.position = 'fixed';
642 qsp_api_element.onchange = function (qsp_api_event) {
643 var qsp_api_file = qsp_api_event.target.files[0];
644 var qsp_api_reader = new FileReader();
645 qsp_api_reader.onload = function (qsp_api_ev) {
646 var target = qsp_api_ev.currentTarget;
647 if (!target.result) {
648 return null;
649 };
650 qsp_api_base64ToState(target.result);
651 __PS_MV_REG = [];
652 return qsp_api_unstashState();
653 };
654 __PS_MV_REG = [];
655 return qsp_api_reader.readAsText(qsp_api_file);
656 };
657 document.body.appendChild(qsp_api_element);
658 qsp_api_element.click();
659 return document.body.removeChild(qsp_api_element);
660 };
661 function qsp_api_savegame() {
662 var qsp_api_element = document.createElement('a');
663 qsp_api_element.setAttribute('href', 'data:text/plain;charset=utf-8,' + qsp_api_stateToBase64());
664 qsp_api_element.setAttribute('download', 'savegame.sav');
665 qsp_api_element.style.display = 'none';
666 document.body.appendChild(qsp_api_element);
667 qsp_api_element.click();
668 __PS_MV_REG = [];
669 return document.body.removeChild(qsp_api_element);
670 };
671 function qsp_api_stashState(qsp_api_args) {
672 qsp_api_callServLoc('$ONGSAVE');
673 qsp_StateStash = JSON.stringify({ 'vars' : qsp_Globals,
674 'objs' : qsp_Objs,
675 'loc-args' : qsp_api_args,
676 'msecs' : Date.now() - qsp_StartedAt,
677 'timer-interval' : qsp_TimerInterval,
678 'main-html' : qsp_api_getFrame('main').innerHTML,
679 'stat-html' : qsp_api_getFrame('stat').innerHTML,
680 'next-location' : qsp_CurrentLocation
681 });
682 };
683 function qsp_api_unstashState() {
684 var qsp_api_data = JSON.parse(qsp_StateStash);
685 qsp_api_clearAct();
686 qsp_Globals = qsp_api_data['vars'];
687 var _js12 = Object.keys(qsp_Globals);
688 var _js14 = _js12.length;
689 for (var _js13 = 0; _js13 < _js14; _js13 += 1) {
690 var qsp_api_k = _js12[_js13];
691 Object.setPrototypeOf(qsp_Globals[qsp_api_k], qsp_api_Var.prototype);
692 };
693 qsp_StartedAt = Date.now() - qsp_api_data['msecs'];
694 qsp_Objs = qsp_api_data['objs'];
695 qsp_CurrentLocation = qsp_api_data['next-location'];
696 qsp_api_getFrame('main').innerHTML = qsp_api_data['main-html'];
697 qsp_api_getFrame('stat').innerHTML = qsp_api_data['stat-html'];
698 qsp_api_updateObjs();
699 qsp_api_setTimer(qsp_api_data['timer-interval']);
700 qsp_api_callServLoc('$ONGLOAD');
701 qsp_api_callLoc(qsp_CurrentLocation, qsp_api_data['loc-args']);
702 };
703 function qsp_api_stateToBase64() {
704 __PS_MV_REG = [];
705 return btoa(encodeURIComponent(qsp_StateStash));
706 };
707 function qsp_api_base64ToState(qsp_api_data) {
708 __PS_MV_REG = [];
709 return qsp_StateStash = decodeURIComponent(atob(qsp_api_data));
710 };
711 function qsp_api_setTimer(qsp_api_interval) {
712 qsp_TimerInterval = qsp_api_interval;
713 clearInterval(qsp_TimerObj);
714 __PS_MV_REG = [];
715 return qsp_TimerObj = setInterval(function () {
716 __PS_MV_REG = [];
717 return qsp_api_callServLoc('$COUNTER');
718 }, qsp_api_interval);
719 };
720 if ('undefined' === typeof qsp_api_servVars) {
721 var qsp_api_servVars = { };
722 };
723 qsp_api_servVars['$BACKIMAGE'] = { 'name' : '$BACKIMAGE', 'body' : function (qsp_api_path) {
724 __PS_MV_REG = [];
725 return qsp_api_getFrame('main').style.backgroundImage = qsp_api_path;
726 } };
727 qsp_api_servVars['BCOLOR'] = { 'name' : 'BCOLOR', 'body' : function (color) {
728 __PS_MV_REG = [];
729 return qsp_api_getFrame('all').style.backgroundColor = qsp_api_rgbString(color);
730 } };
731 qsp_api_servVars['FCOLOR'] = { 'name' : 'FCOLOR', 'body' : function (color) {
732 __PS_MV_REG = [];
733 return qsp_api_getFrame('all').style.color = qsp_api_rgbString(color);
734 } };
735 qsp_api_servVars['LCOLOR'] = { 'name' : 'LCOLOR', 'body' : function (color) {
736 __PS_MV_REG = [];
737 return qsp_api_getFrame('style').innerText = 'a { color: ' + qsp_api_rgbString(color) + ';}';
738 } };
739 qsp_api_servVars['FSIZE'] = { 'name' : 'FSIZE', 'body' : function (size) {
740 __PS_MV_REG = [];
741 return qsp_api_getFrame('all').style.fontSize = size;
742 } };
743 qsp_api_servVars['$FNAME'] = { 'name' : '$FNAME', 'body' : function (fontName) {
744 __PS_MV_REG = [];
745 return qsp_api_getFrame('all').style.fontFamily = fontName + ',serif';
746 } };
747
16
748 function qsp_lib_goto(target, qsp_lib_args) {
17 :loop2
749 qsp_api_clearText('main');
18 if y<y0:
750 qsp_lib_xgoto(target, qsp_lib_args);
19 if x<x0:
751 };
20 x=x+1
752 function qsp_lib_xgoto(target, qsp_lib_args) {
21 jump 'loop2'
753 qsp_lib_args = qsp_lib_args || [];
22 end
754 qsp_api_clearAct();
23 y=y+1
755 qsp_CurrentLocation = target.toUpperCase();
24 x=0
756 qsp_api_stashState(qsp_lib_args);
25 jump 'loop2'
757 qsp_api_callLoc(qsp_CurrentLocation, qsp_lib_args);
26 if y > y0: exit
758 qsp_api_callServLoc('$ONNEWLOC');
27 end
759 };
28 -
760 function qsp_lib_obj(qsp_lib_name) {
761 return qsp_Objs.hasOwnProperty(qsp_lib_name);
762 };
763 function qsp_lib_loc(qsp_lib_name) {
764 return qsp_Locs.hasOwnProperty(qsp_lib_name);
765 };
766 function qsp_lib_rand(qsp_lib_a, qsp_lib_b) {
767 if (qsp_lib_b === undefined) {
768 qsp_lib_b = 1;
769 };
770 var min15 = Math.min(qsp_lib_a, qsp_lib_b);
771 var max16 = Math.max(qsp_lib_a, qsp_lib_b);
772 __PS_MV_REG = [];
773 return min15 + qsp_lib_Math.random(max16 - min15);
774 };
775 function qsp_lib_copyarr(qsp_lib_to, qsp_lib_from, qsp_lib_start, count) {
776 __PS_MV_REG = [];
777 var qsp_lib_toName = qsp_api_varRealName(qsp_lib_to);
778 var qsp_lib_toSlot = __PS_MV_REG[0];
779 __PS_MV_REG = [];
780 var qsp_lib_fromName = qsp_api_varRealName(qsp_lib_from);
781 var qsp_lib_fromSlot = __PS_MV_REG[0];
782 var _js17 = Math.min(qsp_api_arraySize(qsp_lib_fromName), qsp_lib_start + count);
783 for (var qsp_lib_i = qsp_lib_start; qsp_lib_i <= _js17; qsp_lib_i += 1) {
784 qsp_api_setVar(qsp_lib_toName, qsp_lib_start + qsp_lib_i, qsp_lib_toSlot, qsp_api_getVar(qsp_lib_fromName, qsp_lib_start + qsp_lib_i, qsp_lib_fromSlot));
785 };
786 };
787 function qsp_lib_arrpos(qsp_lib_name, qsp_lib_value, qsp_lib_start) {
788 if (qsp_lib_start === undefined) {
789 qsp_lib_start = 0;
790 };
791 __PS_MV_REG = [];
792 var qsp_lib_realName = qsp_api_varRealName(qsp_lib_name);
793 var qsp_lib_slot = __PS_MV_REG[0];
794 var _js18 = qsp_api_arraySize(qsp_lib_name);
795 for (var qsp_lib_i = qsp_lib_start; qsp_lib_i <= _js18; qsp_lib_i += 1) {
796 if (qsp_api_getVar(qsp_lib_realName, qsp_lib_i, qsp_lib_slot) === qsp_lib_value) {
797 __PS_MV_REG = [];
798 return qsp_lib_i;
799 };
800 };
801 __PS_MV_REG = [];
802 return -1;
803 };
804 function qsp_lib_arrcomp(qsp_lib_name, qsp_lib_pattern, qsp_lib_start) {
805 if (qsp_lib_start === undefined) {
806 qsp_lib_start = 0;
807 };
808 __PS_MV_REG = [];
809 var qsp_lib_realName = qsp_api_varRealName(qsp_lib_name);
810 var qsp_lib_slot = __PS_MV_REG[0];
811 var _js19 = qsp_api_arraySize(qsp_lib_name);
812 for (var qsp_lib_i = qsp_lib_start; qsp_lib_i <= _js19; qsp_lib_i += 1) {
813 if (qsp_api_getVar(qsp_lib_realName, qsp_lib_i, qsp_lib_slot).match(qsp_lib_pattern)) {
814 __PS_MV_REG = [];
815 return qsp_lib_i;
816 };
817 };
818 __PS_MV_REG = [];
819 return -1;
820 };
821 function qsp_lib_instr(qsp_lib_s, qsp_lib_subs, qsp_lib_start) {
822 if (qsp_lib_start === undefined) {
823 qsp_lib_start = 1;
824 };
825 return qsp_lib_start + qsp_lib_s.qsp_lib_substring(qsp_lib_start - 1).search(qsp_lib_subs);
826 };
827 function qsp_lib_isnum(qsp_lib_s) {
828 __PS_MV_REG = [];
829 return qsp_lib_isNaN(qsp_lib_s) ? 0 : -1;
830 };
831 function qsp_lib_strcomp(qsp_lib_s, qsp_lib_pattern) {
832 return qsp_lib_s.match(qsp_lib_pattern) ? -1 : 0;
833 };
834 function qsp_lib_strfind(qsp_lib_s, qsp_lib_pattern, qsp_lib_group) {
835 var qsp_lib_re = new qsp_lib_RegExp(qsp_lib_pattern);
836 var match = qsp_lib_re.qsp_lib_exec(qsp_lib_s);
837 __PS_MV_REG = [];
838 return match.qsp_lib_group(qsp_lib_group);
839 };
840 function qsp_lib_strpos(qsp_lib_s, qsp_lib_pattern, qsp_lib_group) {
841 if (qsp_lib_group === undefined) {
842 qsp_lib_group = 0;
843 };
844 var qsp_lib_re = new qsp_lib_RegExp(qsp_lib_pattern);
845 var match = qsp_lib_re.qsp_lib_exec(qsp_lib_s);
846 var qsp_lib_found = match.qsp_lib_group(qsp_lib_group);
847 __PS_MV_REG = [];
848 return qsp_lib_found ? qsp_lib_s.search(qsp_lib_found) : 0;
849 };
850 function qsp_lib_iif(qsp_lib_condExpr, qsp_lib_thenExpr, qsp_lib_elseExpr) {
851 return qsp_lib_condExpr ? qsp_lib_thenExpr : qsp_lib_elseExpr;
852 };
853 function qsp_lib_gosub(target) {
854 var qsp_lib_args = Array.prototype.slice.call(arguments, 1);
855 qsp_api_callLoc(target, qsp_lib_args);
856 };
857 function qsp_lib_func(target) {
858 var qsp_lib_args = Array.prototype.slice.call(arguments, 1);
859 __PS_MV_REG = [];
860 return qsp_api_callLoc(target, qsp_lib_args);
861 };
862 function qsp_lib_dynamic(block) {
863 var qsp_lib_args = Array.prototype.slice.call(arguments, 1);
864 if (typeof block === 'string') {
865 qsp_api_reportError('DYNAMIC can\'t evaluate arbitrary strings.\\nUse {braces} to create blocks for DYNAMIC.');
866 };
867 qsp_api_initArgs(qsp_lib_args);
868 block(qsp_lib_args);
869 qsp_api_getResult();
870 };
871 function qsp_lib_dyneval(block) {
872 var qsp_lib_args = Array.prototype.slice.call(arguments, 1);
873 if (typeof block === 'string') {
874 qsp_api_reportError('DYNEVAL can\'t evaluate arbitrary strings.\\nUse {braces} to create blocks for DYNEVAL.');
875 };
876 qsp_api_initArgs(qsp_lib_args);
877 block(qsp_lib_args);
878 __PS_MV_REG = [];
879 return qsp_api_getResult();
880 };
881 function qsp_lib_mainP(qsp_lib_s) {
882 qsp_api_addText('main', qsp_lib_s);
883 };
884 function qsp_lib_mainPl(qsp_lib_s) {
885 qsp_api_addText('main', qsp_lib_s);
886 qsp_api_newline('main');
887 };
888 function qsp_lib_mainNl(qsp_lib_s) {
889 qsp_api_newline('main');
890 qsp_api_addText('main', qsp_lib_s);
891 };
892 function qsp_lib_maintxt(qsp_lib_s) {
893 qsp_api_getText('main');
894 };
895 function qsp_lib_desc(qsp_lib_s) {
896 return '';
897 };
898 function qsp_lib_mainClear() {
899 qsp_api_clearText('main');
900 };
901 function qsp_lib_statP(qsp_lib_s) {
902 qsp_api_addText('stat', qsp_lib_s);
903 };
904 function qsp_lib_statPl(qsp_lib_s) {
905 qsp_api_addText('stat', qsp_lib_s);
906 qsp_api_newline('stat');
907 };
908 function qsp_lib_statNl(qsp_lib_s) {
909 qsp_api_newline('stat');
910 qsp_api_addText('stat', qsp_lib_s);
911 };
912 function qsp_lib_stattxt(qsp_lib_s) {
913 qsp_api_getText('stat');
914 };
915 function qsp_lib_statClear() {
916 qsp_api_clearText('stat');
917 };
918 function qsp_lib_cls() {
919 qsp_lib_statClear();
920 qsp_lib_mainClear();
921 qsp_api_clearAct();
922 qsp_lib_cmdclear();
923 };
924 function qsp_lib_selact() {
925 for (var qsp_lib_k in qsp_Acts) {
926 var qsp_lib_v = qsp_Acts[qsp_lib_k];
927 if (qsp_lib_v['selected']) {
928 return qsp_lib_v['name'];
929 };
930 };
931 };
932 function qsp_lib_curacts() {
933 var qsp_lib_acts = qsp_api_copyObj(qsp_Acts);
934 __PS_MV_REG = [];
935 return function () {
936 qsp_Acts = qsp_lib_acts;
937 };
938 };
939 function qsp_lib_addobj(qsp_lib_name, qsp_lib_img) {
940 qsp_lib_img = qsp_lib_img || '';
941 qsp_Objs[qsp_lib_name] = { 'name' : qsp_lib_name,
942 'img' : qsp_lib_img,
943 'selected' : null
944 };
945 qsp_api_updateObjs();
946 qsp_api_callServLoc('$ONOBJADD', qsp_lib_name, qsp_lib_img);
947 };
948 function qsp_lib_delobj(qsp_lib_name) {
949 delete qsp_Objs[qsp_lib_name];
950 qsp_api_updateObjs();
951 qsp_api_callServLoc('$ONOBJDEL', qsp_lib_name);
952 };
953 function qsp_lib_killobj(qsp_lib_num) {
954 if (null === qsp_lib_num) {
955 qsp_Objs = { };
956 } else {
957 qsp_lib_delobj(Object.keys(qsp_Objs)[qsp_lib_num]);
958 };
959 qsp_api_updateObjs();
960 };
961 function qsp_lib_selobj() {
962 for (var qsp_lib_k in qsp_Objs) {
963 var qsp_lib_v = qsp_Objs[qsp_lib_k];
964 if (qsp_lib_v['selected']) {
965 return qsp_lib_v['name'];
966 };
967 };
968 };
969 function qsp_lib_unsel() {
970 for (var qsp_lib_k in qsp_Objs) {
971 var qsp_lib_v = qsp_Objs[qsp_lib_k];
972 qsp_lib_v['selected'] = null;
973 };
974 };
975 function qsp_lib_menu(qsp_lib_menuName) {
976 var qsp_lib_menuData = [];
977 var _js20 = qsp_api_getArray(qsp_api_varRealName(qsp_lib_menuName)).values;
978 var _js22 = _js20.length;
979 for (var _js21 = 0; _js21 < _js22; _js21 += 1) {
980 var qsp_lib_itemObj = _js20[_js21];
981 var qsp_lib_item = qsp_lib_itemObj['str'];
982 if (qsp_lib_item === '') {
983 break;
984 } else if (qsp_lib_item === '-:-') {
985 qsp_lib_menuData.push('delimiter');
986 } else {
987 var qsp_lib_tokens = qsp_lib_item.split(':');
988 if (qsp_lib_tokens.length === 2) {
989 qsp_lib_tokens.push('');
990 };
991 var qsp_lib_text = qsp_lib_tokens.splice(0, qsp_lib_tokens.length - 2).join(':');
992 var qsp_lib_loc = qsp_lib_tokens[qsp_lib_tokens.length - 2];
993 var qsp_lib_icon = qsp_lib_tokens[qsp_lib_tokens.length - 1];
994 qsp_lib_menuData.push({ 'text' : qsp_lib_text,
995 'loc' : qsp_lib_loc,
996 'icon' : qsp_lib_icon
997 });
998 };
999 };
1000 qsp_api_menu(qsp_lib_menuData);
1001 };
1002 function qsp_lib_play(qsp_lib_filename, qsp_lib_volume) {
1003 if (qsp_lib_volume === undefined) {
1004 qsp_lib_volume = 100;
1005 };
1006 var qsp_lib_audio = new qsp_lib_Audio(qsp_lib_filename);
1007 qsp_Playing[qsp_lib_filename] = qsp_lib_audio;
1008 qsp_lib_audio.qsp_lib_volume = qsp_lib_volume * 0.01;
1009 __PS_MV_REG = [];
1010 return qsp_lib_audio.qsp_lib_play();
1011 };
1012 function close(qsp_lib_filename) {
1013 qsp_Playing[qsp_lib_filename](qsp_lib_stop);
1014 delete qsp_Playing[qsp_lib_filename];
1015 };
1016 function qsp_lib_closeall() {
1017 var _js23 = Object.keys(qsp_Playing);
1018 var _js25 = _js23.length;
1019 for (var _js24 = 0; _js24 < _js25; _js24 += 1) {
1020 var qsp_lib_k = _js23[_js24];
1021 var qsp_lib_v = qsp_Playing[qsp_lib_k];
1022 qsp_lib_v(qsp_lib_stop);
1023 };
1024 return qsp_Playing = { };
1025 };
1026 function qsp_lib_refint() {
1027 return null;
1028 };
1029 function qsp_lib_usertxt() {
1030 var qsp_lib_input = qsp_byId('qsp-input');
1031 __PS_MV_REG = [];
1032 return qsp_lib_input.qsp_lib_value;
1033 };
1034 function qsp_lib_cmdclear() {
1035 var qsp_lib_input = qsp_byId('qsp-input');
1036 __PS_MV_REG = [];
1037 return qsp_lib_input.qsp_lib_value = '';
1038 };
1039 function qsp_lib_input(qsp_lib_text) {
1040 return window.prompt(qsp_lib_text);
1041 };
1042 function qsp_lib_msecscount() {
1043 return Date.now() - qsp_StartedAt;
1044 };
1045 function qsp_lib_rgb(qsp_lib_red, qsp_lib_green, qsp_lib_blue) {
1046 return (qsp_lib_red << 16) + (qsp_lib_green << 8) + qsp_lib_blue;
1047 };
1048 function qsp_lib_openqst(qsp_lib_name) {
1049 __PS_MV_REG = [];
1050 return qsp_api_runGame(qsp_lib_name);
1051 };
1052 function qsp_lib_addqst(qsp_lib_name) {
1053 var qsp_lib_game = qsp_api_filenameGame(qsp_lib_name);
1054 __PS_MV_REG = [];
1055 return Object.assign(qsp_Locs, qsp_Games[qsp_lib_name]);
1056 };
1057 function qsp_lib_killqst() {
1058 var _js27 = qsp_Games.length;
1059 for (var _js26 = 0; _js26 < _js27; _js26 += 1) {
1060 var _db28 = qsp_Games[_js26];
1061 var qsp_lib_k = _db28[0];
1062 var qsp_lib_v = _db28[1];
1063 if (qsp_lib_k !== qsp_MainGame) {
1064 delete qsp_Locs[qsp_lib_k];
1065 };
1066 };
1067 };
1068
1069 qsp_Games['9loops'] = { };
1070 Object.assign(qsp_Globals, { 'X0' : qsp_api_newVar('X0', 0),
1071 'X' : qsp_api_newVar('X', 0),
1072 'Y0' : qsp_api_newVar('Y0', 0),
1073 'Y' : qsp_api_newVar('Y', 0),
1074 'S' : qsp_api_newVar('S', 0),
1075 'USEHTML' : qsp_api_newVar('USEHTML', 0),
1076 'RESULT' : qsp_api_newVar('RESULT', 0),
1077 '$RESULT' : qsp_api_newVar('$RESULT', 0),
1078 '$ONGLOAD' : qsp_api_newVar('$ONGLOAD', 0),
1079 '$ONGSAVE' : qsp_api_newVar('$ONGSAVE', 0),
1080 '$ONOBJADD' : qsp_api_newVar('$ONOBJADD', 0),
1081 '$ONOBJDEL' : qsp_api_newVar('$ONOBJDEL', 0),
1082 '$ONOBJSEL' : qsp_api_newVar('$ONOBJSEL', 0),
1083 '$ONNEWLOC' : qsp_api_newVar('$ONNEWLOC', 0),
1084 '$ONACTSEL' : qsp_api_newVar('$ONACTSEL', 0),
1085 '$COUNTER' : qsp_api_newVar('$COUNTER', 0),
1086 '$USERCOM' : qsp_api_newVar('$USERCOM', 0)
1087 });
1088 qsp_Games['9loops']['LOOPS'] = async function (qsp_lib_args) {
1089 var qsp_lib__labels = [];
1090 qsp_lib__labels['_nil'] = async function () {
1091 return 'КОНЕЦ';
1092 qsp_lib_statP('Это сообщение не будет выведено');
1093 __PS_MV_REG = [];
1094 return 'КОНЕЦ';
1095 };
1096 qsp_lib__labels['КОНЕЦ'] = async function () {
1097 qsp_lib_statP('А это сообщение пользователь увидит');
1098 qsp_Globals['S'][0] = 0;
1099 __PS_MV_REG = [];
1100 return 'LOOP1';
1101 };
1102 qsp_lib__labels['LOOP1'] = async function () {
1103 while (true) {
1104 if (qsp_Globals['S'][0] < 9) {
1105 qsp_Globals['S'][0] += 1;
1106 qsp_lib_statPl(qsp_Globals['S'][0]);
1107 continue;
1108 };
1109 qsp_lib_statP('Всё!');
1110 break;
1111 };
1112 __PS_MV_REG = [];
1113 return 'LOOP2';
1114 };
1115 qsp_lib__labels['LOOP2'] = async function () {
1116 while (true) {
1117 if (qsp_Globals['Y'][0] < qsp_Globals['Y0'][0]) {
1118 if (qsp_Globals['X'][0] < qsp_Globals['X0'][0]) {
1119 qsp_Globals['X'][0] += 1;
1120 continue;
1121 };
1122 qsp_Globals['Y'][0] += 1;
1123 qsp_Globals['X'][0] = 0;
1124 continue;
1125 if (qsp_Globals['Y'][0] > qsp_Globals['Y0'][0]) {
1126 return;
1127 };
1128 };
1129 break;
1130 };
1131 };
1132 for (var qsp_lib__nextblock = '_nil'; qsp_lib__nextblock; qsp_lib__nextblock = await (qsp_lib__labels[qsp_lib__nextblock]())) {
1133 };
1134 };</script></body></html> No newline at end of file
Show file before | Show file after | Hide comments
@@ -1,14 +1,16 b''
1
1
2 (in-package txt2web)
2 (in-package txt2web)
3
3
4 (defclass compiler ()
4 (defclass compiler ()
5 ((body :accessor body :initform #.(load-src "extras/body.html"))
5 ((body :accessor body :initform #.(load-src "extras/body.html"))
6 (css :accessor css :initform (list #.(load-src "extras/default.css")))
6 (css :accessor css :initform (list #.(load-src "extras/default.css")))
7 (ast :accessor ast :initform nil)
7 (js :accessor js :initform (reverse
8 (js :accessor js :initform (reverse
8 (list
9 (list
9 '#.(read-progn-from-string (load-src "src/main.ps"))
10 '#.(read-progn-from-string (load-src "src/main.ps"))
10 '#.(read-progn-from-string (load-src "src/api.ps"))
11 '#.(read-progn-from-string (load-src "src/api.ps"))
11 '#.(read-progn-from-string (load-src "src/intrinsics.ps")))))
12 '#.(read-progn-from-string (load-src "src/intrinsics.ps")))))
13 (parse :accessor parse-only :initarg :parse)
12 (compile :accessor compile-only :initarg :compile)
14 (compile :accessor compile-only :initarg :compile)
13 (target :accessor target :initarg :target)
15 (target :accessor target :initarg :target)
14 (beautify :accessor beautify :initarg :beautify)))
16 (beautify :accessor beautify :initarg :beautify)))
Show file before | Show file after | Hide comments
@@ -1,158 +1,164 b''
1
1
2 (in-package txt2web)
2 (in-package txt2web)
3
3
4 (defvar *app-name* "txt2web")
4 (defvar *app-name* "txt2web")
5
5
6 (defun entry-point-no-args ()
6 (defun entry-point-no-args ()
7 (setf *delivered* t)
7 (setf *delivered* t)
8 (entry-point uiop:*command-line-arguments*))
8 (entry-point uiop:*command-line-arguments*))
9
9
10 (defun entry-point (args)
10 (defun entry-point (args)
11 (let ((*package* (find-package :txt2web)))
11 (let ((*package* (find-package :txt2web)))
12 (catch :terminate
12 (catch :terminate
13 (let ((compiler (apply #'make-instance 'compiler (parse-opts args))))
13 (let ((compiler (apply #'make-instance 'compiler (parse-opts args))))
14 (write-compiled-file compiler))))
14 (if (parse-only compiler)
15 (let ((*package* (find-package :txt2web.lib)))
16 (format t "~{~S~^~%~%~}" (reverse (ast compiler))))
17 (write-compiled-file compiler)))))
15 (values))
18 (values))
16
19
17 (defun parse-opts (args)
20 (defun parse-opts (args)
18 (let ((mode :sources)
21 (let ((mode :sources)
19 (data (list :sources nil :target nil :js nil :css nil :body nil :compile nil :beautify nil)))
22 (data (list :sources nil :target nil :js nil :css nil :body nil :compile nil :parse nil :beautify nil)))
20 (loop :for arg :in args
23 (loop :for arg :in args
21 :do (alexandria:switch (arg :test #'string=)
24 :do (alexandria:switch (arg :test #'string=)
22 ("-o" (setf mode :target))
25 ("-o" (setf mode :target))
23 ("--js" (setf mode :js))
26 ("--js" (setf mode :js))
24 ("--css" (setf mode :css))
27 ("--css" (setf mode :css))
25 ("--body" (setf mode :body))
28 ("--body" (setf mode :body))
26 ("-c" (setf (getf data :compile) t))
29 ("-c" (setf (getf data :compile) t))
30 ("-p" (setf (getf data :parse) t))
27 ("--beautify" (setf (getf data :beautify) t))
31 ("--beautify" (setf (getf data :beautify) t))
28 (t (push arg (getf data mode)))))
32 (t (push arg (getf data mode)))))
29 (unless (< 0 (length (getf data :sources)))
33 (unless (< 0 (length (getf data :sources)))
30 (report-error "There should be at least one source"))
34 (report-error "There should be at least one source"))
31 (unless (> 1 (length (getf data :target)))
35 (unless (> 1 (length (getf data :target)))
32 (report-error "There should be no more than one target"))
36 (report-error "There should be no more than one target"))
33 (unless (> 1 (length (getf data :body)))
37 (unless (> 1 (length (getf data :body)))
34 (report-error "There should be no more than one body"))
38 (report-error "There should be no more than one body"))
35 (unless (getf data :target)
39 (unless (getf data :target)
36 (setf (getf data :target)
40 (setf (getf data :target)
37 (let* ((sources (first (getf data :sources)))
41 (let* ((sources (first (getf data :sources)))
38 (tokens (uiop:split-string sources :separator "."))
42 (tokens (uiop:split-string sources :separator "."))
39 (target (format nil "~{~A~^.~}.html"
43 (target (format nil "~{~A~^.~}.html"
40 (butlast tokens))))
44 (butlast tokens))))
41 (list target))))
45 (list target))))
42 (list :sources (getf data :sources)
46 (list :sources (getf data :sources)
43 :target (first (getf data :target))
47 :target (first (getf data :target))
44 :js (getf data :js)
48 :js (getf data :js)
49 :parse (getf data :parse)
45 :css (getf data :css)
50 :css (getf data :css)
46 :body (first (getf data :body))
51 :body (first (getf data :body))
47 :compile (getf data :compile)
52 :compile (getf data :compile)
48 :beautify (getf data :beautify))))
53 :beautify (getf data :beautify))))
49
54
50 (defun print-usage ()
55 (defun print-usage ()
51 (lformat t :usage *app-name*))
56 (lformat t :usage *app-name*))
52
57
53 (defun parse-file (filename)
58 (defun parse-file (filename)
54 (handler-case
59 (handler-case
55 (p:parse 'txt2web-grammar
60 (p:parse 'txt2web-grammar
56 (alexandria:read-file-into-string filename :external-format :utf-8))
61 (alexandria:read-file-into-string filename :external-format :utf-8))
57 (p:esrap-parse-error (e)
62 (p:esrap-parse-error (e)
58 (format t "~A~%" e)
63 (format t "~A~%" e)
59 (throw :terminate nil))))
64 (throw :terminate nil))))
60
65
61 (defun report-error (fmt &rest args)
66 (defun report-error (fmt &rest args)
62 (format t "ERROR: ~A~%" (apply #'format nil fmt args))
67 (format t "ERROR: ~A~%" (apply #'format nil fmt args))
63 (print-usage)
68 (print-usage)
64 (throw :terminate nil))
69 (throw :terminate nil))
65
70
66 ;;; JS
71 ;;; JS
67
72
68 (defun minify-package (package-designator minify prefix)
73 (defun minify-package (package-designator minify prefix)
69 (setf (ps:ps-package-prefix package-designator) prefix)
74 (setf (ps:ps-package-prefix package-designator) prefix)
70 (if minify
75 (if minify
71 (ps:obfuscate-package package-designator)
76 (ps:obfuscate-package package-designator)
72 (ps:unobfuscate-package package-designator)))
77 (ps:unobfuscate-package package-designator)))
73
78
74 (defmethod js-sources ((compiler compiler))
79 (defmethod js-sources ((compiler compiler))
75 (let ((ps:*ps-print-pretty* (beautify compiler)))
80 (let ((ps:*ps-print-pretty* (beautify compiler)))
76 (cond ((beautify compiler)
81 (cond ((beautify compiler)
77 (minify-package "TXT2WEB.MAIN" nil "qsp_")
82 (minify-package "TXT2WEB.MAIN" nil "qsp_")
78 (minify-package "TXT2WEB.API" nil "qsp_api_")
83 (minify-package "TXT2WEB.API" nil "qsp_api_")
79 (minify-package "TXT2WEB.LIB" nil "qsp_lib_"))
84 (minify-package "TXT2WEB.LIB" nil "qsp_lib_"))
80 (t
85 (t
81 (minify-package "TXT2WEB.MAIN" t "_")
86 (minify-package "TXT2WEB.MAIN" t "_")
82 (minify-package "TXT2WEB.API" t "a_")
87 (minify-package "TXT2WEB.API" t "a_")
83 (minify-package "TXT2WEB.LIB" t "l_")))
88 (minify-package "TXT2WEB.LIB" t "l_")))
84 (format nil "~{~A~^~%~%~}" (mapcar #'ps:ps* (reverse (js compiler))))))
89 (format nil "~{~A~^~%~%~}" (mapcar #'ps:ps* (reverse (js compiler))))))
85
90
86 ;;; CSS
91 ;;; CSS
87
92
88 (defmethod css-sources ((compiler compiler))
93 (defmethod css-sources ((compiler compiler))
89 (format nil "~{~A~^~%~%~}" (css compiler)))
94 (format nil "~{~A~^~%~%~}" (css compiler)))
90
95
91 ;;; HTML
96 ;;; HTML
92
97
93 (defmethod html-sources ((compiler compiler))
98 (defmethod html-sources ((compiler compiler))
94 (let ((flute:*escape-html* nil)
99 (let ((flute:*escape-html* nil)
95 (body-template (body compiler))
100 (body-template (body compiler))
96 (js (js-sources compiler))
101 (js (js-sources compiler))
97 (css (css-sources compiler)))
102 (css (css-sources compiler)))
98 (with-output-to-string (out)
103 (with-output-to-string (out)
99 (write
104 (write
100 (flute:h
105 (flute:h
101 (html
106 (html
102 (head
107 (head
103 (meta :charset "utf-8")
108 (meta :charset "utf-8")
104 (title "txt2web"))
109 (title "txt2web"))
105 (body
110 (body
106 body-template
111 body-template
107 (style css)
112 (style css)
108 (script js))))
113 (script js))))
109 :stream out
114 :stream out
110 :pretty nil))))
115 :pretty nil))))
111
116
112 (defun filename-game (filename)
117 (defun filename-game (filename)
113 (let ((filename (alexandria:lastcar (uiop:split-string filename :separator "/"))))
118 (let ((filename (alexandria:lastcar (uiop:split-string filename :separator "/"))))
114 (format nil "~{~A~^.~}" (butlast (uiop:split-string filename :separator ".")))))
119 (format nil "~{~A~^.~}" (butlast (uiop:split-string filename :separator ".")))))
115
120
116 (defmethod initialize-instance ((compiler compiler) &key sources ((:js js-files)) ((:css css-files)) ((:body body-file)) compile &allow-other-keys)
121 (defmethod initialize-instance ((compiler compiler) &key sources ((:js js-files)) ((:css css-files)) ((:body body-file)) compile parse &allow-other-keys)
117 (call-next-method)
122 (call-next-method)
118 (with-slots (body css js)
123 (with-slots (ast body css js)
119 compiler
124 compiler
120 ;; Compile the game's JS
125 ;; Compile the game's JS
121 (dolist (source sources)
126 (dolist (source sources)
122 (let ((ps (parse-file source))
127 (let ((ps (parse-file source))
123 (game-name (filename-game source)))
128 (game-name (filename-game source)))
124 (destructuring-bind (kw &rest locations)
129 (destructuring-bind (kw &rest locations)
125 ps
130 ps
126 (unless (eq kw 'lib:game)
131 (unless (eq kw 'lib:game)
127 (report-error "Internal error!"))
132 (report-error "Internal error!"))
128 (push
133 (push
129 `(lib:game (,game-name) ,@locations)
134 `(lib:game (,game-name) ,@locations)
130 js))))
135 ast))))
136 (setf js (append ast js))
131 ;; Does the user need us to do anything else
137 ;; Does the user need us to do anything else
132 (unless compile
138 (unless (or parse compile)
133 ;; Read in body
139 ;; Read in body
134 (when body-file
140 (when body-file
135 (setf body
141 (setf body
136 (alexandria:read-file-into-string body-file :external-format :utf-8)))
142 (alexandria:read-file-into-string body-file :external-format :utf-8)))
137 ;; Include js files
143 ;; Include js files
138 (dolist (js-file js-files)
144 (dolist (js-file js-files)
139 (push (format nil "////// Included file ~A~%~A" js-file
145 (push (format nil "////// Included file ~A~%~A" js-file
140 (alexandria:read-file-into-string js-file :external-format :utf-8))
146 (alexandria:read-file-into-string js-file :external-format :utf-8))
141 js))
147 js))
142 ;; Include css files
148 ;; Include css files
143 (when css-files
149 (when css-files
144 ;; User option overrides the default css
150 ;; User option overrides the default css
145 (setf css nil)
151 (setf css nil)
146 (dolist (css-file css-files)
152 (dolist (css-file css-files)
147 (push (format nil "////// Included file ~A~%~A" css-file
153 (push (format nil "////// Included file ~A~%~A" css-file
148 (alexandria:read-file-into-string css-file :external-format :utf-8))
154 (alexandria:read-file-into-string css-file :external-format :utf-8))
149 css))))))
155 css))))))
150
156
151 (defmethod write-compiled-file ((compiler compiler))
157 (defmethod write-compiled-file ((compiler compiler))
152 (alexandria:write-string-into-file
158 (alexandria:write-string-into-file
153 (if (compile-only compiler)
159 (if (compile-only compiler)
154 ;; Just the JS
160 ;; Just the JS
155 (js-sources compiler)
161 (js-sources compiler)
156 ;; All of it
162 ;; All of it
157 (html-sources compiler))
163 (html-sources compiler))
158 (target compiler) :if-exists :supersede))
164 (target compiler) :if-exists :supersede))
Show file before | Show file after | Hide comments
@@ -1,664 +1,664 b''
1
1
2 (in-package txt2web)
2 (in-package txt2web)
3
3
4 ;;;; Parses TXT source to an intermediate representation
4 ;;;; Parses TXT source to an intermediate representation
5
5
6 (eval-when (:compile-toplevel :load-toplevel :execute)
6 (eval-when (:compile-toplevel :load-toplevel :execute)
7 (defparameter *max-args* 10))
7 (defparameter *max-args* 10))
8
8
9 ;;; Utility
9 ;;; Utility
10
10
11 (defun remove-nth (list nth)
11 (defun remove-nth (list nth)
12 (append (subseq list 0 nth)
12 (append (subseq list 0 nth)
13 (subseq list (1+ nth))))
13 (subseq list (1+ nth))))
14
14
15 (defun not-quote (char)
15 (defun not-quote (char)
16 (not (eql #\' char)))
16 (not (eql #\' char)))
17
17
18 (defun not-doublequote (char)
18 (defun not-doublequote (char)
19 (not (eql #\" char)))
19 (not (eql #\" char)))
20
20
21 (defun not-brace (char)
21 (defun not-brace (char)
22 (not (eql #\} char)))
22 (not (eql #\} char)))
23
23
24 (defun not-integer (string)
24 (defun not-integer (string)
25 (when (find-if-not #'digit-char-p string)
25 (when (find-if-not #'digit-char-p string)
26 t))
26 t))
27
27
28 (defun not-newline (char)
28 (defun not-newline (char)
29 (not (eql #\newline char)))
29 (not (eql #\newline char)))
30
30
31 (defun id-any-char (char)
31 (defun id-any-char (char)
32 (and
32 (and
33 (not (digit-char-p char))
33 (not (digit-char-p char))
34 (not (eql #\newline char))
34 (not (eql #\newline char))
35 (not (find char " !:&=<>+-*/,'\"()[]{}"))))
35 (not (find char " !:&=<>+-*/,'\"()[]{}"))))
36
36
37 (defun intern-first (list)
37 (defun intern-first (list)
38 (list* (intern (string-upcase (first list)) "TXT2WEB.LIB")
38 (list* (intern (string-upcase (first list)) "TXT2WEB.LIB")
39 (rest list)))
39 (rest list)))
40
40
41 (eval-when (:compile-toplevel :load-toplevel :execute)
41 (eval-when (:compile-toplevel :load-toplevel :execute)
42 (defun remove-nil (list)
42 (defun remove-nil (list)
43 (remove nil list)))
43 (remove nil list)))
44
44
45 (defun binop-rest (list)
45 (defun binop-rest (list)
46 (destructuring-bind (ws1 operator ws2 operand2)
46 (destructuring-bind (ws1 operator ws2 operand2)
47 list
47 list
48 (declare (ignore ws1 ws2))
48 (declare (ignore ws1 ws2))
49 (list (intern (string-upcase operator) "TXT2WEB.LIB") operand2)))
49 (list (intern (string-upcase operator) "TXT2WEB.LIB") operand2)))
50
50
51 (defun do-binop% (left-op other-ops)
51 (defun do-binop% (left-op other-ops)
52 (if (null other-ops)
52 (if (null other-ops)
53 left-op
53 left-op
54 (destructuring-bind ((operator right-op) &rest rest-ops)
54 (destructuring-bind ((operator right-op) &rest rest-ops)
55 other-ops
55 other-ops
56 (if (and (listp left-op)
56 (if (and (listp left-op)
57 (eq (first left-op)
57 (eq (first left-op)
58 operator))
58 operator))
59 (do-binop% (append left-op (list right-op)) rest-ops)
59 (do-binop% (append left-op (list right-op)) rest-ops)
60 (do-binop% (list operator left-op right-op) rest-ops)))))
60 (do-binop% (list operator left-op right-op) rest-ops)))))
61
61
62 (walker:deftransform parser-qspmod mod (&rest args)
62 (walker:deftransform parser-qspmod mod (&rest args)
63 (list* 'qspmod (mapcar #'walker:walk-continue args)))
63 (list* 'qspmod (mapcar #'walker:walk-continue args)))
64
64
65 (defun do-binop (list)
65 (defun do-binop (list)
66 (walker:walk 'parser-qspmod
66 (walker:walk 'parser-qspmod
67 (destructuring-bind (left-op rest-ops)
67 (destructuring-bind (left-op rest-ops)
68 list
68 list
69 (do-binop% left-op
69 (do-binop% left-op
70 (mapcar #'binop-rest rest-ops)))))
70 (mapcar #'binop-rest rest-ops)))))
71
71
72 (defun maybe-text (list)
72 (defun maybe-text (list)
73 "Leaves lists in place and applies esrap:text to everything else"
73 "Leaves lists in place and applies esrap:text to everything else"
74 (let ((parts nil)
74 (let ((parts nil)
75 (part (list 'text)))
75 (part (list 'text)))
76 (loop :for token :in list
76 (loop :for token :in list
77 :do (cond ((listp token)
77 :do (cond ((listp token)
78 (push (nreverse part) parts)
78 (push (nreverse part) parts)
79 (setf part (list 'text))
79 (setf part (list 'text))
80 (push token parts))
80 (push token parts))
81 (t (push token part))))
81 (t (push token part))))
82 (push (nreverse part) parts)
82 (push (nreverse part) parts)
83 (remove ""
83 (remove ""
84 (loop :for part :in (nreverse parts)
84 (loop :for part :in (nreverse parts)
85 :collect (case (first part)
85 :collect (case (first part)
86 ('text (p:text (rest part)))
86 ('text (p:text (rest part)))
87 (t part)))
87 (t part)))
88 :test #'equal)))
88 :test #'equal)))
89
89
90 (p:defrule line-continuation (and #\_ #\newline)
90 (p:defrule line-continuation (and #\_ #\newline)
91 (:constant nil))
91 (:constant nil))
92
92
93 (p:defrule text-spaces (+ (or #\space #\tab line-continuation))
93 (p:defrule text-spaces (+ (or #\space #\tab line-continuation))
94 (:text t))
94 (:text t))
95
95
96 (p:defrule spaces (+ (or #\space #\tab line-continuation))
96 (p:defrule spaces (+ (or #\space #\tab line-continuation))
97 (:constant nil)
97 (:constant nil)
98 (:error-report nil))
98 (:error-report nil))
99
99
100 (p:defrule spaces? (* (or #\space #\tab line-continuation))
100 (p:defrule spaces? (* (or #\space #\tab line-continuation))
101 (:constant nil)
101 (:constant nil)
102 (:error-report nil))
102 (:error-report nil))
103
103
104 (p:defrule colon #\:
104 (p:defrule colon #\:
105 (:constant nil))
105 (:constant nil))
106
106
107 (p:defrule equal #\=
107 (p:defrule equal #\=
108 (:constant nil))
108 (:constant nil))
109
109
110 (p:defrule alphanumeric (alphanumericp character))
110 (p:defrule alphanumeric (alphanumericp character))
111
111
112 (p:defrule not-newline (not-newline character))
112 (p:defrule not-newline (not-newline character))
113
113
114 (p:defrule squote-esc "''"
114 (p:defrule squote-esc "''"
115 (:lambda (list)
115 (:lambda (list)
116 (p:text (elt list 0))))
116 (p:text (elt list 0))))
117
117
118 (p:defrule dquote-esc "\"\""
118 (p:defrule dquote-esc "\"\""
119 (:lambda (list)
119 (:lambda (list)
120 (p:text (elt list 0))))
120 (p:text (elt list 0))))
121
121
122 (p:defrule sstring-char (or squote-esc (not-quote character))
122 (p:defrule sstring-char (or squote-esc (not-quote character))
123 (:text t))
123 (:text t))
124
124
125 (p:defrule dstring-char (or dquote-esc (not-doublequote character))
125 (p:defrule dstring-char (or dquote-esc (not-doublequote character))
126 (:text t))
126 (:text t))
127
127
128 ;;; Identifiers
128 ;;; Identifiers
129
129
130 (defparameter *keywords* '(act addlib addobj addqst and arrcomp arrpos arrsize cla clear *clear close clr *clr cls cmdclear cmdclr copyarr countobj curact curacts curloc debug delact dellib delobj desc disablescroll disablesubex dynamic dyneval else elseif end exit loop freelib func getobj gosub goto gs gt if iif img *img inclib input instr isnum isplay jump killall killobj killqst killvar lcase len let loc local maintxt max menu mid min mod msecscount msg nl *nl no nosave obj opengame openqst or p *p pl *pl play qspver rand refint replace rgb rnd savegame selact selobj set settimer showacts showinput showobjs showstat stattxt step str strcomp strfind strpos to trim ucase unsel unselect user_text usrtxt val view wait while xgoto xgt))
130 (defparameter *keywords* '(act addlib addobj addqst and arrcomp arrpos arrsize cla clear *clear close clr *clr cls cmdclear cmdclr copyarr countobj curact curacts curloc debug delact dellib delobj desc disablescroll dynamic dyneval else elseif end exit loop freelib func getobj gosub goto gs gt if iif img *img inclib input instr isnum isplay jump killall killobj killqst killvar lcase len let loc local maintxt max menu mid min mod msecscount msg nl *nl no nosave obj opengame openqst or p *p pl *pl play qspver rand refint replace rgb rnd savegame selact selobj set settimer showacts showinput showobjs showstat stattxt step str strcomp strfind strpos to trim ucase unsel unselect user_text usrtxt val view wait while xgoto xgt))
131
131
132 (defun trim-$ (str)
132 (defun trim-$ (str)
133 (if (char= #\$ (elt str 0))
133 (if (char= #\$ (elt str 0))
134 (subseq str 1)
134 (subseq str 1)
135 str))
135 str))
136
136
137 (defun qsp-keyword-p (id)
137 (defun qsp-keyword-p (id)
138 (member (intern (trim-$ (string-upcase id))) *keywords*))
138 (member (intern (trim-$ (string-upcase id))) *keywords*))
139
139
140 (defun not-qsp-keyword-p (id)
140 (defun not-qsp-keyword-p (id)
141 (not (member (intern (trim-$ (string-upcase id))) *keywords*)))
141 (not (member (intern (trim-$ (string-upcase id))) *keywords*)))
142
142
143 (p:defrule qsp-keyword (qsp-keyword-p identifier-raw))
143 (p:defrule qsp-keyword (qsp-keyword-p identifier-raw))
144
144
145 (p:defrule id-first (id-any-char character))
145 (p:defrule id-first (id-any-char character))
146 (p:defrule id-next (or (id-any-char character)
146 (p:defrule id-next (or (id-any-char character)
147 (digit-char-p character)))
147 (digit-char-p character)))
148 (p:defrule identifier-raw (and id-first (* id-next))
148 (p:defrule identifier-raw (and id-first (* id-next))
149 (:lambda (list)
149 (:lambda (list)
150 (intern (string-upcase (p:text list)) "TXT2WEB.LIB")))
150 (intern (string-upcase (p:text list)) "TXT2WEB.LIB")))
151
151
152 (p:defrule identifier (not-qsp-keyword-p identifier-raw))
152 (p:defrule identifier (not-qsp-keyword-p identifier-raw))
153
153
154 ;;; Strings
154 ;;; Strings
155
155
156 (p:defrule qsp-string (or normal-string brace-string))
156 (p:defrule qsp-string (or normal-string brace-string))
157
157
158 (p:defrule brace-string (and #\{ before-statement block-body #\})
158 (p:defrule brace-string (and #\{ before-statement block-body #\})
159 (:lambda (list)
159 (:lambda (list)
160 (list* 'lib:qspblock (third list))))
160 (list* 'lib:qspblock (third list))))
161
161
162 (p:defrule normal-string (or sstring dstring)
162 (p:defrule normal-string (or sstring dstring)
163 (:lambda (str)
163 (:lambda (str)
164 (list* 'lib:str (or str (list "")))))
164 (list* 'lib:str (or str (list "")))))
165
165
166 (p:defrule sstring (and #\' (* (or sstring-interpol
166 (p:defrule sstring (and #\' (* (or sstring-interpol
167 sstring-exec
167 sstring-exec
168 sstring-char))
168 sstring-char))
169 #\')
169 #\')
170 (:lambda (list)
170 (:lambda (list)
171 (maybe-text (second list))))
171 (maybe-text (second list))))
172
172
173 (p:defrule dstring (and #\" (* (or dstring-interpol
173 (p:defrule dstring (and #\" (* (or dstring-interpol
174 dstring-exec
174 dstring-exec
175 dstring-char))
175 dstring-char))
176 #\")
176 #\")
177 (:lambda (list)
177 (:lambda (list)
178 (maybe-text (second list))))
178 (maybe-text (second list))))
179
179
180 (defun parse-interpol (list)
180 (defun parse-interpol (list)
181 (p:parse 'expression (p:text (mapcar 'second (second list)))))
181 (p:parse 'expression (p:text (mapcar 'second (second list)))))
182
182
183 (defun parse-exec (list)
183 (defun parse-exec (list)
184 (list* 'lib:exec (p:parse 'exec-body (p:text (second list)))))
184 (list* 'lib:exec (p:parse 'exec-body (p:text (second list)))))
185
185
186 (p:defrule sstring-interpol (and "<<" (+ (and (p:! ">>")
186 (p:defrule sstring-interpol (and "<<" (+ (and (p:! ">>")
187 sstring-char))
187 sstring-char))
188 ">>")
188 ">>")
189 (:function parse-interpol))
189 (:function parse-interpol))
190
190
191 (p:defrule dstring-interpol (and "<<" (+ (and (p:! ">>")
191 (p:defrule dstring-interpol (and "<<" (+ (and (p:! ">>")
192 dstring-char))
192 dstring-char))
193 ">>")
193 ">>")
194 (:function parse-interpol))
194 (:function parse-interpol))
195
195
196 (p:defrule sstring-exec (or (and (p:~ "\"exec:")
196 (p:defrule sstring-exec (or (and (p:~ "\"exec:")
197 (+ (and (p:& (not-doublequote character)) sstring-char))
197 (+ (and (p:& (not-doublequote character)) sstring-char))
198 #\")
198 #\")
199 (and (p:~ "''exec:")
199 (and (p:~ "''exec:")
200 (+ (not-quote character))
200 (+ (not-quote character))
201 "''"))
201 "''"))
202 (:function parse-exec))
202 (:function parse-exec))
203
203
204 (p:defrule dstring-exec (or (and (p:~ "'exec:")
204 (p:defrule dstring-exec (or (and (p:~ "'exec:")
205 (+ (and (p:& (not-quote character)) dstring-char))
205 (+ (and (p:& (not-quote character)) dstring-char))
206 #\')
206 #\')
207 (and (p:~ "\"\"exec")
207 (and (p:~ "\"\"exec")
208 (+ (not-doublequote character))
208 (+ (not-doublequote character))
209 "\"\""))
209 "\"\""))
210 (:function parse-exec))
210 (:function parse-exec))
211
211
212 ;;; Location
212 ;;; Location
213
213
214 (p:defrule txt2web-grammar (and (* (or spaces #\newline))
214 (p:defrule txt2web-grammar (and (* (or spaces #\newline))
215 (* location))
215 (* location))
216 (:lambda (list)
216 (:lambda (list)
217 `(lib:game ,@(second list))))
217 `(lib:game ,@(second list))))
218
218
219 (p:defrule location (and location-header block-body location-end)
219 (p:defrule location (and location-header block-body location-end)
220 (:destructure (header body end)
220 (:destructure (header body end)
221 (declare (ignore end))
221 (declare (ignore end))
222 `(lib:location (,header) ,@body)))
222 `(lib:location (,header) ,@body)))
223
223
224 (p:defrule location-header (and #\#
224 (p:defrule location-header (and #\#
225 (+ not-newline)
225 (+ not-newline)
226 (and #\newline spaces? before-statement))
226 (and #\newline spaces? before-statement))
227 (:destructure (spaces1 name spaces2)
227 (:destructure (spaces1 name spaces2)
228 (declare (ignore spaces1 spaces2))
228 (declare (ignore spaces1 spaces2))
229 (string-upcase (string-trim " " (p:text name)))))
229 (string-upcase (string-trim " " (p:text name)))))
230
230
231 (p:defrule location-end (and #\- (* not-newline) #\newline before-statement)
231 (p:defrule location-end (and #\- (* not-newline) #\newline before-statement)
232 (:constant nil))
232 (:constant nil))
233
233
234 ;;; Block body
234 ;;; Block body
235
235
236 (p:defrule newline-block-body (and #\newline spaces? block-body)
236 (p:defrule newline-block-body (and #\newline spaces? block-body)
237 (:function third))
237 (:function third))
238
238
239 (p:defrule block-body (* statement)
239 (p:defrule block-body (* statement)
240 (:function remove-nil))
240 (:function remove-nil))
241
241
242 ;; Just for <a href="exec:...'>
242 ;; Just for <a href="exec:...'>
243 ;; Explicitly called from that rule's production
243 ;; Explicitly called from that rule's production
244 (p:defrule exec-body (and before-statement line-body)
244 (p:defrule exec-body (and before-statement line-body)
245 (:function second))
245 (:function second))
246
246
247 (p:defrule line-body (and inline-statement (* next-inline-statement))
247 (p:defrule line-body (and inline-statement (* next-inline-statement))
248 (:lambda (list)
248 (:lambda (list)
249 (list* (first list) (second list))))
249 (list* (first list) (second list))))
250
250
251 (p:defrule before-statement (* (or #\newline spaces))
251 (p:defrule before-statement (* (or #\newline spaces))
252 (:constant nil))
252 (:constant nil))
253
253
254 (p:defrule statement-end (or statement-end-real statement-end-block-close))
254 (p:defrule statement-end (or statement-end-real statement-end-block-close))
255
255
256 (p:defrule statement-end-real (and (or #\newline
256 (p:defrule statement-end-real (and (or #\newline
257 (and #\& spaces? (p:& statement%)))
257 (and #\& spaces? (p:& statement%)))
258 before-statement)
258 before-statement)
259 (:constant nil))
259 (:constant nil))
260
260
261 (p:defrule statement-end-block-close (or (p:& #\}))
261 (p:defrule statement-end-block-close (or (p:& #\}))
262 (:constant nil))
262 (:constant nil))
263
263
264 (p:defrule inline-statement (and statement% spaces?)
264 (p:defrule inline-statement (and statement% spaces?)
265 (:function first))
265 (:function first))
266
266
267 (p:defrule next-inline-statement (and #\& spaces? inline-statement)
267 (p:defrule next-inline-statement (and #\& spaces? inline-statement)
268 (:function third))
268 (:function third))
269
269
270 (p:defrule not-a-non-statement (and (p:! (p:~ "elseif"))
270 (p:defrule not-a-non-statement (and (p:! (p:~ "elseif"))
271 (p:! (p:~ "else"))
271 (p:! (p:~ "else"))
272 (p:! (p:~ "end"))))
272 (p:! (p:~ "end"))))
273
273
274 (p:defrule statement (and inline-statement statement-end)
274 (p:defrule statement (and inline-statement statement-end)
275 (:function first))
275 (:function first))
276
276
277 (p:defrule statement% (and not-a-non-statement
277 (p:defrule statement% (and not-a-non-statement
278 (or label comment string-output
278 (or label comment string-output
279 block non-returning-intrinsic local
279 block non-returning-intrinsic local
280 assignment expression-output))
280 assignment expression-output))
281 (:function second))
281 (:function second))
282
282
283 (p:defrule expr-stopper (or comment block non-returning-intrinsic))
283 (p:defrule expr-stopper (or comment block non-returning-intrinsic))
284
284
285 (p:defrule string-output qsp-string
285 (p:defrule string-output qsp-string
286 (:lambda (string)
286 (:lambda (string)
287 (list 'lib:main-pl string)))
287 (list 'lib:main-pl string)))
288
288
289 (p:defrule expression-output expression
289 (p:defrule expression-output expression
290 (:lambda (list)
290 (:lambda (list)
291 (list 'lib:main-pl list)))
291 (list 'lib:main-pl list)))
292
292
293 (p:defrule label (and colon identifier)
293 (p:defrule label (and colon identifier)
294 (:lambda (list)
294 (:lambda (list)
295 (intern (string (second list)) :keyword)))
295 (intern (string (second list)) :keyword)))
296
296
297 (p:defrule comment (and #\! (* (or qsp-string brace-comment text-spaces not-newline)))
297 (p:defrule comment (and #\! (* (or qsp-string brace-comment text-spaces not-newline)))
298 (:constant nil))
298 (:constant nil))
299
299
300 (p:defrule brace-comment (and #\{ (* (not-brace character)) #\})
300 (p:defrule brace-comment (and #\{ (* (not-brace character)) #\})
301 (:constant nil))
301 (:constant nil))
302
302
303 (p:defrule local (and (p:~ "local") spaces variable (p:? (and spaces? #\= spaces? expression)))
303 (p:defrule local (and (p:~ "local") spaces variable (p:? (and spaces? #\= spaces? expression)))
304 (:lambda (list)
304 (:lambda (list)
305 (list* 'lib:local (third list)
305 (list* 'lib:local (third list)
306 (when (fourth list)
306 (when (fourth list)
307 (list (fourth (fourth list)))))))
307 (list (fourth (fourth list)))))))
308
308
309 ;;; Blocks
309 ;;; Blocks
310
310
311 (p:defrule block (or block-act block-if block-loop))
311 (p:defrule block (or block-act block-if block-loop))
312
312
313 (p:defrule block-if (and block-if-head block-if-body)
313 (p:defrule block-if (and block-if-head block-if-body)
314 (:destructure (head body)
314 (:destructure (head body)
315 `(lib:qspcond (,@head ,@(first body))
315 `(lib:qspcond (,@head ,@(first body))
316 ,@(rest body))))
316 ,@(rest body))))
317
317
318 (p:defrule block-if-head (and (p:~ "if") spaces expression spaces? colon spaces?)
318 (p:defrule block-if-head (and (p:~ "if") spaces expression spaces? colon spaces?)
319 (:function remove-nil)
319 (:function remove-nil)
320 (:function cdr))
320 (:function cdr))
321
321
322 (p:defrule block-if-body (or block-if-ml block-if-sl)
322 (p:defrule block-if-body (or block-if-ml block-if-sl)
323 (:destructure (if-body elseifs else &rest ws)
323 (:destructure (if-body elseifs else &rest ws)
324 (declare (ignore ws))
324 (declare (ignore ws))
325 `(,(remove-nil if-body) ,@elseifs ,@(when else `((else ,@else))))))
325 `(,(remove-nil if-body) ,@elseifs ,@(when else `((else ,@else))))))
326
326
327 (p:defrule block-if-sl (and line-body
327 (p:defrule block-if-sl (and line-body
328 (p:? block-if-elseif-inline)
328 (p:? block-if-elseif-inline)
329 (p:? block-if-else-inline)
329 (p:? block-if-else-inline)
330 spaces?))
330 spaces?))
331
331
332 (p:defrule block-if-ml (and (and #\newline spaces?)
332 (p:defrule block-if-ml (and (and #\newline spaces?)
333 block-body
333 block-body
334 (p:? block-if-elseif)
334 (p:? block-if-elseif)
335 (p:? block-if-else)
335 (p:? block-if-else)
336 block-if-end)
336 block-if-end)
337 (:lambda (list)
337 (:lambda (list)
338 (cdr list)))
338 (cdr list)))
339
339
340 (p:defrule block-if-elseif-inline (and block-if-elseif-head line-body (p:? block-if-elseif-inline))
340 (p:defrule block-if-elseif-inline (and block-if-elseif-head line-body (p:? block-if-elseif-inline))
341 (:destructure (head statements elseif)
341 (:destructure (head statements elseif)
342 `((,@(rest head) ,@(remove-nil statements)) ,@elseif)))
342 `((,@(rest head) ,@(remove-nil statements)) ,@elseif)))
343
343
344 (p:defrule block-if-elseif (and block-if-elseif-head statement-end block-body (p:? block-if-elseif))
344 (p:defrule block-if-elseif (and block-if-elseif-head statement-end block-body (p:? block-if-elseif))
345 (:destructure (head ws statements elseif)
345 (:destructure (head ws statements elseif)
346 (declare (ignore ws))
346 (declare (ignore ws))
347 `((,@(rest head) ,@(remove-nil statements)) ,@elseif)))
347 `((,@(rest head) ,@(remove-nil statements)) ,@elseif)))
348
348
349 (p:defrule block-if-elseif-head (and (p:~ "elseif") spaces expression spaces? colon spaces?)
349 (p:defrule block-if-elseif-head (and (p:~ "elseif") spaces expression spaces? colon spaces?)
350 (:function remove-nil)
350 (:function remove-nil)
351 (:function intern-first))
351 (:function intern-first))
352
352
353 (p:defrule block-if-else-inline (and block-if-else-head line-body)
353 (p:defrule block-if-else-inline (and block-if-else-head line-body)
354 (:function second))
354 (:function second))
355
355
356 (p:defrule block-if-else (and block-if-else-head #\newline spaces? block-body)
356 (p:defrule block-if-else (and block-if-else-head #\newline spaces? block-body)
357 (:function fourth))
357 (:function fourth))
358
358
359 (p:defrule block-if-else-head (and (p:~ "else") spaces?)
359 (p:defrule block-if-else-head (and (p:~ "else") spaces?)
360 (:constant nil))
360 (:constant nil))
361
361
362 (p:defrule block-if-end (and (p:~ "end")
362 (p:defrule block-if-end (and (p:~ "end")
363 (p:? (and spaces (p:~ "if"))))
363 (p:? (and spaces (p:~ "if"))))
364 (:constant nil))
364 (:constant nil))
365
365
366 (p:defrule block-act (and block-act-head (or block-ml block-sl))
366 (p:defrule block-act (and block-act-head (or block-ml block-sl))
367 (:lambda (list)
367 (:lambda (list)
368 (apply #'append list)))
368 (apply #'append list)))
369
369
370 (p:defrule block-act-head (and (p:~ "act") spaces? qsp-string spaces?
370 (p:defrule block-act-head (and (p:~ "act") spaces? qsp-string spaces?
371 (p:? block-act-head-img)
371 (p:? block-act-head-img)
372 colon spaces?)
372 colon spaces?)
373 (:lambda (list)
373 (:lambda (list)
374 (intern-first (list (first list)
374 (intern-first (list (first list)
375 (third list)
375 (third list)
376 (or (fifth list) '(lib:str ""))))))
376 (or (fifth list) '(lib:str ""))))))
377
377
378 (p:defrule block-act-head-img (and #\, spaces? qsp-string spaces?)
378 (p:defrule block-act-head-img (and #\, spaces? qsp-string spaces?)
379 (:lambda (list)
379 (:lambda (list)
380 (or (third list) "")))
380 (or (third list) "")))
381
381
382 (p:defrule block-loop (and block-loop-head (or block-ml block-sl))
382 (p:defrule block-loop (and block-loop-head (or block-ml block-sl))
383 (:lambda (list)
383 (:lambda (list)
384 (apply #'append list)))
384 (apply #'append list)))
385
385
386 (p:defrule block-loop-head (and (p:~ "loop") spaces
386 (p:defrule block-loop-head (and (p:~ "loop") spaces
387 (p:? (and block-loop-head-init spaces?))
387 (p:? (and block-loop-head-init spaces?))
388 block-loop-head-while spaces?
388 block-loop-head-while spaces?
389 (p:? (and block-loop-head-step spaces?))
389 (p:? (and block-loop-head-step spaces?))
390 colon spaces?)
390 colon spaces?)
391 (:lambda (list)
391 (:lambda (list)
392 (break "~S" list)
392 (break "~S" list)
393 (list 'lib:qsploop
393 (list 'lib:qsploop
394 (elt list 2)
394 (elt list 2)
395 (elt list 6)
395 (elt list 6)
396 (elt list 9)
396 (elt list 9)
397 (elt list 10))))
397 (elt list 10))))
398
398
399 (p:defrule block-loop-head-init (or local plain-assignment))
399 (p:defrule block-loop-head-init (or local plain-assignment))
400
400
401 (p:defrule block-loop-head-while (and (p:~ "while") eq-expr)
401 (p:defrule block-loop-head-while (and (p:~ "while") eq-expr)
402 (:function second))
402 (:function second))
403
403
404 (p:defrule block-loop-head-step (and (p:~ "step") (or plain-assignment op-assignment))
404 (p:defrule block-loop-head-step (and (p:~ "step") (or plain-assignment op-assignment))
405 (:function second))
405 (:function second))
406
406
407 (p:defrule block-sl line-body)
407 (p:defrule block-sl line-body)
408
408
409 (p:defrule block-ml (and newline-block-body block-end)
409 (p:defrule block-ml (and newline-block-body block-end)
410 (:lambda (list)
410 (:lambda (list)
411 (apply #'list* (butlast list))))
411 (apply #'list* (butlast list))))
412
412
413 (p:defrule block-end (and (p:~ "end"))
413 (p:defrule block-end (and (p:~ "end"))
414 (:constant nil))
414 (:constant nil))
415
415
416 ;;; Calls
416 ;;; Calls
417
417
418 (p:defrule first-argument (and expression spaces?)
418 (p:defrule first-argument (and expression spaces?)
419 (:function first))
419 (:function first))
420 (p:defrule next-argument (and "," spaces? expression)
420 (p:defrule next-argument (and "," spaces? expression)
421 (:function third))
421 (:function third))
422 (p:defrule arguments (or parenthesized-arguments plain-arguments no-arguments))
422 (p:defrule arguments (or parenthesized-arguments plain-arguments no-arguments))
423 (p:defrule parenthesized-arguments (and spaces? #\( base-arguments #\))
423 (p:defrule parenthesized-arguments (and spaces? #\( base-arguments #\))
424 (:function third))
424 (:function third))
425 (p:defrule plain-arguments (and spaces? base-arguments)
425 (p:defrule plain-arguments (and spaces? base-arguments)
426 (:function second))
426 (:function second))
427 (p:defrule no-arguments (or (and spaces? (p:& #\newline))
427 (p:defrule no-arguments (or (and spaces? (p:& #\newline))
428 (and spaces? (p:& #\&))
428 (and spaces? (p:& #\&))
429 spaces?)
429 spaces?)
430 (:constant nil))
430 (:constant nil))
431 (p:defrule base-arguments (or (and first-argument (* next-argument)) spaces?)
431 (p:defrule base-arguments (or (and first-argument (* next-argument)) spaces?)
432 (:lambda (list)
432 (:lambda (list)
433 (if (null list)
433 (if (null list)
434 nil
434 nil
435 (list* (first list) (second list)))))
435 (list* (first list) (second list)))))
436
436
437 ;;; Intrinsics
437 ;;; Intrinsics
438
438
439 (defmacro defintrinsics ((rule-name returning-rule-name non-returning-rule-name) &body clauses)
439 (defmacro defintrinsics ((rule-name returning-rule-name non-returning-rule-name) &body clauses)
440 `(progn
440 `(progn
441 ,@(loop :for clause :in clauses
441 ,@(loop :for clause :in clauses
442 :collect `(defintrinsic ,@clause))
442 :collect `(defintrinsic ,@clause))
443 (p:defrule ,returning-rule-name (or ,@(remove-nil
443 (p:defrule ,returning-rule-name (or ,@(remove-nil
444 (mapcar (lambda (clause)
444 (mapcar (lambda (clause)
445 (when (second clause)
445 (when (second clause)
446 (alexandria:symbolicate
446 (alexandria:symbolicate
447 'intrinsic- (first clause))))
447 'intrinsic- (first clause))))
448 clauses))))
448 clauses))))
449 (p:defrule ,non-returning-rule-name (or ,@(remove-nil
449 (p:defrule ,non-returning-rule-name (or ,@(remove-nil
450 (mapcar (lambda (clause)
450 (mapcar (lambda (clause)
451 (unless (second clause)
451 (unless (second clause)
452 (alexandria:symbolicate
452 (alexandria:symbolicate
453 'intrinsic- (first clause))))
453 'intrinsic- (first clause))))
454 clauses))))
454 clauses))))
455 (p:defrule ,rule-name (or ,returning-rule-name ,non-returning-rule-name))))
455 (p:defrule ,rule-name (or ,returning-rule-name ,non-returning-rule-name))))
456
456
457 (defmacro defintrinsic (sym returning &optional (min-arity 0) max-arity &rest names)
457 (defmacro defintrinsic (sym returning &optional (min-arity 0) max-arity &rest names)
458 (declare (ignore returning))
458 (declare (ignore returning))
459 (unless max-arity
459 (unless max-arity
460 (setf max-arity *max-args*))
460 (setf max-arity *max-args*))
461 (setf names
461 (setf names
462 (if names
462 (if names
463 (mapcar #'string-upcase names)
463 (mapcar #'string-upcase names)
464 (list (string sym))))
464 (list (string sym))))
465 `(p:defrule ,(alexandria:symbolicate 'intrinsic- sym)
465 `(p:defrule ,(alexandria:symbolicate 'intrinsic- sym)
466 (and (p:? #\$) (or ,@(loop :for name :in names :collect `(p:~ ,name)))
466 (and (p:? #\$) (or ,@(loop :for name :in names :collect `(p:~ ,name)))
467 arguments)
467 arguments)
468 (:destructure (dollar name arguments)
468 (:destructure (dollar name arguments)
469 (declare (ignore dollar))
469 (declare (ignore dollar))
470 (unless (<= ,min-arity (length arguments) ,max-arity)
470 (unless (<= ,min-arity (length arguments) ,max-arity)
471 (error "Intrinsic ~A expects between ~A and ~A arguments but ~A were provided:~%~S"
471 (error "Intrinsic ~A expects between ~A and ~A arguments but ~A were provided:~%~S"
472 name ,min-arity ,max-arity (length arguments) arguments))
472 name ,min-arity ,max-arity (length arguments) arguments))
473 (list* ',(intern (string sym) "TXT2WEB.LIB") arguments))))
473 (list* ',(intern (string sym) "TXT2WEB.LIB") arguments))))
474
474
475 (defintrinsics (intrinsic returning-intrinsic non-returning-intrinsic)
475 (defintrinsics (intrinsic returning-intrinsic non-returning-intrinsic)
476 ;; Transitions
476 ;; Transitions
477 (goto% nil 0 nil "gt" "goto")
477 (goto% nil 0 nil "gt" "goto")
478 (xgoto% nil 0 nil "xgt" "xgoto")
478 (xgoto% nil 0 nil "xgt" "xgoto")
479 ;; Variables
479 ;; Variables
480 (killvar nil 0 2)
480 (killvar nil 0 2)
481 ;; Expressions
481 ;; Expressions
482 (obj t 1 1)
482 (obj t 1 1)
483 (loc t 1 1)
483 (loc t 1 1)
484 (no t 1 1)
484 (no t 1 1)
485 ;; Basic
485 ;; Basic
486 (qspver t 0 0)
486 (qspver t 0 0)
487 (curloc t 0 0)
487 (curloc t 0 0)
488 (rand t 1 2)
488 (rand t 1 2)
489 (rnd t 0 0)
489 (rnd t 0 0)
490 (qspmax t 1 nil "max")
490 (qspmax t 1 nil "max")
491 (qspmin t 1 nil "min")
491 (qspmin t 1 nil "min")
492 ;; Arrays
492 ;; Arrays
493 (killall nil 0 0)
493 (killall nil 0 0)
494 (copyarr nil 2 4)
494 (copyarr nil 2 4)
495 (arrsize t 1 1)
495 (arrsize t 1 1)
496 (arrpos t 2 3)
496 (arrpos t 2 3)
497 (arrcomp t 2 3)
497 (arrcomp t 2 3)
498 ;; Strings
498 ;; Strings
499 (len t 1 1)
499 (len t 1 1)
500 (mid t 2 3)
500 (mid t 2 3)
501 (ucase t 1 1)
501 (ucase t 1 1)
502 (lcase t 1 1)
502 (lcase t 1 1)
503 (trim t 1 1)
503 (trim t 1 1)
504 (qspreplace t 2 3 "replace")
504 (qspreplace t 2 3 "replace")
505 (instr t 2 3)
505 (instr t 2 3)
506 (isnum t 1 1)
506 (isnum t 1 1)
507 (val t 1 1)
507 (val t 1 1)
508 (qspstr t 1 1 "str")
508 (qspstr t 1 1 "str")
509 (strcomp t 2 2)
509 (strcomp t 2 2)
510 (strfind t 2 3)
510 (strfind t 2 3)
511 (strpos t 2 3)
511 (strpos t 2 3)
512 ;; IF
512 ;; IF
513 (iif t 2 3)
513 (iif t 2 3)
514 ;; Subs
514 ;; Subs
515 (gosub nil 1 nil "gosub" "gs")
515 (gosub nil 1 nil "gosub" "gs")
516 (func t 1 nil)
516 (func t 1 nil)
517 (exit nil 0 0)
517 (exit nil 0 0)
518 ;; Jump
518 ;; Jump
519 (jump nil 1 1)
519 (jump nil 1 1)
520 ;; Dynamic
520 ;; Dynamic
521 (dynamic nil 1 nil)
521 (dynamic nil 1 nil)
522 (dyneval t 1 nil)
522 (dyneval t 1 nil)
523 ;; Sound
523 ;; Sound
524 (play nil 1 2)
524 (play nil 1 2)
525 (isplay t 1 1)
525 (isplay t 1 1)
526 (close nil 1 1)
526 (close nil 1 1)
527 (closeall nil 0 0 "close all")
527 (closeall nil 0 0 "close all")
528 ;; Main window
528 ;; Main window
529 (main-pl nil 1 1 "*pl")
529 (main-pl nil 1 1 "*pl")
530 (main-nl nil 0 1 "*nl")
530 (main-nl nil 0 1 "*nl")
531 (main-p nil 1 1 "*p")
531 (main-p nil 1 1 "*p")
532 (maintxt t 0 0)
532 (maintxt t 0 0)
533 (desc t 1 1)
533 (desc t 1 1)
534 (main-clear nil 0 0 "*clear" "*clr")
534 (main-clear nil 0 0 "*clear" "*clr")
535 ;; Aux window
535 ;; Aux window
536 (showstat nil 1 1)
536 (showstat nil 1 1)
537 (stat-pl nil 1 1 "pl")
537 (stat-pl nil 1 1 "pl")
538 (stat-nl nil 0 1 "nl")
538 (stat-nl nil 0 1 "nl")
539 (stat-p nil 1 1 "p")
539 (stat-p nil 1 1 "p")
540 (stattxt t 0 0)
540 (stattxt t 0 0)
541 (stat-clear nil 0 0 "clear" "clr")
541 (stat-clear nil 0 0 "clear" "clr")
542 (cls nil 0 0)
542 (cls nil 0 0)
543 ;; Dialog
543 ;; Dialog
544 (msg nil 1 1)
544 (msg nil 1 1)
545 ;; Acts
545 ;; Acts
546 (showacts nil 1 1)
546 (showacts nil 1 1)
547 (delact nil 1 1 "delact" "del act")
547 (delact nil 1 1 "delact" "del act")
548 (curacts t 0 0)
548 (curacts t 0 0)
549 (selact t 0 0)
549 (selact t 0 0)
550 (cla nil 0 0)
550 (cla nil 0 0)
551 ;; Objects
551 ;; Objects
552 (showobjs nil 1 1)
552 (showobjs nil 1 1)
553 (addobj nil 1 3 "addobj" "add obj")
553 (addobj nil 1 3 "addobj" "add obj")
554 (delobj nil 1 1 "delobj" "del obj")
554 (delobj nil 1 1 "delobj" "del obj")
555 (killobj nil 0 1)
555 (killobj nil 0 1)
556 (countobj t 0 0)
556 (countobj t 0 0)
557 (getobj t 1 1)
557 (getobj t 1 1)
558 (selobj t 0 0)
558 (selobj t 0 0)
559 (unsel nil 0 0 "unsel" "unselect")
559 (unsel nil 0 0 "unsel" "unselect")
560 ;; Menu
560 ;; Menu
561 (menu nil 1 1)
561 (menu nil 1 1)
562 ;; Images
562 ;; Images
563 (refint nil 0 0)
563 (refint nil 0 0)
564 (view nil 0 1)
564 (view nil 0 1)
565 (img nil 1)
565 (img nil 1)
566 (*img nil 1)
566 (*img nil 1)
567 ;; Fonts
567 ;; Fonts
568 (rgb t 3 3)
568 (rgb t 3 3)
569 ;; Input
569 ;; Input
570 (showinput nil 1 1)
570 (showinput nil 1 1)
571 (usertxt t 0 0 "user_text" "usrtxt")
571 (usertxt t 0 0 "user_text" "usrtxt")
572 (cmdclear nil 0 0 "cmdclear" "cmdclr")
572 (cmdclear nil 0 0 "cmdclear" "cmdclr")
573 (input t 1 1)
573 (input t 1 1)
574 ;; Files
574 ;; Files
575 (openqst nil 1 1)
575 (openqst nil 1 1)
576 (addqst nil 1 1 "addqst" "addlib" "inclib")
576 (addqst nil 1 1 "addqst" "addlib" "inclib")
577 (killqst nil 1 1 "killqst" "dellib" "freelib")
577 (killqst nil 1 1 "killqst" "dellib" "freelib")
578 (opengame nil 0 0)
578 (opengame nil 0 0)
579 (savegame nil 0 0)
579 (savegame nil 0 0)
580 ;; Real time
580 ;; Real time
581 (wait nil 1 1)
581 (wait nil 1 1)
582 (msecscount t 0 0)
582 (msecscount t 0 0)
583 (settimer nil 1 1))
583 (settimer nil 1 1))
584
584
585 ;;; Expression
585 ;;; Expression
586
586
587 (p:defrule expression or-expr)
587 (p:defrule expression or-expr)
588
588
589 (p:defrule or-expr (and and-expr (* (and spaces? or-op spaces? and-expr)))
589 (p:defrule or-expr (and and-expr (* (and spaces? or-op spaces? and-expr)))
590 (:function do-binop))
590 (:function do-binop))
591
591
592 (p:defrule and-expr (and eq-expr (* (and spaces? and-op spaces? eq-expr)))
592 (p:defrule and-expr (and eq-expr (* (and spaces? and-op spaces? eq-expr)))
593 (:function do-binop))
593 (:function do-binop))
594
594
595 (p:defrule eq-expr (and sum-expr (* (and spaces? (or "<=" ">=" "=<" "=>" "<>"
595 (p:defrule eq-expr (and sum-expr (* (and spaces? (or "<=" ">=" "=<" "=>" "<>"
596 "=" "<" ">" "!")
596 "=" "<" ">")
597 spaces? sum-expr)))
597 spaces? sum-expr)))
598 (:function do-binop))
598 (:function do-binop))
599
599
600 (p:defrule sum-expr (and mod-expr (* (and spaces? (or #\+ #\-) spaces? mod-expr)))
600 (p:defrule sum-expr (and mod-expr (* (and spaces? (or #\+ #\-) spaces? mod-expr)))
601 (:function do-binop))
601 (:function do-binop))
602
602
603 (p:defrule mod-expr (and mul-expr (* (and spaces? (p:~ "mod") spaces? mul-expr)))
603 (p:defrule mod-expr (and mul-expr (* (and spaces? (p:~ "mod") spaces? mul-expr)))
604 (:function do-binop))
604 (:function do-binop))
605
605
606 (p:defrule mul-expr (and unary-expr (* (and spaces? (or #\* #\/) spaces? unary-expr)))
606 (p:defrule mul-expr (and unary-expr (* (and spaces? (or #\* #\/) spaces? unary-expr)))
607 (:function do-binop))
607 (:function do-binop))
608
608
609 (p:defrule unary-expr (and (p:? (or #\+ #\-)) atom-expr)
609 (p:defrule unary-expr (and (p:? (or #\+ #\-)) atom-expr)
610 (:lambda (list)
610 (:lambda (list)
611 (let ((expr (remove-nil list)))
611 (let ((expr (remove-nil list)))
612 (if (= 1 (length expr))
612 (if (= 1 (length expr))
613 (first expr)
613 (first expr)
614 (intern-first expr)))))
614 (intern-first expr)))))
615
615
616 (p:defrule atom-expr (and (or variable literal returning-intrinsic paren-expr) spaces?)
616 (p:defrule atom-expr (and (or variable literal returning-intrinsic paren-expr) spaces?)
617 (:function first))
617 (:function first))
618
618
619 (p:defrule paren-expr (and #\( spaces? expression spaces? #\))
619 (p:defrule paren-expr (and #\( spaces? expression spaces? #\))
620 (:function third))
620 (:function third))
621
621
622 (p:defrule or-op (p:~ "or")
622 (p:defrule or-op (p:~ "or")
623 (:constant "or"))
623 (:constant "or"))
624
624
625 (p:defrule and-op (p:~ "and")
625 (p:defrule and-op (p:~ "and")
626 (:constant "and"))
626 (:constant "and"))
627
627
628 ;;; Variables
628 ;;; Variables
629
629
630 (p:defrule variable (and identifier (p:? array-index))
630 (p:defrule variable (and identifier (p:? array-index))
631 (:destructure (id idx-raw)
631 (:destructure (id idx-raw)
632 (let ((idx (case idx-raw
632 (let ((idx (case idx-raw
633 ((nil) 0)
633 ((nil) 0)
634 (:last nil)
634 (:last nil)
635 (t idx-raw))))
635 (t idx-raw))))
636 (list 'lib:qspvar id idx))))
636 (list 'lib:qspvar id idx))))
637
637
638 (p:defrule array-index (and #\[ spaces? (p:? expression) spaces? #\])
638 (p:defrule array-index (and #\[ spaces? (p:? expression) spaces? #\])
639 (:lambda (list)
639 (:lambda (list)
640 (or (third list) :last)))
640 (or (third list) :last)))
641
641
642 (p:defrule assignment (or kw-assignment plain-assignment op-assignment)
642 (p:defrule assignment (or kw-assignment plain-assignment op-assignment)
643 (:destructure (qspvar eq expr)
643 (:destructure (qspvar eq expr)
644 (declare (ignore eq))
644 (declare (ignore eq))
645 (list 'lib:set qspvar expr)))
645 (list 'lib:set qspvar expr)))
646
646
647 (p:defrule kw-assignment (and (or (p:~ "let") (p:~ "set")) spaces? (or op-assignment plain-assignment))
647 (p:defrule kw-assignment (and (or (p:~ "let") (p:~ "set")) spaces? (or op-assignment plain-assignment))
648 (:function third))
648 (:function third))
649
649
650 (p:defrule op-assignment (and variable spaces? (or "+" "-" "*" "/") #\= spaces? expression)
650 (p:defrule op-assignment (and variable spaces? (or "+" "-" "*" "/") #\= spaces? expression)
651 (:destructure (qspvar ws1 op eq ws2 expr)
651 (:destructure (qspvar ws1 op eq ws2 expr)
652 (declare (ignore ws1 ws2))
652 (declare (ignore ws1 ws2))
653 (list qspvar eq (intern-first (list op qspvar expr)))))
653 (list qspvar eq (intern-first (list op qspvar expr)))))
654
654
655 (p:defrule plain-assignment (and variable spaces? #\= spaces? expression)
655 (p:defrule plain-assignment (and variable spaces? #\= spaces? expression)
656 (:function remove-nil))
656 (:function remove-nil))
657
657
658 ;;; Non-string literals
658 ;;; Non-string literals
659
659
660 (p:defrule literal (or qsp-string brace-string number))
660 (p:defrule literal (or qsp-string brace-string number))
661
661
662 (p:defrule number (+ (or #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
662 (p:defrule number (+ (or #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
663 (:lambda (list)
663 (:lambda (list)
664 (parse-integer (p:text list))))
664 (parse-integer (p:text list))))
Show file before | Show file after | Hide comments
@@ -1,394 +1,391 b''
1
1
2 (in-package txt2web.lib)
2 (in-package txt2web.lib)
3
3
4 ;;;; Parenscript macros which make the parser's intermediate
4 ;;;; Parenscript macros which make the parser's intermediate
5 ;;;; representation directly compilable by Parenscript
5 ;;;; representation directly compilable by Parenscript
6 ;;;; Some utility macros for other .ps sources too.
6 ;;;; Some utility macros for other .ps sources too.
7
7
8 ;;;; Block type | Has own locals | Has labels | async
8 ;;;; Block type | Has own locals | Has labels | async
9 ;;; Location | TRUE | TRUE | TRUE
9 ;;; Location | TRUE | TRUE | TRUE
10 ;;; Act | TRUE | TRUE | TRUE
10 ;;; Act | TRUE | TRUE | TRUE
11 ;;; {} | TRUE | TRUE | TRUE
11 ;;; {} | TRUE | TRUE | TRUE
12 ;;; IF | FALSE | TRUE | TRUE
12 ;;; IF | FALSE | TRUE | TRUE
13 ;;; FOR | FALSE | TRUE | TRUE
13 ;;; FOR | FALSE | TRUE | TRUE
14 ;;;
14 ;;;
15 ;;; IF and FOR are actually not blocks at all. They're implemented as Javascript's if and for loops.
15 ;;; IF and FOR are actually not blocks at all. They're implemented as Javascript's if and for loops.
16 ;;; Jumps back are also optimized to Javascript's while loops.
16 ;;; Jumps back are also optimized to Javascript's while loops.
17
17
18 ;;; Utils
18 ;;; Utils
19
19
20 ;;; Common
20 ;;; Common
21
21
22 (defpsmacro label-block (() &body body)
22 (defpsmacro label-block (() &body body)
23 (let ((has-labels (some #'keywordp body)))
23 (let ((has-labels (some #'keywordp body)))
24 `(block nil
24 `(block nil
25 ,@(when has-labels
25 ,@(when has-labels
26 '((var _labels (list))))
26 '((var _labels (list))))
27 (tagbody
27 (tagbody
28 ,@body
28 ,@body
29 (void)))))
29 (void)))))
30
30
31 (defpsmacro str (&rest forms)
31 (defpsmacro str (&rest forms)
32 (cond ((zerop (length forms))
32 (cond ((zerop (length forms))
33 "")
33 "")
34 ((and (= 1 (length forms))
34 ((and (= 1 (length forms))
35 (stringp (first forms)))
35 (stringp (first forms)))
36 (first forms))
36 (first forms))
37 (t
37 (t
38 `(& ,@forms))))
38 `(& ,@forms))))
39
39
40 (defpsmacro locals-block (&body body)
40 (defpsmacro locals-block (&body body)
41 "Includes labels too (through qsp-lambda)"
41 "Includes labels too (through qsp-lambda)"
42 (let ((*locals* nil))
42 (let ((*locals* nil))
43 (walker:walk 'locals body)
43 (walker:walk 'locals body)
44 `(qsp-lambda
44 `(qsp-lambda
45 (create-locals ,*locals*)
45 (create-locals ,*locals*)
46 ,@(walker:walk 'apply-vars body))))
46 ,@(walker:walk 'apply-vars body))))
47
47
48 ;;; 1loc
48 ;;; 1loc
49
49
50 (defparameter *special-variables*
50 (defparameter *special-variables*
51 '((usehtml 0)
51 '((usehtml 0)
52 (result 0)
52 (result 0)
53 ($result 0)
53 ($result 0)
54 ($ongload 0)
54 ($ongload 0)
55 ($ongsave 0)
55 ($ongsave 0)
56 ($onobjadd 0)
56 ($onobjadd 0)
57 ($onobjdel 0)
57 ($onobjdel 0)
58 ($onobjsel 0)
58 ($onobjsel 0)
59 ($onnewloc 0)
59 ($onnewloc 0)
60 ($onactsel 0)
60 ($onactsel 0)
61 ($counter 0)
61 ($counter 0)
62 ($usercom 0)))
62 ($usercom 0)))
63
63
64 (defpsmacro game ((name) &body body)
64 (defpsmacro game ((name) &body body)
65 (setf body (walker:walk 'for-transform body))
65 (setf body (walker:walk 'for-transform body))
66 (setf *globals* *special-variables*)
66 (setf *globals* *special-variables*)
67 (walker:walk 'globals body)
67 (walker:walk 'globals body)
68 `(progn
68 `(progn
69 ;; Game object
69 ;; Game object
70 (setf (@ *games ,name)
70 (setf (@ *games ,name)
71 (create))
71 (create))
72 ;; Global variables from this game
72 ;; Global variables from this game
73 (create-globals ,*globals*)
73 (create-globals ,*globals*)
74 ;; Locations
74 ;; Locations
75 ,@(loop :for location :in body
75 ,@(loop :for location :in body
76 :collect `(setf (@ *games ,name ,(caadr location))
76 :collect `(setf (@ *games ,name ,(caadr location))
77 ,location))))
77 ,location))))
78
78
79 (defpsmacro location ((name) &body body)
79 (defpsmacro location ((name) &body body)
80 (declare (ignore name))
80 (declare (ignore name))
81 "Name is used by the game macro above"
81 "Name is used by the game macro above"
82 `(locals-block ,@body))
82 `(locals-block ,@body))
83
83
84 (defpsmacro goto% (target &rest args)
84 (defpsmacro goto% (target &rest args)
85 `(progn
85 `(progn
86 (goto ,target ,args)
86 (goto ,target ,args)
87 (exit)))
87 (exit)))
88
88
89 (defpsmacro xgoto% (target &rest args)
89 (defpsmacro xgoto% (target &rest args)
90 `(progn
90 `(progn
91 (xgoto ,target ,args)
91 (xgoto ,target ,args)
92 (exit)))
92 (exit)))
93
93
94 ;;; 2var
94 ;;; 2var
95
95
96 (defvar *globals* nil)
96 (defvar *globals* nil)
97 (defvar *locals* nil)
97 (defvar *locals* nil)
98
98
99 (defpsmacro create-globals (globals)
99 (defpsmacro create-globals (globals)
100 (flet ((indexes (name)
100 (flet ((indexes (name)
101 (remove nil
101 (remove nil
102 (remove-if #'listp
102 (remove-if #'listp
103 (mapcar #'second
103 (mapcar #'second
104 (remove name globals
104 (remove name globals
105 :key #'first
105 :key #'first
106 :test-not #'eq))))))
106 :test-not #'eq))))))
107 (let ((names (remove-duplicates (mapcar #'first globals))))
107 (let ((names (remove-duplicates (mapcar #'first globals))))
108 `(chain *object
108 `(chain *object
109 (assign *globals
109 (assign *globals
110 (create
110 (create
111 ,@(loop :for sym :in names
111 ,@(loop :for sym :in names
112 :for indexes := (indexes sym)
112 :for indexes := (indexes sym)
113 :for name := (string-upcase sym)
113 :for name := (string-upcase sym)
114 :append `(,name
114 :append `(,name
115 (api-call new-var ,name ,@indexes)))))))))
115 (api-call new-var ,name ,@indexes)))))))))
116
116
117 (walker:deftransform globals qspvar (&rest var)
117 (walker:deftransform globals qspvar (&rest var)
118 (pushnew var *globals* :test #'equal)
118 (pushnew var *globals* :test #'equal)
119 (walker:walk-continue))
119 (walker:walk-continue))
120
120
121 (walker:deftransform globals local (var &rest expr)
121 (walker:deftransform globals local (var &rest expr)
122 (declare (ignore var))
122 (declare (ignore var))
123 (walker:walk 'globals expr))
123 (walker:walk 'globals expr))
124
124
125 (defpsmacro create-locals (locals)
125 (defpsmacro create-locals (locals)
126 (when locals
126 (when locals
127 `(progn
127 `(progn
128 (var locals (create
128 (var locals (create
129 ,@(loop :for (sym index) :in locals
129 ,@(loop :for (sym index) :in locals
130 :for name := (string-upcase sym)
130 :for name := (string-upcase sym)
131 :append `(,name (api-call new-var ,name))))))))
131 :append `(,name (api-call new-var ,name))))))))
132
132
133 ;; locations, blocks, and acts all have their own locals namespace
133 ;; locations, blocks, and acts all have their own locals namespace
134 (walker:deftransform-stop locals qspblock)
134 (walker:deftransform-stop locals qspblock)
135 (walker:deftransform-stop locals act)
135 (walker:deftransform-stop locals act)
136
136
137 (walker:deftransform locals local (var &optional expr)
137 (walker:deftransform locals local (var &optional expr)
138 (declare (ignore expr))
138 (declare (ignore expr))
139 (pushnew (rest var) *locals* :test #'equal)
139 (pushnew (rest var) *locals* :test #'equal)
140 nil)
140 nil)
141
141
142 ;; index types:
142 ;; index types:
143 ;; literal number
143 ;; literal number
144 ;; literal string
144 ;; literal string
145 ;; variable number
145 ;; variable number
146 ;; variable string
146 ;; variable string
147 ;; expression (may be possible to determine if it's a string or a number)
147 ;; expression (may be possible to determine if it's a string or a number)
148
148
149 (defun $-var-p (sym)
149 (defun $-var-p (sym)
150 (char= #\$ (elt (string-upcase (symbol-name sym)) 0)))
150 (char= #\$ (elt (string-upcase (symbol-name sym)) 0)))
151
151
152 (defun literal-string-p (form)
152 (defun literal-string-p (form)
153 (and (listp form)
153 (and (listp form)
154 (= 2 (length form))
154 (= 2 (length form))
155 (eq 'str (first form))
155 (eq 'str (first form))
156 (stringp (second form))))
156 (stringp (second form))))
157
157
158 (defun variable-number-p (form)
158 (defun variable-number-p (form)
159 (and (listp form)
159 (and (listp form)
160 (eq 'qspvar (first form))
160 (eq 'qspvar (first form))
161 (not ($-var-p (second form)))))
161 (not ($-var-p (second form)))))
162
162
163 (defun variable-string-p (form)
163 (defun variable-string-p (form)
164 (and (listp form)
164 (and (listp form)
165 (eq 'qspvar (first form))
165 (eq 'qspvar (first form))
166 ($-var-p (second form))))
166 ($-var-p (second form))))
167
167
168 (walker:deftransform apply-vars set (var expr)
168 (walker:deftransform apply-vars set (var expr)
169 (destructuring-bind (qspvar name index)
169 (destructuring-bind (qspvar name index)
170 var
170 var
171 (declare (ignore qspvar))
171 (declare (ignore qspvar))
172 (setf name (string-upcase name))
172 (setf name (string-upcase name))
173 (let ((slot `(getprop
173 (let ((slot `(getprop
174 ,(if (member name *locals* :key #'first)
174 ,(if (member name *locals* :key #'first)
175 'locals '*globals)
175 'locals '*globals)
176 ,name))
176 ,name))
177 (index (walker:walk 'apply-vars index))
177 (index (walker:walk 'apply-vars index))
178 (value (walker:walk 'apply-vars expr)))
178 (value (walker:walk 'apply-vars expr)))
179 (cond
179 (cond
180 ((member name api:*serv-vars* :test #'equalp)
180 ((member name api:*serv-vars* :test #'equalp)
181 `(api:set-serv-var ,name ,index ,value))
181 `(api:set-serv-var ,name ,index ,value))
182 ((null index)
182 ((null index)
183 `(chain (elt ,slot) (push ,value)))
183 `(chain (elt ,slot) (push ,value)))
184 ((or (numberp index)
184 ((or (numberp index)
185 (variable-number-p index))
185 (variable-number-p index))
186 `(setf (elt ,slot ,index) ,value))
186 `(setf (elt ,slot ,index) ,value))
187 ((or (literal-string-p index)
187 ((or (literal-string-p index)
188 (variable-string-p index))
188 (variable-string-p index))
189 `(api:set-str-element ,slot ,index ,value))
189 `(api:set-str-element ,slot ,index ,value))
190 (t
190 (t
191 `(api:set-any-element ,slot ,index ,value))))))
191 `(api:set-any-element ,slot ,index ,value))))))
192
192
193 (walker:deftransform apply-vars local (var &optional expr)
193 (walker:deftransform apply-vars local (var &optional expr)
194 ;; TODO: var can't be a service variable
194 ;; TODO: var can't be a service variable
195 (when expr
195 (when expr
196 (walker:walk 'apply-vars (list 'set var expr))))
196 (walker:walk 'apply-vars (list 'set var expr))))
197
197
198 (walker:deftransform apply-vars qspvar (name index)
198 (walker:deftransform apply-vars qspvar (name index)
199 (let ((slot `(getprop
199 (let ((slot `(getprop
200 ,(if (member name *locals* :key #'first) 'locals '*globals)
200 ,(if (member name *locals* :key #'first) 'locals '*globals)
201 ,(string-upcase name))))
201 ,(string-upcase name))))
202 (cond
202 (cond
203 ((null index)
203 ((null index)
204 `(elt ,slot (1- (length ,slot))))
204 `(elt ,slot (1- (length ,slot))))
205 ((or (numberp index)
205 ((or (numberp index)
206 (variable-number-p index))
206 (variable-number-p index))
207 `(elt ,slot ,(walker:walk-continue index)))
207 `(elt ,slot ,(walker:walk-continue index)))
208 ((or (literal-string-p index)
208 ((or (literal-string-p index)
209 (variable-string-p index))
209 (variable-string-p index))
210 `(elt ,slot (@ ,slot :indexes ,(walker:walk-continue index))))
210 `(elt ,slot (@ ,slot :indexes ,(walker:walk-continue index))))
211 (t
211 (t
212 `(get-element ,slot ,(walker:walk-continue index))))))
212 `(get-element ,slot ,(walker:walk-continue index))))))
213
213
214 (walker:deftransform apply-vars qspblock (&rest block)
214 (walker:deftransform apply-vars qspblock (&rest block)
215 (declare (ignore block))
215 (declare (ignore block))
216 (walker:whole))
216 (walker:whole))
217 (walker:deftransform apply-vars act (&rest block)
217 (walker:deftransform apply-vars act (&rest block)
218 (declare (ignore block))
218 (declare (ignore block))
219 (walker:whole))
219 (walker:whole))
220 (walker:deftransform apply-vars qspfor (var from to step body)
220 (walker:deftransform apply-vars qspfor (var from to step body)
221 (list* 'qspfor var (mapcar #'walker:walk-continue (list from to step body))))
221 (list* 'qspfor var (mapcar #'walker:walk-continue (list from to step body))))
222
222
223 ;;; 3expr
223 ;;; 3expr
224
224
225 (defpsmacro <> (op1 op2)
225 (defpsmacro <> (op1 op2)
226 `(not (equal ,op1 ,op2)))
226 `(not (equal ,op1 ,op2)))
227
227
228 (defpsmacro ! (op1 op2)
229 `(not (equal ,op1 ,op2)))
230
231 (defpsmacro qspmod (&rest ops)
228 (defpsmacro qspmod (&rest ops)
232 (case (length ops)
229 (case (length ops)
233 (1 (first ops))
230 (1 (first ops))
234 (2 `(mod ,@ops))
231 (2 `(mod ,@ops))
235 (t `(mod ,(first ops) (qspmod ,@(rest ops))))))
232 (t `(mod ,(first ops) (qspmod ,@(rest ops))))))
236
233
237 ;;; 4code
234 ;;; 4code
238
235
239 (defpsmacro exec (&body body)
236 (defpsmacro exec (&body body)
240 (format nil "javascript: ~{~A~^~%~}" (mapcar #'ps* body)))
237 (format nil "javascript: ~{~A~^~%~}" (mapcar #'ps* body)))
241
238
242 ;;; 5arrays
239 ;;; 5arrays
243
240
244 ;;; 6str
241 ;;; 6str
245
242
246 (defpsmacro & (&rest args)
243 (defpsmacro & (&rest args)
247 `(chain "" (concat ,@args)))
244 `(chain "" (concat ,@args)))
248
245
249 ;;; 7if
246 ;;; 7if
250
247
251 (defpsmacro qspcond (&rest clauses)
248 (defpsmacro qspcond (&rest clauses)
252 `(cond ,@(loop :for clause :in clauses
249 `(cond ,@(loop :for clause :in clauses
253 :for f := (if (eq 'txt2web::else (first clause))
250 :for f := (if (eq 'txt2web::else (first clause))
254 't
251 't
255 (first clause))
252 (first clause))
256 :collect (list f
253 :collect (list f
257 `(tagbody
254 `(tagbody
258 ,@(rest clause))))))
255 ,@(rest clause))))))
259
256
260 ;;; 8sub
257 ;;; 8sub
261
258
262 ;;; 9jump
259 ;;; 9jump
263 ;;; Yep, that's a huge kludge since Javascript doesn't support arbitrary labels
260 ;;; Yep, that's a huge kludge since Javascript doesn't support arbitrary labels
264
261
265 (defpsmacro jump (target)
262 (defpsmacro jump (target)
266 `(return-from label-body ,(string-upcase (second target))))
263 `(return-from label-body ,(string-upcase (second target))))
267
264
268 (defpsmacro tagbody (&body body)
265 (defpsmacro tagbody (&body body)
269 (let ((create-locals (if (eq (caar body) 'create-locals)
266 (let ((create-locals (if (eq (caar body) 'create-locals)
270 (list (car body))))
267 (list (car body))))
271 (void (if (equal (car (last body)) '(void))
268 (void (if (equal (car (last body)) '(void))
272 '((void)))))
269 '((void)))))
273 (when create-locals
270 (when create-locals
274 (setf body (cdr body)))
271 (setf body (cdr body)))
275 (when void
272 (when void
276 (setf body (butlast body)))
273 (setf body (butlast body)))
277 (let ((funcs (list nil "_nil")))
274 (let ((funcs (list nil "_nil")))
278 (dolist (form body)
275 (dolist (form body)
279 (cond ((keywordp form)
276 (cond ((keywordp form)
280 (setf (first funcs) (reverse (first funcs)))
277 (setf (first funcs) (reverse (first funcs)))
281 (push (string-upcase form) funcs)
278 (push (string-upcase form) funcs)
282 (push nil funcs))
279 (push nil funcs))
283 (t
280 (t
284 (push form (first funcs)))))
281 (push form (first funcs)))))
285 (setf (first funcs) (reverse (first funcs)))
282 (setf (first funcs) (reverse (first funcs)))
286 (setf funcs (reverse funcs))
283 (setf funcs (reverse funcs))
287 `(progn
284 `(progn
288 ,@create-locals
285 ,@create-locals
289 ,(if (= 2 (length funcs))
286 ,(if (= 2 (length funcs))
290 `(progn
287 `(progn
291 ,@body)
288 ,@body)
292 `(progn
289 `(progn
293 (tagbody-blocks ,funcs)
290 (tagbody-blocks ,funcs)
294 (loop
291 (loop
295 :for _nextblock
292 :for _nextblock
296 := :_nil
293 := :_nil
297 :then (await (funcall (getprop _labels _nextblock)))
294 :then (await (funcall (getprop _labels _nextblock)))
298 :while _nextblock)))
295 :while _nextblock)))
299 ,@void))))
296 ,@void))))
300
297
301 (defvar *current-label*)
298 (defvar *current-label*)
302 (defvar *has-jump-back*)
299 (defvar *has-jump-back*)
303 (walker:deftransform optimize-jump jump (target)
300 (walker:deftransform optimize-jump jump (target)
304 (cond ((string= (string-upcase (second target)) *current-label*)
301 (cond ((string= (string-upcase (second target)) *current-label*)
305 (setf *has-jump-back* t)
302 (setf *has-jump-back* t)
306 '(continue))
303 '(continue))
307 (t
304 (t
308 (walker:walk-continue))))
305 (walker:walk-continue))))
309
306
310 (defpsmacro tagbody-blocks (funcs)
307 (defpsmacro tagbody-blocks (funcs)
311 `(setf ,@(loop :for (label code . rest-labels) :on funcs :by #'cddr
308 `(setf ,@(loop :for (label code . rest-labels) :on funcs :by #'cddr
312 :append `((@ _labels ,label)
309 :append `((@ _labels ,label)
313 (async-lambda ()
310 (async-lambda ()
314 (block label-body
311 (block label-body
315 (tagbody-block-body ,label ,code
312 (tagbody-block-body ,label ,code
316 ,(first rest-labels))))))))
313 ,(first rest-labels))))))))
317
314
318 (defpsmacro tagbody-block-body (label code next-label)
315 (defpsmacro tagbody-block-body (label code next-label)
319 (let ((*current-label* label)
316 (let ((*current-label* label)
320 (*has-jump-back* nil))
317 (*has-jump-back* nil))
321 (let ((code (walker:walk 'optimize-jump code)))
318 (let ((code (walker:walk 'optimize-jump code)))
322 (if *has-jump-back*
319 (if *has-jump-back*
323 `(progn
320 `(progn
324 (loop :do (progn
321 (loop :do (progn
325 ,@code
322 ,@code
326 (break)))
323 (break)))
327 ,@(if next-label
324 ,@(if next-label
328 (list next-label)
325 (list next-label)
329 nil))
326 nil))
330 `(progn
327 `(progn
331 ,@code
328 ,@code
332 ,@(if next-label
329 ,@(if next-label
333 (list next-label)
330 (list next-label)
334 nil))))))
331 nil))))))
335
332
336 (defpsmacro exit ()
333 (defpsmacro exit ()
337 '(return-from nil (values)))
334 '(return-from nil (values)))
338
335
339 ;;; 10dynamic
336 ;;; 10dynamic
340
337
341 (defpsmacro qspblock (&body body)
338 (defpsmacro qspblock (&body body)
342 `(locals-block
339 `(locals-block
343 ,@body))
340 ,@body))
344
341
345 (defpsmacro qsp-lambda (&body body)
342 (defpsmacro qsp-lambda (&body body)
346 `(async-lambda (args)
343 `(async-lambda (args)
347 (label-block ()
344 (label-block ()
348 ,@body)))
345 ,@body)))
349
346
350 ;;; 11main
347 ;;; 11main
351
348
352 (defpsmacro act (name img &body body)
349 (defpsmacro act (name img &body body)
353 `(api-call add-act ,name ,img
350 `(api-call add-act ,name ,img
354 (locals-block
351 (locals-block
355 ,@body)))
352 ,@body)))
356
353
357 ;;; 12aux
354 ;;; 12aux
358
355
359 ;;; 13diag
356 ;;; 13diag
360
357
361 ;;; 14act
358 ;;; 14act
362
359
363 ;;; 15objs
360 ;;; 15objs
364
361
365 ;;; 16menu
362 ;;; 16menu
366
363
367 ;;; 17sound
364 ;;; 17sound
368
365
369 ;;; 18img
366 ;;; 18img
370
367
371 ;;; 19input
368 ;;; 19input
372
369
373 ;;; 20time
370 ;;; 20time
374
371
375 ;;; 21local
372 ;;; 21local
376
373
377 ;;; 22loop
374 ;;; 22loop
378
375
379 (defpsmacro qsploop (init cond step &body body)
376 (defpsmacro qsploop (init cond step &body body)
380 `(progn
377 `(progn
381 ,init
378 ,init
382 (loop :while ,cond
379 (loop :while ,cond
383 :do (progn
380 :do (progn
384 ,@body
381 ,@body
385 ,step))))
382 ,step))))
386
383
387 ;; Transform because it creates a (set ...) hence it has to be processed
384 ;; Transform because it creates a (set ...) hence it has to be processed
388 ;; before the apply-vars transform. And macros are processed after all
385 ;; before the apply-vars transform. And macros are processed after all
389 ;; the transforms
386 ;; the transforms
390 (walker:deftransform for-transform qspfor (var from to step &rest body)
387 (walker:deftransform for-transform qspfor (var from to step &rest body)
391 `(loop :for i :from ,from :to ,to :by ,step
388 `(loop :for i :from ,from :to ,to :by ,step
392 :do (set ,var i)
389 :do (set ,var i)
393 :do (block nil
390 :do (block nil
394 ,@(walker:walk-continue body))))
391 ,@(walker:walk-continue body))))
Show file before | Show file after | Hide comments
1 NO CONTENT: file was removed
NO CONTENT: file was removed
General Comments 0
You need to be logged in to leave comments. Login now