##// 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 5 * Save-load game in slots
3 6
4 7 * Reporting error lines in the parser
5 8 * Report duplicate label (in the parser)
6 9 * reporting error lines at runtime (by storing them in every form in the parser
7 10 * Report JUMP with missing label (in tagbody)
8 11 * Localizing parser errors...
9 12
10 13 * Build Istreblenie
11 14 * Build Цветохимия
12 15
13 16 * Windows GUI (for the compiler)
14 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">
20 </div>
21
22 <div id="qsp-image-container" class="center-on-screen">
23 <img id="qsp-image">
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 };
2 # loops
3 jump 'КонеЦ'
4 p 'Это сообщение не будет выведено'
5 :конец
6 p 'А это сообщение пользователь увидит'
191 7
192 function qsp_api_makeActHtml(qsp_api_title, qsp_api_img) {
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>';
194 };
195 function qsp_api_makeMenuItemHtml(qsp_api_num, qsp_api_title, qsp_api_img, qsp_api_loc) {
196 return '<a href=\'' + ('javascript:' + ('qsp_api_finishMenu' + '(\"' + qsp_api_loc + '\");')) + '\'>' + (qsp_api_img ? '<img src=\'' + qsp_api_img + '\'>' : '') + qsp_api_title + '</a>';
197 };
198 function qsp_api_makeObj(qsp_api_title, qsp_api_img, qsp_api_selected) {
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>';
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 } };
8 s=0
9 :loop1
10 if s<9:
11 s=s+1
12 pl s
13 jump 'loop1'
14 end
15 p 'Всё!'
747 16
748 function qsp_lib_goto(target, qsp_lib_args) {
749 qsp_api_clearText('main');
750 qsp_lib_xgoto(target, qsp_lib_args);
751 };
752 function qsp_lib_xgoto(target, qsp_lib_args) {
753 qsp_lib_args = qsp_lib_args || [];
754 qsp_api_clearAct();
755 qsp_CurrentLocation = target.toUpperCase();
756 qsp_api_stashState(qsp_lib_args);
757 qsp_api_callLoc(qsp_CurrentLocation, qsp_lib_args);
758 qsp_api_callServLoc('$ONNEWLOC');
759 };
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
17 :loop2
18 if y<y0:
19 if x<x0:
20 x=x+1
21 jump 'loop2'
22 end
23 y=y+1
24 x=0
25 jump 'loop2'
26 if y > y0: exit
27 end
28 -
Show file before | Show file after | Hide comments
@@ -1,14 +1,16 b''
1 1
2 2 (in-package txt2web)
3 3
4 4 (defclass compiler ()
5 5 ((body :accessor body :initform #.(load-src "extras/body.html"))
6 6 (css :accessor css :initform (list #.(load-src "extras/default.css")))
7 (ast :accessor ast :initform nil)
7 8 (js :accessor js :initform (reverse
8 9 (list
9 10 '#.(read-progn-from-string (load-src "src/main.ps"))
10 11 '#.(read-progn-from-string (load-src "src/api.ps"))
11 12 '#.(read-progn-from-string (load-src "src/intrinsics.ps")))))
13 (parse :accessor parse-only :initarg :parse)
12 14 (compile :accessor compile-only :initarg :compile)
13 15 (target :accessor target :initarg :target)
14 16 (beautify :accessor beautify :initarg :beautify)))
Show file before | Show file after | Hide comments
@@ -1,158 +1,164 b''
1 1
2 2 (in-package txt2web)
3 3
4 4 (defvar *app-name* "txt2web")
5 5
6 6 (defun entry-point-no-args ()
7 7 (setf *delivered* t)
8 8 (entry-point uiop:*command-line-arguments*))
9 9
10 10 (defun entry-point (args)
11 11 (let ((*package* (find-package :txt2web)))
12 12 (catch :terminate
13 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 18 (values))
16 19
17 20 (defun parse-opts (args)
18 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 23 (loop :for arg :in args
21 24 :do (alexandria:switch (arg :test #'string=)
22 25 ("-o" (setf mode :target))
23 26 ("--js" (setf mode :js))
24 27 ("--css" (setf mode :css))
25 28 ("--body" (setf mode :body))
26 29 ("-c" (setf (getf data :compile) t))
30 ("-p" (setf (getf data :parse) t))
27 31 ("--beautify" (setf (getf data :beautify) t))
28 32 (t (push arg (getf data mode)))))
29 33 (unless (< 0 (length (getf data :sources)))
30 34 (report-error "There should be at least one source"))
31 35 (unless (> 1 (length (getf data :target)))
32 36 (report-error "There should be no more than one target"))
33 37 (unless (> 1 (length (getf data :body)))
34 38 (report-error "There should be no more than one body"))
35 39 (unless (getf data :target)
36 40 (setf (getf data :target)
37 41 (let* ((sources (first (getf data :sources)))
38 42 (tokens (uiop:split-string sources :separator "."))
39 43 (target (format nil "~{~A~^.~}.html"
40 44 (butlast tokens))))
41 45 (list target))))
42 46 (list :sources (getf data :sources)
43 47 :target (first (getf data :target))
44 48 :js (getf data :js)
49 :parse (getf data :parse)
45 50 :css (getf data :css)
46 51 :body (first (getf data :body))
47 52 :compile (getf data :compile)
48 53 :beautify (getf data :beautify))))
49 54
50 55 (defun print-usage ()
51 56 (lformat t :usage *app-name*))
52 57
53 58 (defun parse-file (filename)
54 59 (handler-case
55 60 (p:parse 'txt2web-grammar
56 61 (alexandria:read-file-into-string filename :external-format :utf-8))
57 62 (p:esrap-parse-error (e)
58 63 (format t "~A~%" e)
59 64 (throw :terminate nil))))
60 65
61 66 (defun report-error (fmt &rest args)
62 67 (format t "ERROR: ~A~%" (apply #'format nil fmt args))
63 68 (print-usage)
64 69 (throw :terminate nil))
65 70
66 71 ;;; JS
67 72
68 73 (defun minify-package (package-designator minify prefix)
69 74 (setf (ps:ps-package-prefix package-designator) prefix)
70 75 (if minify
71 76 (ps:obfuscate-package package-designator)
72 77 (ps:unobfuscate-package package-designator)))
73 78
74 79 (defmethod js-sources ((compiler compiler))
75 80 (let ((ps:*ps-print-pretty* (beautify compiler)))
76 81 (cond ((beautify compiler)
77 82 (minify-package "TXT2WEB.MAIN" nil "qsp_")
78 83 (minify-package "TXT2WEB.API" nil "qsp_api_")
79 84 (minify-package "TXT2WEB.LIB" nil "qsp_lib_"))
80 85 (t
81 86 (minify-package "TXT2WEB.MAIN" t "_")
82 87 (minify-package "TXT2WEB.API" t "a_")
83 88 (minify-package "TXT2WEB.LIB" t "l_")))
84 89 (format nil "~{~A~^~%~%~}" (mapcar #'ps:ps* (reverse (js compiler))))))
85 90
86 91 ;;; CSS
87 92
88 93 (defmethod css-sources ((compiler compiler))
89 94 (format nil "~{~A~^~%~%~}" (css compiler)))
90 95
91 96 ;;; HTML
92 97
93 98 (defmethod html-sources ((compiler compiler))
94 99 (let ((flute:*escape-html* nil)
95 100 (body-template (body compiler))
96 101 (js (js-sources compiler))
97 102 (css (css-sources compiler)))
98 103 (with-output-to-string (out)
99 104 (write
100 105 (flute:h
101 106 (html
102 107 (head
103 108 (meta :charset "utf-8")
104 109 (title "txt2web"))
105 110 (body
106 111 body-template
107 112 (style css)
108 113 (script js))))
109 114 :stream out
110 115 :pretty nil))))
111 116
112 117 (defun filename-game (filename)
113 118 (let ((filename (alexandria:lastcar (uiop:split-string filename :separator "/"))))
114 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 122 (call-next-method)
118 (with-slots (body css js)
123 (with-slots (ast body css js)
119 124 compiler
120 125 ;; Compile the game's JS
121 126 (dolist (source sources)
122 127 (let ((ps (parse-file source))
123 128 (game-name (filename-game source)))
124 129 (destructuring-bind (kw &rest locations)
125 130 ps
126 131 (unless (eq kw 'lib:game)
127 132 (report-error "Internal error!"))
128 133 (push
129 134 `(lib:game (,game-name) ,@locations)
130 js))))
135 ast))))
136 (setf js (append ast js))
131 137 ;; Does the user need us to do anything else
132 (unless compile
138 (unless (or parse compile)
133 139 ;; Read in body
134 140 (when body-file
135 141 (setf body
136 142 (alexandria:read-file-into-string body-file :external-format :utf-8)))
137 143 ;; Include js files
138 144 (dolist (js-file js-files)
139 145 (push (format nil "////// Included file ~A~%~A" js-file
140 146 (alexandria:read-file-into-string js-file :external-format :utf-8))
141 147 js))
142 148 ;; Include css files
143 149 (when css-files
144 150 ;; User option overrides the default css
145 151 (setf css nil)
146 152 (dolist (css-file css-files)
147 153 (push (format nil "////// Included file ~A~%~A" css-file
148 154 (alexandria:read-file-into-string css-file :external-format :utf-8))
149 155 css))))))
150 156
151 157 (defmethod write-compiled-file ((compiler compiler))
152 158 (alexandria:write-string-into-file
153 159 (if (compile-only compiler)
154 160 ;; Just the JS
155 161 (js-sources compiler)
156 162 ;; All of it
157 163 (html-sources compiler))
158 164 (target compiler) :if-exists :supersede))
Show file before | Show file after | Hide comments
@@ -1,664 +1,664 b''
1 1
2 2 (in-package txt2web)
3 3
4 4 ;;;; Parses TXT source to an intermediate representation
5 5
6 6 (eval-when (:compile-toplevel :load-toplevel :execute)
7 7 (defparameter *max-args* 10))
8 8
9 9 ;;; Utility
10 10
11 11 (defun remove-nth (list nth)
12 12 (append (subseq list 0 nth)
13 13 (subseq list (1+ nth))))
14 14
15 15 (defun not-quote (char)
16 16 (not (eql #\' char)))
17 17
18 18 (defun not-doublequote (char)
19 19 (not (eql #\" char)))
20 20
21 21 (defun not-brace (char)
22 22 (not (eql #\} char)))
23 23
24 24 (defun not-integer (string)
25 25 (when (find-if-not #'digit-char-p string)
26 26 t))
27 27
28 28 (defun not-newline (char)
29 29 (not (eql #\newline char)))
30 30
31 31 (defun id-any-char (char)
32 32 (and
33 33 (not (digit-char-p char))
34 34 (not (eql #\newline char))
35 35 (not (find char " !:&=<>+-*/,'\"()[]{}"))))
36 36
37 37 (defun intern-first (list)
38 38 (list* (intern (string-upcase (first list)) "TXT2WEB.LIB")
39 39 (rest list)))
40 40
41 41 (eval-when (:compile-toplevel :load-toplevel :execute)
42 42 (defun remove-nil (list)
43 43 (remove nil list)))
44 44
45 45 (defun binop-rest (list)
46 46 (destructuring-bind (ws1 operator ws2 operand2)
47 47 list
48 48 (declare (ignore ws1 ws2))
49 49 (list (intern (string-upcase operator) "TXT2WEB.LIB") operand2)))
50 50
51 51 (defun do-binop% (left-op other-ops)
52 52 (if (null other-ops)
53 53 left-op
54 54 (destructuring-bind ((operator right-op) &rest rest-ops)
55 55 other-ops
56 56 (if (and (listp left-op)
57 57 (eq (first left-op)
58 58 operator))
59 59 (do-binop% (append left-op (list right-op)) rest-ops)
60 60 (do-binop% (list operator left-op right-op) rest-ops)))))
61 61
62 62 (walker:deftransform parser-qspmod mod (&rest args)
63 63 (list* 'qspmod (mapcar #'walker:walk-continue args)))
64 64
65 65 (defun do-binop (list)
66 66 (walker:walk 'parser-qspmod
67 67 (destructuring-bind (left-op rest-ops)
68 68 list
69 69 (do-binop% left-op
70 70 (mapcar #'binop-rest rest-ops)))))
71 71
72 72 (defun maybe-text (list)
73 73 "Leaves lists in place and applies esrap:text to everything else"
74 74 (let ((parts nil)
75 75 (part (list 'text)))
76 76 (loop :for token :in list
77 77 :do (cond ((listp token)
78 78 (push (nreverse part) parts)
79 79 (setf part (list 'text))
80 80 (push token parts))
81 81 (t (push token part))))
82 82 (push (nreverse part) parts)
83 83 (remove ""
84 84 (loop :for part :in (nreverse parts)
85 85 :collect (case (first part)
86 86 ('text (p:text (rest part)))
87 87 (t part)))
88 88 :test #'equal)))
89 89
90 90 (p:defrule line-continuation (and #\_ #\newline)
91 91 (:constant nil))
92 92
93 93 (p:defrule text-spaces (+ (or #\space #\tab line-continuation))
94 94 (:text t))
95 95
96 96 (p:defrule spaces (+ (or #\space #\tab line-continuation))
97 97 (:constant nil)
98 98 (:error-report nil))
99 99
100 100 (p:defrule spaces? (* (or #\space #\tab line-continuation))
101 101 (:constant nil)
102 102 (:error-report nil))
103 103
104 104 (p:defrule colon #\:
105 105 (:constant nil))
106 106
107 107 (p:defrule equal #\=
108 108 (:constant nil))
109 109
110 110 (p:defrule alphanumeric (alphanumericp character))
111 111
112 112 (p:defrule not-newline (not-newline character))
113 113
114 114 (p:defrule squote-esc "''"
115 115 (:lambda (list)
116 116 (p:text (elt list 0))))
117 117
118 118 (p:defrule dquote-esc "\"\""
119 119 (:lambda (list)
120 120 (p:text (elt list 0))))
121 121
122 122 (p:defrule sstring-char (or squote-esc (not-quote character))
123 123 (:text t))
124 124
125 125 (p:defrule dstring-char (or dquote-esc (not-doublequote character))
126 126 (:text t))
127 127
128 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 132 (defun trim-$ (str)
133 133 (if (char= #\$ (elt str 0))
134 134 (subseq str 1)
135 135 str))
136 136
137 137 (defun qsp-keyword-p (id)
138 138 (member (intern (trim-$ (string-upcase id))) *keywords*))
139 139
140 140 (defun not-qsp-keyword-p (id)
141 141 (not (member (intern (trim-$ (string-upcase id))) *keywords*)))
142 142
143 143 (p:defrule qsp-keyword (qsp-keyword-p identifier-raw))
144 144
145 145 (p:defrule id-first (id-any-char character))
146 146 (p:defrule id-next (or (id-any-char character)
147 147 (digit-char-p character)))
148 148 (p:defrule identifier-raw (and id-first (* id-next))
149 149 (:lambda (list)
150 150 (intern (string-upcase (p:text list)) "TXT2WEB.LIB")))
151 151
152 152 (p:defrule identifier (not-qsp-keyword-p identifier-raw))
153 153
154 154 ;;; Strings
155 155
156 156 (p:defrule qsp-string (or normal-string brace-string))
157 157
158 158 (p:defrule brace-string (and #\{ before-statement block-body #\})
159 159 (:lambda (list)
160 160 (list* 'lib:qspblock (third list))))
161 161
162 162 (p:defrule normal-string (or sstring dstring)
163 163 (:lambda (str)
164 164 (list* 'lib:str (or str (list "")))))
165 165
166 166 (p:defrule sstring (and #\' (* (or sstring-interpol
167 167 sstring-exec
168 168 sstring-char))
169 169 #\')
170 170 (:lambda (list)
171 171 (maybe-text (second list))))
172 172
173 173 (p:defrule dstring (and #\" (* (or dstring-interpol
174 174 dstring-exec
175 175 dstring-char))
176 176 #\")
177 177 (:lambda (list)
178 178 (maybe-text (second list))))
179 179
180 180 (defun parse-interpol (list)
181 181 (p:parse 'expression (p:text (mapcar 'second (second list)))))
182 182
183 183 (defun parse-exec (list)
184 184 (list* 'lib:exec (p:parse 'exec-body (p:text (second list)))))
185 185
186 186 (p:defrule sstring-interpol (and "<<" (+ (and (p:! ">>")
187 187 sstring-char))
188 188 ">>")
189 189 (:function parse-interpol))
190 190
191 191 (p:defrule dstring-interpol (and "<<" (+ (and (p:! ">>")
192 192 dstring-char))
193 193 ">>")
194 194 (:function parse-interpol))
195 195
196 196 (p:defrule sstring-exec (or (and (p:~ "\"exec:")
197 197 (+ (and (p:& (not-doublequote character)) sstring-char))
198 198 #\")
199 199 (and (p:~ "''exec:")
200 200 (+ (not-quote character))
201 201 "''"))
202 202 (:function parse-exec))
203 203
204 204 (p:defrule dstring-exec (or (and (p:~ "'exec:")
205 205 (+ (and (p:& (not-quote character)) dstring-char))
206 206 #\')
207 207 (and (p:~ "\"\"exec")
208 208 (+ (not-doublequote character))
209 209 "\"\""))
210 210 (:function parse-exec))
211 211
212 212 ;;; Location
213 213
214 214 (p:defrule txt2web-grammar (and (* (or spaces #\newline))
215 215 (* location))
216 216 (:lambda (list)
217 217 `(lib:game ,@(second list))))
218 218
219 219 (p:defrule location (and location-header block-body location-end)
220 220 (:destructure (header body end)
221 221 (declare (ignore end))
222 222 `(lib:location (,header) ,@body)))
223 223
224 224 (p:defrule location-header (and #\#
225 225 (+ not-newline)
226 226 (and #\newline spaces? before-statement))
227 227 (:destructure (spaces1 name spaces2)
228 228 (declare (ignore spaces1 spaces2))
229 229 (string-upcase (string-trim " " (p:text name)))))
230 230
231 231 (p:defrule location-end (and #\- (* not-newline) #\newline before-statement)
232 232 (:constant nil))
233 233
234 234 ;;; Block body
235 235
236 236 (p:defrule newline-block-body (and #\newline spaces? block-body)
237 237 (:function third))
238 238
239 239 (p:defrule block-body (* statement)
240 240 (:function remove-nil))
241 241
242 242 ;; Just for <a href="exec:...'>
243 243 ;; Explicitly called from that rule's production
244 244 (p:defrule exec-body (and before-statement line-body)
245 245 (:function second))
246 246
247 247 (p:defrule line-body (and inline-statement (* next-inline-statement))
248 248 (:lambda (list)
249 249 (list* (first list) (second list))))
250 250
251 251 (p:defrule before-statement (* (or #\newline spaces))
252 252 (:constant nil))
253 253
254 254 (p:defrule statement-end (or statement-end-real statement-end-block-close))
255 255
256 256 (p:defrule statement-end-real (and (or #\newline
257 257 (and #\& spaces? (p:& statement%)))
258 258 before-statement)
259 259 (:constant nil))
260 260
261 261 (p:defrule statement-end-block-close (or (p:& #\}))
262 262 (:constant nil))
263 263
264 264 (p:defrule inline-statement (and statement% spaces?)
265 265 (:function first))
266 266
267 267 (p:defrule next-inline-statement (and #\& spaces? inline-statement)
268 268 (:function third))
269 269
270 270 (p:defrule not-a-non-statement (and (p:! (p:~ "elseif"))
271 271 (p:! (p:~ "else"))
272 272 (p:! (p:~ "end"))))
273 273
274 274 (p:defrule statement (and inline-statement statement-end)
275 275 (:function first))
276 276
277 277 (p:defrule statement% (and not-a-non-statement
278 278 (or label comment string-output
279 279 block non-returning-intrinsic local
280 280 assignment expression-output))
281 281 (:function second))
282 282
283 283 (p:defrule expr-stopper (or comment block non-returning-intrinsic))
284 284
285 285 (p:defrule string-output qsp-string
286 286 (:lambda (string)
287 287 (list 'lib:main-pl string)))
288 288
289 289 (p:defrule expression-output expression
290 290 (:lambda (list)
291 291 (list 'lib:main-pl list)))
292 292
293 293 (p:defrule label (and colon identifier)
294 294 (:lambda (list)
295 295 (intern (string (second list)) :keyword)))
296 296
297 297 (p:defrule comment (and #\! (* (or qsp-string brace-comment text-spaces not-newline)))
298 298 (:constant nil))
299 299
300 300 (p:defrule brace-comment (and #\{ (* (not-brace character)) #\})
301 301 (:constant nil))
302 302
303 303 (p:defrule local (and (p:~ "local") spaces variable (p:? (and spaces? #\= spaces? expression)))
304 304 (:lambda (list)
305 305 (list* 'lib:local (third list)
306 306 (when (fourth list)
307 307 (list (fourth (fourth list)))))))
308 308
309 309 ;;; Blocks
310 310
311 311 (p:defrule block (or block-act block-if block-loop))
312 312
313 313 (p:defrule block-if (and block-if-head block-if-body)
314 314 (:destructure (head body)
315 315 `(lib:qspcond (,@head ,@(first body))
316 316 ,@(rest body))))
317 317
318 318 (p:defrule block-if-head (and (p:~ "if") spaces expression spaces? colon spaces?)
319 319 (:function remove-nil)
320 320 (:function cdr))
321 321
322 322 (p:defrule block-if-body (or block-if-ml block-if-sl)
323 323 (:destructure (if-body elseifs else &rest ws)
324 324 (declare (ignore ws))
325 325 `(,(remove-nil if-body) ,@elseifs ,@(when else `((else ,@else))))))
326 326
327 327 (p:defrule block-if-sl (and line-body
328 328 (p:? block-if-elseif-inline)
329 329 (p:? block-if-else-inline)
330 330 spaces?))
331 331
332 332 (p:defrule block-if-ml (and (and #\newline spaces?)
333 333 block-body
334 334 (p:? block-if-elseif)
335 335 (p:? block-if-else)
336 336 block-if-end)
337 337 (:lambda (list)
338 338 (cdr list)))
339 339
340 340 (p:defrule block-if-elseif-inline (and block-if-elseif-head line-body (p:? block-if-elseif-inline))
341 341 (:destructure (head statements elseif)
342 342 `((,@(rest head) ,@(remove-nil statements)) ,@elseif)))
343 343
344 344 (p:defrule block-if-elseif (and block-if-elseif-head statement-end block-body (p:? block-if-elseif))
345 345 (:destructure (head ws statements elseif)
346 346 (declare (ignore ws))
347 347 `((,@(rest head) ,@(remove-nil statements)) ,@elseif)))
348 348
349 349 (p:defrule block-if-elseif-head (and (p:~ "elseif") spaces expression spaces? colon spaces?)
350 350 (:function remove-nil)
351 351 (:function intern-first))
352 352
353 353 (p:defrule block-if-else-inline (and block-if-else-head line-body)
354 354 (:function second))
355 355
356 356 (p:defrule block-if-else (and block-if-else-head #\newline spaces? block-body)
357 357 (:function fourth))
358 358
359 359 (p:defrule block-if-else-head (and (p:~ "else") spaces?)
360 360 (:constant nil))
361 361
362 362 (p:defrule block-if-end (and (p:~ "end")
363 363 (p:? (and spaces (p:~ "if"))))
364 364 (:constant nil))
365 365
366 366 (p:defrule block-act (and block-act-head (or block-ml block-sl))
367 367 (:lambda (list)
368 368 (apply #'append list)))
369 369
370 370 (p:defrule block-act-head (and (p:~ "act") spaces? qsp-string spaces?
371 371 (p:? block-act-head-img)
372 372 colon spaces?)
373 373 (:lambda (list)
374 374 (intern-first (list (first list)
375 375 (third list)
376 376 (or (fifth list) '(lib:str ""))))))
377 377
378 378 (p:defrule block-act-head-img (and #\, spaces? qsp-string spaces?)
379 379 (:lambda (list)
380 380 (or (third list) "")))
381 381
382 382 (p:defrule block-loop (and block-loop-head (or block-ml block-sl))
383 383 (:lambda (list)
384 384 (apply #'append list)))
385 385
386 386 (p:defrule block-loop-head (and (p:~ "loop") spaces
387 387 (p:? (and block-loop-head-init spaces?))
388 388 block-loop-head-while spaces?
389 389 (p:? (and block-loop-head-step spaces?))
390 390 colon spaces?)
391 391 (:lambda (list)
392 392 (break "~S" list)
393 393 (list 'lib:qsploop
394 394 (elt list 2)
395 395 (elt list 6)
396 396 (elt list 9)
397 397 (elt list 10))))
398 398
399 399 (p:defrule block-loop-head-init (or local plain-assignment))
400 400
401 401 (p:defrule block-loop-head-while (and (p:~ "while") eq-expr)
402 402 (:function second))
403 403
404 404 (p:defrule block-loop-head-step (and (p:~ "step") (or plain-assignment op-assignment))
405 405 (:function second))
406 406
407 407 (p:defrule block-sl line-body)
408 408
409 409 (p:defrule block-ml (and newline-block-body block-end)
410 410 (:lambda (list)
411 411 (apply #'list* (butlast list))))
412 412
413 413 (p:defrule block-end (and (p:~ "end"))
414 414 (:constant nil))
415 415
416 416 ;;; Calls
417 417
418 418 (p:defrule first-argument (and expression spaces?)
419 419 (:function first))
420 420 (p:defrule next-argument (and "," spaces? expression)
421 421 (:function third))
422 422 (p:defrule arguments (or parenthesized-arguments plain-arguments no-arguments))
423 423 (p:defrule parenthesized-arguments (and spaces? #\( base-arguments #\))
424 424 (:function third))
425 425 (p:defrule plain-arguments (and spaces? base-arguments)
426 426 (:function second))
427 427 (p:defrule no-arguments (or (and spaces? (p:& #\newline))
428 428 (and spaces? (p:& #\&))
429 429 spaces?)
430 430 (:constant nil))
431 431 (p:defrule base-arguments (or (and first-argument (* next-argument)) spaces?)
432 432 (:lambda (list)
433 433 (if (null list)
434 434 nil
435 435 (list* (first list) (second list)))))
436 436
437 437 ;;; Intrinsics
438 438
439 439 (defmacro defintrinsics ((rule-name returning-rule-name non-returning-rule-name) &body clauses)
440 440 `(progn
441 441 ,@(loop :for clause :in clauses
442 442 :collect `(defintrinsic ,@clause))
443 443 (p:defrule ,returning-rule-name (or ,@(remove-nil
444 444 (mapcar (lambda (clause)
445 445 (when (second clause)
446 446 (alexandria:symbolicate
447 447 'intrinsic- (first clause))))
448 448 clauses))))
449 449 (p:defrule ,non-returning-rule-name (or ,@(remove-nil
450 450 (mapcar (lambda (clause)
451 451 (unless (second clause)
452 452 (alexandria:symbolicate
453 453 'intrinsic- (first clause))))
454 454 clauses))))
455 455 (p:defrule ,rule-name (or ,returning-rule-name ,non-returning-rule-name))))
456 456
457 457 (defmacro defintrinsic (sym returning &optional (min-arity 0) max-arity &rest names)
458 458 (declare (ignore returning))
459 459 (unless max-arity
460 460 (setf max-arity *max-args*))
461 461 (setf names
462 462 (if names
463 463 (mapcar #'string-upcase names)
464 464 (list (string sym))))
465 465 `(p:defrule ,(alexandria:symbolicate 'intrinsic- sym)
466 466 (and (p:? #\$) (or ,@(loop :for name :in names :collect `(p:~ ,name)))
467 467 arguments)
468 468 (:destructure (dollar name arguments)
469 469 (declare (ignore dollar))
470 470 (unless (<= ,min-arity (length arguments) ,max-arity)
471 471 (error "Intrinsic ~A expects between ~A and ~A arguments but ~A were provided:~%~S"
472 472 name ,min-arity ,max-arity (length arguments) arguments))
473 473 (list* ',(intern (string sym) "TXT2WEB.LIB") arguments))))
474 474
475 475 (defintrinsics (intrinsic returning-intrinsic non-returning-intrinsic)
476 476 ;; Transitions
477 477 (goto% nil 0 nil "gt" "goto")
478 478 (xgoto% nil 0 nil "xgt" "xgoto")
479 479 ;; Variables
480 480 (killvar nil 0 2)
481 481 ;; Expressions
482 482 (obj t 1 1)
483 483 (loc t 1 1)
484 484 (no t 1 1)
485 485 ;; Basic
486 486 (qspver t 0 0)
487 487 (curloc t 0 0)
488 488 (rand t 1 2)
489 489 (rnd t 0 0)
490 490 (qspmax t 1 nil "max")
491 491 (qspmin t 1 nil "min")
492 492 ;; Arrays
493 493 (killall nil 0 0)
494 494 (copyarr nil 2 4)
495 495 (arrsize t 1 1)
496 496 (arrpos t 2 3)
497 497 (arrcomp t 2 3)
498 498 ;; Strings
499 499 (len t 1 1)
500 500 (mid t 2 3)
501 501 (ucase t 1 1)
502 502 (lcase t 1 1)
503 503 (trim t 1 1)
504 504 (qspreplace t 2 3 "replace")
505 505 (instr t 2 3)
506 506 (isnum t 1 1)
507 507 (val t 1 1)
508 508 (qspstr t 1 1 "str")
509 509 (strcomp t 2 2)
510 510 (strfind t 2 3)
511 511 (strpos t 2 3)
512 512 ;; IF
513 513 (iif t 2 3)
514 514 ;; Subs
515 515 (gosub nil 1 nil "gosub" "gs")
516 516 (func t 1 nil)
517 517 (exit nil 0 0)
518 518 ;; Jump
519 519 (jump nil 1 1)
520 520 ;; Dynamic
521 521 (dynamic nil 1 nil)
522 522 (dyneval t 1 nil)
523 523 ;; Sound
524 524 (play nil 1 2)
525 525 (isplay t 1 1)
526 526 (close nil 1 1)
527 527 (closeall nil 0 0 "close all")
528 528 ;; Main window
529 529 (main-pl nil 1 1 "*pl")
530 530 (main-nl nil 0 1 "*nl")
531 531 (main-p nil 1 1 "*p")
532 532 (maintxt t 0 0)
533 533 (desc t 1 1)
534 534 (main-clear nil 0 0 "*clear" "*clr")
535 535 ;; Aux window
536 536 (showstat nil 1 1)
537 537 (stat-pl nil 1 1 "pl")
538 538 (stat-nl nil 0 1 "nl")
539 539 (stat-p nil 1 1 "p")
540 540 (stattxt t 0 0)
541 541 (stat-clear nil 0 0 "clear" "clr")
542 542 (cls nil 0 0)
543 543 ;; Dialog
544 544 (msg nil 1 1)
545 545 ;; Acts
546 546 (showacts nil 1 1)
547 547 (delact nil 1 1 "delact" "del act")
548 548 (curacts t 0 0)
549 549 (selact t 0 0)
550 550 (cla nil 0 0)
551 551 ;; Objects
552 552 (showobjs nil 1 1)
553 553 (addobj nil 1 3 "addobj" "add obj")
554 554 (delobj nil 1 1 "delobj" "del obj")
555 555 (killobj nil 0 1)
556 556 (countobj t 0 0)
557 557 (getobj t 1 1)
558 558 (selobj t 0 0)
559 559 (unsel nil 0 0 "unsel" "unselect")
560 560 ;; Menu
561 561 (menu nil 1 1)
562 562 ;; Images
563 563 (refint nil 0 0)
564 564 (view nil 0 1)
565 565 (img nil 1)
566 566 (*img nil 1)
567 567 ;; Fonts
568 568 (rgb t 3 3)
569 569 ;; Input
570 570 (showinput nil 1 1)
571 571 (usertxt t 0 0 "user_text" "usrtxt")
572 572 (cmdclear nil 0 0 "cmdclear" "cmdclr")
573 573 (input t 1 1)
574 574 ;; Files
575 575 (openqst nil 1 1)
576 576 (addqst nil 1 1 "addqst" "addlib" "inclib")
577 577 (killqst nil 1 1 "killqst" "dellib" "freelib")
578 578 (opengame nil 0 0)
579 579 (savegame nil 0 0)
580 580 ;; Real time
581 581 (wait nil 1 1)
582 582 (msecscount t 0 0)
583 583 (settimer nil 1 1))
584 584
585 585 ;;; Expression
586 586
587 587 (p:defrule expression or-expr)
588 588
589 589 (p:defrule or-expr (and and-expr (* (and spaces? or-op spaces? and-expr)))
590 590 (:function do-binop))
591 591
592 592 (p:defrule and-expr (and eq-expr (* (and spaces? and-op spaces? eq-expr)))
593 593 (:function do-binop))
594 594
595 595 (p:defrule eq-expr (and sum-expr (* (and spaces? (or "<=" ">=" "=<" "=>" "<>"
596 "=" "<" ">" "!")
596 "=" "<" ">")
597 597 spaces? sum-expr)))
598 598 (:function do-binop))
599 599
600 600 (p:defrule sum-expr (and mod-expr (* (and spaces? (or #\+ #\-) spaces? mod-expr)))
601 601 (:function do-binop))
602 602
603 603 (p:defrule mod-expr (and mul-expr (* (and spaces? (p:~ "mod") spaces? mul-expr)))
604 604 (:function do-binop))
605 605
606 606 (p:defrule mul-expr (and unary-expr (* (and spaces? (or #\* #\/) spaces? unary-expr)))
607 607 (:function do-binop))
608 608
609 609 (p:defrule unary-expr (and (p:? (or #\+ #\-)) atom-expr)
610 610 (:lambda (list)
611 611 (let ((expr (remove-nil list)))
612 612 (if (= 1 (length expr))
613 613 (first expr)
614 614 (intern-first expr)))))
615 615
616 616 (p:defrule atom-expr (and (or variable literal returning-intrinsic paren-expr) spaces?)
617 617 (:function first))
618 618
619 619 (p:defrule paren-expr (and #\( spaces? expression spaces? #\))
620 620 (:function third))
621 621
622 622 (p:defrule or-op (p:~ "or")
623 623 (:constant "or"))
624 624
625 625 (p:defrule and-op (p:~ "and")
626 626 (:constant "and"))
627 627
628 628 ;;; Variables
629 629
630 630 (p:defrule variable (and identifier (p:? array-index))
631 631 (:destructure (id idx-raw)
632 632 (let ((idx (case idx-raw
633 633 ((nil) 0)
634 634 (:last nil)
635 635 (t idx-raw))))
636 636 (list 'lib:qspvar id idx))))
637 637
638 638 (p:defrule array-index (and #\[ spaces? (p:? expression) spaces? #\])
639 639 (:lambda (list)
640 640 (or (third list) :last)))
641 641
642 642 (p:defrule assignment (or kw-assignment plain-assignment op-assignment)
643 643 (:destructure (qspvar eq expr)
644 644 (declare (ignore eq))
645 645 (list 'lib:set qspvar expr)))
646 646
647 647 (p:defrule kw-assignment (and (or (p:~ "let") (p:~ "set")) spaces? (or op-assignment plain-assignment))
648 648 (:function third))
649 649
650 650 (p:defrule op-assignment (and variable spaces? (or "+" "-" "*" "/") #\= spaces? expression)
651 651 (:destructure (qspvar ws1 op eq ws2 expr)
652 652 (declare (ignore ws1 ws2))
653 653 (list qspvar eq (intern-first (list op qspvar expr)))))
654 654
655 655 (p:defrule plain-assignment (and variable spaces? #\= spaces? expression)
656 656 (:function remove-nil))
657 657
658 658 ;;; Non-string literals
659 659
660 660 (p:defrule literal (or qsp-string brace-string number))
661 661
662 662 (p:defrule number (+ (or #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
663 663 (:lambda (list)
664 664 (parse-integer (p:text list))))
Show file before | Show file after | Hide comments
@@ -1,394 +1,391 b''
1 1
2 2 (in-package txt2web.lib)
3 3
4 4 ;;;; Parenscript macros which make the parser's intermediate
5 5 ;;;; representation directly compilable by Parenscript
6 6 ;;;; Some utility macros for other .ps sources too.
7 7
8 8 ;;;; Block type | Has own locals | Has labels | async
9 9 ;;; Location | TRUE | TRUE | TRUE
10 10 ;;; Act | TRUE | TRUE | TRUE
11 11 ;;; {} | TRUE | TRUE | TRUE
12 12 ;;; IF | FALSE | TRUE | TRUE
13 13 ;;; FOR | FALSE | TRUE | TRUE
14 14 ;;;
15 15 ;;; IF and FOR are actually not blocks at all. They're implemented as Javascript's if and for loops.
16 16 ;;; Jumps back are also optimized to Javascript's while loops.
17 17
18 18 ;;; Utils
19 19
20 20 ;;; Common
21 21
22 22 (defpsmacro label-block (() &body body)
23 23 (let ((has-labels (some #'keywordp body)))
24 24 `(block nil
25 25 ,@(when has-labels
26 26 '((var _labels (list))))
27 27 (tagbody
28 28 ,@body
29 29 (void)))))
30 30
31 31 (defpsmacro str (&rest forms)
32 32 (cond ((zerop (length forms))
33 33 "")
34 34 ((and (= 1 (length forms))
35 35 (stringp (first forms)))
36 36 (first forms))
37 37 (t
38 38 `(& ,@forms))))
39 39
40 40 (defpsmacro locals-block (&body body)
41 41 "Includes labels too (through qsp-lambda)"
42 42 (let ((*locals* nil))
43 43 (walker:walk 'locals body)
44 44 `(qsp-lambda
45 45 (create-locals ,*locals*)
46 46 ,@(walker:walk 'apply-vars body))))
47 47
48 48 ;;; 1loc
49 49
50 50 (defparameter *special-variables*
51 51 '((usehtml 0)
52 52 (result 0)
53 53 ($result 0)
54 54 ($ongload 0)
55 55 ($ongsave 0)
56 56 ($onobjadd 0)
57 57 ($onobjdel 0)
58 58 ($onobjsel 0)
59 59 ($onnewloc 0)
60 60 ($onactsel 0)
61 61 ($counter 0)
62 62 ($usercom 0)))
63 63
64 64 (defpsmacro game ((name) &body body)
65 65 (setf body (walker:walk 'for-transform body))
66 66 (setf *globals* *special-variables*)
67 67 (walker:walk 'globals body)
68 68 `(progn
69 69 ;; Game object
70 70 (setf (@ *games ,name)
71 71 (create))
72 72 ;; Global variables from this game
73 73 (create-globals ,*globals*)
74 74 ;; Locations
75 75 ,@(loop :for location :in body
76 76 :collect `(setf (@ *games ,name ,(caadr location))
77 77 ,location))))
78 78
79 79 (defpsmacro location ((name) &body body)
80 80 (declare (ignore name))
81 81 "Name is used by the game macro above"
82 82 `(locals-block ,@body))
83 83
84 84 (defpsmacro goto% (target &rest args)
85 85 `(progn
86 86 (goto ,target ,args)
87 87 (exit)))
88 88
89 89 (defpsmacro xgoto% (target &rest args)
90 90 `(progn
91 91 (xgoto ,target ,args)
92 92 (exit)))
93 93
94 94 ;;; 2var
95 95
96 96 (defvar *globals* nil)
97 97 (defvar *locals* nil)
98 98
99 99 (defpsmacro create-globals (globals)
100 100 (flet ((indexes (name)
101 101 (remove nil
102 102 (remove-if #'listp
103 103 (mapcar #'second
104 104 (remove name globals
105 105 :key #'first
106 106 :test-not #'eq))))))
107 107 (let ((names (remove-duplicates (mapcar #'first globals))))
108 108 `(chain *object
109 109 (assign *globals
110 110 (create
111 111 ,@(loop :for sym :in names
112 112 :for indexes := (indexes sym)
113 113 :for name := (string-upcase sym)
114 114 :append `(,name
115 115 (api-call new-var ,name ,@indexes)))))))))
116 116
117 117 (walker:deftransform globals qspvar (&rest var)
118 118 (pushnew var *globals* :test #'equal)
119 119 (walker:walk-continue))
120 120
121 121 (walker:deftransform globals local (var &rest expr)
122 122 (declare (ignore var))
123 123 (walker:walk 'globals expr))
124 124
125 125 (defpsmacro create-locals (locals)
126 126 (when locals
127 127 `(progn
128 128 (var locals (create
129 129 ,@(loop :for (sym index) :in locals
130 130 :for name := (string-upcase sym)
131 131 :append `(,name (api-call new-var ,name))))))))
132 132
133 133 ;; locations, blocks, and acts all have their own locals namespace
134 134 (walker:deftransform-stop locals qspblock)
135 135 (walker:deftransform-stop locals act)
136 136
137 137 (walker:deftransform locals local (var &optional expr)
138 138 (declare (ignore expr))
139 139 (pushnew (rest var) *locals* :test #'equal)
140 140 nil)
141 141
142 142 ;; index types:
143 143 ;; literal number
144 144 ;; literal string
145 145 ;; variable number
146 146 ;; variable string
147 147 ;; expression (may be possible to determine if it's a string or a number)
148 148
149 149 (defun $-var-p (sym)
150 150 (char= #\$ (elt (string-upcase (symbol-name sym)) 0)))
151 151
152 152 (defun literal-string-p (form)
153 153 (and (listp form)
154 154 (= 2 (length form))
155 155 (eq 'str (first form))
156 156 (stringp (second form))))
157 157
158 158 (defun variable-number-p (form)
159 159 (and (listp form)
160 160 (eq 'qspvar (first form))
161 161 (not ($-var-p (second form)))))
162 162
163 163 (defun variable-string-p (form)
164 164 (and (listp form)
165 165 (eq 'qspvar (first form))
166 166 ($-var-p (second form))))
167 167
168 168 (walker:deftransform apply-vars set (var expr)
169 169 (destructuring-bind (qspvar name index)
170 170 var
171 171 (declare (ignore qspvar))
172 172 (setf name (string-upcase name))
173 173 (let ((slot `(getprop
174 174 ,(if (member name *locals* :key #'first)
175 175 'locals '*globals)
176 176 ,name))
177 177 (index (walker:walk 'apply-vars index))
178 178 (value (walker:walk 'apply-vars expr)))
179 179 (cond
180 180 ((member name api:*serv-vars* :test #'equalp)
181 181 `(api:set-serv-var ,name ,index ,value))
182 182 ((null index)
183 183 `(chain (elt ,slot) (push ,value)))
184 184 ((or (numberp index)
185 185 (variable-number-p index))
186 186 `(setf (elt ,slot ,index) ,value))
187 187 ((or (literal-string-p index)
188 188 (variable-string-p index))
189 189 `(api:set-str-element ,slot ,index ,value))
190 190 (t
191 191 `(api:set-any-element ,slot ,index ,value))))))
192 192
193 193 (walker:deftransform apply-vars local (var &optional expr)
194 194 ;; TODO: var can't be a service variable
195 195 (when expr
196 196 (walker:walk 'apply-vars (list 'set var expr))))
197 197
198 198 (walker:deftransform apply-vars qspvar (name index)
199 199 (let ((slot `(getprop
200 200 ,(if (member name *locals* :key #'first) 'locals '*globals)
201 201 ,(string-upcase name))))
202 202 (cond
203 203 ((null index)
204 204 `(elt ,slot (1- (length ,slot))))
205 205 ((or (numberp index)
206 206 (variable-number-p index))
207 207 `(elt ,slot ,(walker:walk-continue index)))
208 208 ((or (literal-string-p index)
209 209 (variable-string-p index))
210 210 `(elt ,slot (@ ,slot :indexes ,(walker:walk-continue index))))
211 211 (t
212 212 `(get-element ,slot ,(walker:walk-continue index))))))
213 213
214 214 (walker:deftransform apply-vars qspblock (&rest block)
215 215 (declare (ignore block))
216 216 (walker:whole))
217 217 (walker:deftransform apply-vars act (&rest block)
218 218 (declare (ignore block))
219 219 (walker:whole))
220 220 (walker:deftransform apply-vars qspfor (var from to step body)
221 221 (list* 'qspfor var (mapcar #'walker:walk-continue (list from to step body))))
222 222
223 223 ;;; 3expr
224 224
225 225 (defpsmacro <> (op1 op2)
226 226 `(not (equal ,op1 ,op2)))
227 227
228 (defpsmacro ! (op1 op2)
229 `(not (equal ,op1 ,op2)))
230
231 228 (defpsmacro qspmod (&rest ops)
232 229 (case (length ops)
233 230 (1 (first ops))
234 231 (2 `(mod ,@ops))
235 232 (t `(mod ,(first ops) (qspmod ,@(rest ops))))))
236 233
237 234 ;;; 4code
238 235
239 236 (defpsmacro exec (&body body)
240 237 (format nil "javascript: ~{~A~^~%~}" (mapcar #'ps* body)))
241 238
242 239 ;;; 5arrays
243 240
244 241 ;;; 6str
245 242
246 243 (defpsmacro & (&rest args)
247 244 `(chain "" (concat ,@args)))
248 245
249 246 ;;; 7if
250 247
251 248 (defpsmacro qspcond (&rest clauses)
252 249 `(cond ,@(loop :for clause :in clauses
253 250 :for f := (if (eq 'txt2web::else (first clause))
254 251 't
255 252 (first clause))
256 253 :collect (list f
257 254 `(tagbody
258 255 ,@(rest clause))))))
259 256
260 257 ;;; 8sub
261 258
262 259 ;;; 9jump
263 260 ;;; Yep, that's a huge kludge since Javascript doesn't support arbitrary labels
264 261
265 262 (defpsmacro jump (target)
266 263 `(return-from label-body ,(string-upcase (second target))))
267 264
268 265 (defpsmacro tagbody (&body body)
269 266 (let ((create-locals (if (eq (caar body) 'create-locals)
270 267 (list (car body))))
271 268 (void (if (equal (car (last body)) '(void))
272 269 '((void)))))
273 270 (when create-locals
274 271 (setf body (cdr body)))
275 272 (when void
276 273 (setf body (butlast body)))
277 274 (let ((funcs (list nil "_nil")))
278 275 (dolist (form body)
279 276 (cond ((keywordp form)
280 277 (setf (first funcs) (reverse (first funcs)))
281 278 (push (string-upcase form) funcs)
282 279 (push nil funcs))
283 280 (t
284 281 (push form (first funcs)))))
285 282 (setf (first funcs) (reverse (first funcs)))
286 283 (setf funcs (reverse funcs))
287 284 `(progn
288 285 ,@create-locals
289 286 ,(if (= 2 (length funcs))
290 287 `(progn
291 288 ,@body)
292 289 `(progn
293 290 (tagbody-blocks ,funcs)
294 291 (loop
295 292 :for _nextblock
296 293 := :_nil
297 294 :then (await (funcall (getprop _labels _nextblock)))
298 295 :while _nextblock)))
299 296 ,@void))))
300 297
301 298 (defvar *current-label*)
302 299 (defvar *has-jump-back*)
303 300 (walker:deftransform optimize-jump jump (target)
304 301 (cond ((string= (string-upcase (second target)) *current-label*)
305 302 (setf *has-jump-back* t)
306 303 '(continue))
307 304 (t
308 305 (walker:walk-continue))))
309 306
310 307 (defpsmacro tagbody-blocks (funcs)
311 308 `(setf ,@(loop :for (label code . rest-labels) :on funcs :by #'cddr
312 309 :append `((@ _labels ,label)
313 310 (async-lambda ()
314 311 (block label-body
315 312 (tagbody-block-body ,label ,code
316 313 ,(first rest-labels))))))))
317 314
318 315 (defpsmacro tagbody-block-body (label code next-label)
319 316 (let ((*current-label* label)
320 317 (*has-jump-back* nil))
321 318 (let ((code (walker:walk 'optimize-jump code)))
322 319 (if *has-jump-back*
323 320 `(progn
324 321 (loop :do (progn
325 322 ,@code
326 323 (break)))
327 324 ,@(if next-label
328 325 (list next-label)
329 326 nil))
330 327 `(progn
331 328 ,@code
332 329 ,@(if next-label
333 330 (list next-label)
334 331 nil))))))
335 332
336 333 (defpsmacro exit ()
337 334 '(return-from nil (values)))
338 335
339 336 ;;; 10dynamic
340 337
341 338 (defpsmacro qspblock (&body body)
342 339 `(locals-block
343 340 ,@body))
344 341
345 342 (defpsmacro qsp-lambda (&body body)
346 343 `(async-lambda (args)
347 344 (label-block ()
348 345 ,@body)))
349 346
350 347 ;;; 11main
351 348
352 349 (defpsmacro act (name img &body body)
353 350 `(api-call add-act ,name ,img
354 351 (locals-block
355 352 ,@body)))
356 353
357 354 ;;; 12aux
358 355
359 356 ;;; 13diag
360 357
361 358 ;;; 14act
362 359
363 360 ;;; 15objs
364 361
365 362 ;;; 16menu
366 363
367 364 ;;; 17sound
368 365
369 366 ;;; 18img
370 367
371 368 ;;; 19input
372 369
373 370 ;;; 20time
374 371
375 372 ;;; 21local
376 373
377 374 ;;; 22loop
378 375
379 376 (defpsmacro qsploop (init cond step &body body)
380 377 `(progn
381 378 ,init
382 379 (loop :while ,cond
383 380 :do (progn
384 381 ,@body
385 382 ,step))))
386 383
387 384 ;; Transform because it creates a (set ...) hence it has to be processed
388 385 ;; before the apply-vars transform. And macros are processed after all
389 386 ;; the transforms
390 387 (walker:deftransform for-transform qspfor (var from to step &rest body)
391 388 `(loop :for i :from ,from :to ,to :by ,step
392 389 :do (set ,var i)
393 390 :do (block nil
394 391 ,@(walker:walk-continue body))))
Show file before | Show file after | Hide comments
1 NO CONTENT: file was removed
General Comments 0
You need to be logged in to leave comments. Login now