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

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

txt->qsps, remove FOR and IMG, broken LOCAL and LOOP
naryl -
r60:517f9c14 default
parent child Browse files
Show More
Show file before | Show file after | Hide comments
This diff has been collapsed as it changes many lines, (1134 lines changed) Show them Hide them
@@ -0,0 +1,1134 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
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 };
191
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 } };
747
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
Show file before | Show file after | Hide comments
@@ -0,0 +1,3 b''
1 # loc
2 LCOLOR = rgb(106,90,205)
3 -
Show file before | Show file after | Hide comments
@@ -1,9 +1,10 b''
1 1 .*~
2 .*.txt
2 3 .qlot
3 4 .html
4 5 .png
5 6 .orig
6 7 tests
7 8 txt2web
8 txt2web.tar.xz
9 .*.tar.xz
9 10 system-index.txt
Show file before | Show file after | Hide comments
@@ -1,17 +1,14 b''
1 1
2 * Localization
3 2 * Save-load game in slots
4 3
5 * CLI build for Windows
6
7 4 * Reporting error lines in the parser
8 5 * Report duplicate label (in the parser)
9 6 * reporting error lines at runtime (by storing them in every form in the parser
10 7 * Report JUMP with missing label (in tagbody)
11 8 * Localizing parser errors...
12 9
13 10 * Build Istreblenie
14 11 * Build ЦвСтохимия
15 12
16 13 * Windows GUI (for the compiler)
17 14 * Resizable frames
Show file before | Show file after | Hide comments
1 NO CONTENT: file renamed from examples/10dynamic.txt to examples/10dynamic.qsps
Show file before | Show file after | Hide comments
1 NO CONTENT: file renamed from examples/11main.txt to examples/11main.qsps
Show file before | Show file after | Hide comments
1 NO CONTENT: file renamed from examples/12aux.txt to examples/12aux.qsps
Show file before | Show file after | Hide comments
1 NO CONTENT: file renamed from examples/13diag.txt to examples/13diag.qsps
Show file before | Show file after | Hide comments
1 NO CONTENT: file renamed from examples/14act.txt to examples/14act.qsps
Show file before | Show file after | Hide comments
1 NO CONTENT: file renamed from examples/15objs.txt to examples/15objs.qsps
Show file before | Show file after | Hide comments
1 NO CONTENT: file renamed from examples/16menu.txt to examples/16menu.qsps
Show file before | Show file after | Hide comments
1 NO CONTENT: file renamed from examples/17sound.txt to examples/17sound.qsps
Show file before | Show file after | Hide comments
@@ -1,26 +1,14 b''
1 1
2 2 # img
3 3 $BACKIMAGE = 'content/back.png'
4 4
5 5 VIEW 'content/monster.png'
6 6
7 7 ! Π’ΠΊΠ»ΡŽΡ‡Π°Π΅ΠΌ Ρ€Π΅ΠΆΠΈΠΌ HTML. Если Π²ΠΎ всСй ΠΈΠ³Ρ€Π΅ ΠΈΡΠΏΠΎΠ»ΡŒΠ·ΡƒΠ΅Ρ‚ΡΡ HTML,
8 8 ! Ρ‚ΠΎ достаточно Π²ΠΊΠ»ΡŽΡ‡ΠΈΡ‚ΡŒ Π΅Π³ΠΎ Π½Π° самой ΠΏΠ΅Ρ€Π²ΠΎΠΉ Π»ΠΎΠΊΠ°Ρ†ΠΈΠΈ.
9 9 USEHTML = 1
10 10 ! Π’Ρ‹Π²ΠΎΠ΄ΠΈΠΌ ΠΊΠ°Ρ€Ρ‚ΠΈΠ½ΠΊΡƒ Π² основноС описаниС
11 11 '<img src="content/room.jpg">'
12 12 ! Π’Ρ‹Π²ΠΎΠ΄ΠΈΠΌ ΠΊΠ°Ρ€Ρ‚ΠΈΠ½ΠΊΡƒ Π² Π΄ΠΎΠΏ. описаниС
13 13 PL '<img src="content/map.jpg">'
14
15 !! Π ΠΠ‘Π¨Π˜Π Π•ΠΠ˜Π• ΠšΠžΠœΠŸΠ˜Π›Π―Π’ΠžΠ Π (Π½Π΅ ΠΈΡΠΏΠΎΠ»ΡŒΠ·ΡƒΠΉΡ‚Π΅ Ссли Ρ…ΠΎΡ‚ΠΈΡ‚ΠΈΠ΅ пСрСносимости Π½Π° Π΄Ρ€ΡƒΠ³ΠΈΠ΅ ΠΏΠ»Π΅Π΅Ρ€Ρ‹)
16 ! Π’Ρ‹Π²ΠΎΠ΄ΠΈΠΌ ΠΊΠ°Ρ€Ρ‚ΠΈΠ½ΠΊΡƒ Π² основноС описаниС
17 *IMG 'content/room.jpg'
18 ! Π’Ρ‹Π²ΠΎΠ΄ΠΈΠΌ Π΄Π²Π΅ ΠΊΠ°Ρ€Ρ‚ΠΈΠ½ΠΊΠΈ рядом Π² Π΄ΠΎΠΏΠΎΠ»Π½ΠΈΡ‚Π΅Π»ΡŒΠ½ΠΎΠ΅ описаниС
19 IMG 'content/stat1.png'
20 IMG 'content/stat2.png'
21 ! Π’.Π΅. ΠΊΠ°Ρ€Ρ‚ΠΈΠ½ΠΊΠΈ Π²Π΅Π΄ΡƒΡ‚ сСбя ΠΊΠ°ΠΊ тСкст ΠΈ пСрСносы строк Π½ΡƒΠΆΠ½ΠΎ Π²ΡΡ‚Π°Π²Π»ΡΡ‚ΡŒ явно
22
23 ! НСсколько ΠΊΠ°Ρ€Ρ‚ΠΈΠ½ΠΎΠΊ Ρ€Π°ΡΠΏΠΎΠ»Π°Π³Π°ΡŽΡ‚ΡΡ Π² ΠΎΠ΄Π½ΠΎΠΌ ΠΈ Ρ‚ΠΎΠΌ ΠΆΠ΅ мСстС Π² порядкС пСрСчислСния.
24 ! Π˜ΡΠΏΠΎΠ»ΡŒΠ·ΡƒΡ ΠΏΡ€ΠΎΠ·Ρ€Π°Ρ‡Π½ΠΎΡΡ‚ΡŒ ΠΌΠΎΠΆΠ½ΠΎ ΠΏΠΎΠ»ΡƒΡ‡ΠΈΡ‚ΡŒ эффСкт налоТСния Π½Π΅ΡΠΊΠΎΠ»ΡŒΠΊΠΈΡ… ΠΊΠ°Ρ€Ρ‚ΠΈΠ½ΠΎΠΊ слоями
25 IMG 'content/ragdoll.png', $equipment['body'], $equipment['head']
26 14 -
Show file before | Show file after | Hide comments
1 NO CONTENT: file renamed from examples/19input.txt to examples/19input.qsps
Show file before | Show file after | Hide comments
1 NO CONTENT: file renamed from examples/1loc.txt to examples/1loc.qsps
Show file before | Show file after | Hide comments
1 NO CONTENT: file renamed from examples/20time.txt to examples/20time.qsps
Show file before | Show file after | Hide comments
1 NO CONTENT: file renamed from examples/21locals.txt to examples/21locals.qsps
Show file before | Show file after | Hide comments
@@ -1,18 +1,18 b''
1 1
2 2 # for
3 FOR k1=0 TO 5:
3 LOOP k1=0 WHILE k1 < 5:
4 4 *PL k1
5 5 IF k1=3: EXIT
6 6 END
7 7
8 FOR Π½ΠΎΠΌΠ΅Ρ€_Π½ΠΏΡ† = 1 TO количСство_Π½ΠΏΡ†: GS 'ΠΈΠ½ΠΈΡ†ΠΈΠ°Π»ΠΈΠ·ΠΈΡ€ΠΎΠ²Π°Ρ‚ΡŒ Π½ΠΏΡ†', Π½ΠΎΠΌΠ΅Ρ€_Π½ΠΏΡ†
8 LOOP Π½ΠΎΠΌΠ΅Ρ€_Π½ΠΏΡ† = 1 WHILE Π½ΠΎΠΌΠ΅Ρ€_Π½ΠΏΡ† < количСство_Π½ΠΏΡ†: GS 'ΠΈΠ½ΠΈΡ†ΠΈΠ°Π»ΠΈΠ·ΠΈΡ€ΠΎΠ²Π°Ρ‚ΡŒ Π½ΠΏΡ†', Π½ΠΎΠΌΠ΅Ρ€_Π½ΠΏΡ†
9 9
10 10 ΡΡ‚ΠΎΠΈΠΌΠΎΡΡ‚ΡŒ['ΠΌΠ΅Ρ‡'] = 10
11 11 ΡΡ‚ΠΎΠΈΠΌΠΎΡΡ‚ΡŒ['доспСх'] = 250
12 12 ΡΡ‚ΠΎΠΈΠΌΠΎΡΡ‚ΡŒ['Ρ‰ΠΈΡ‚'] = 15
13 13 ΡΡ‚ΠΎΠΈΠΌΠΎΡΡ‚ΡŒ_снаряТСния = 0
14 FOR Π½ΠΎΠΌΠ΅Ρ€_ΠΏΡ€Π΅Π΄ΠΌΠ΅Ρ‚Π° = 0 TO ARRSIZE('ΡΡ‚ΠΎΠΈΠΌΠΎΡΡ‚ΡŒ')-1: ΡΡ‚ΠΎΠΈΠΌΠΎΡΡ‚ΡŒ_снаряТСния += ΡΡ‚ΠΎΠΈΠΌΠΎΡΡ‚ΡŒ[Π½ΠΎΠΌΠ΅Ρ€_ΠΏΡ€Π΅Π΄ΠΌΠ΅Ρ‚Π°]
14 LOOP Π½ΠΎΠΌΠ΅Ρ€_ΠΏΡ€Π΅Π΄ΠΌΠ΅Ρ‚Π° = 0 WHILE Π½ΠΎΠΌΠ΅Ρ€_ΠΏΡ€Π΅Π΄ΠΌΠ΅Ρ‚Π° < ARRSIZE('ΡΡ‚ΠΎΠΈΠΌΠΎΡΡ‚ΡŒ'): ΡΡ‚ΠΎΠΈΠΌΠΎΡΡ‚ΡŒ_снаряТСния += ΡΡ‚ΠΎΠΈΠΌΠΎΡΡ‚ΡŒ[Π½ΠΎΠΌΠ΅Ρ€_ΠΏΡ€Π΅Π΄ΠΌΠ΅Ρ‚Π°]
15 15
16 FOR i = 1 TO 10 STEP 2: *PL i
16 LOOP i = 1 WHILE i < 10 STEP i += 2: *PL i
17 17
18 18 -
Show file before | Show file after | Hide comments
1 NO CONTENT: file renamed from examples/2var.txt to examples/2var.qsps
Show file before | Show file after | Hide comments
1 NO CONTENT: file renamed from examples/3expr.txt to examples/3expr.qsps
Show file before | Show file after | Hide comments
1 NO CONTENT: file renamed from examples/4code.txt to examples/4code.qsps
Show file before | Show file after | Hide comments
1 NO CONTENT: file renamed from examples/5arrays.txt to examples/5arrays.qsps
Show file before | Show file after | Hide comments
1 NO CONTENT: file renamed from examples/6str.txt to examples/6str.qsps
Show file before | Show file after | Hide comments
1 NO CONTENT: file renamed from examples/7if.txt to examples/7if.qsps
Show file before | Show file after | Hide comments
1 NO CONTENT: file renamed from examples/8sub.txt to examples/8sub.qsps
Show file before | Show file after | Hide comments
1 NO CONTENT: file renamed from examples/9999error.txt to examples/9999error.qsps
Show file before | Show file after | Hide comments
1 NO CONTENT: file renamed from examples/9loops.txt to examples/9loops.qsps
Show file before | Show file after | Hide comments
1 NO CONTENT: file renamed from examples/bench.txt to examples/bench.qsps
Show file before | Show file after | Hide comments
@@ -1,529 +1,510 b''
1 1
2 2 (in-package txt2web.api)
3 3
4 4 ;;; API deals with DOM manipulation and some bookkeeping for the
5 5 ;;; intrinsics, namely variables
6 6 ;;; API is an implementation detail and has no QSP documentation. It
7 7 ;;; doesn't call intrinsics
8 8
9 9 ;;; Utils
10 10
11 11 (defun make-act-html (title img)
12 12 (+ "<a class='qsp-act' href='" (href-call call-act title) "' onmouseover='" (inline-call select-act title) "'>"
13 13 (if img (+ "<img src='" img "'>") "")
14 14 title
15 15 "</a>"))
16 16
17 17 (defun make-menu-item-html (num title img loc)
18 18 (+ "<a href='" (href-call finish-menu loc) "'>"
19 19 (if img (+ "<img src='" img "'>") "")
20 20 title
21 21 "</a>"))
22 22
23 23 (defun make-obj (title img selected)
24 24 (+ "<li onclick='" (inline-call select-obj title img) "'>"
25 25 "<a class='qsp-obj" (if selected " qsp-obj-selected" "") "'>"
26 26 (if img (+ "<img src='" img "'>") "")
27 27 title
28 28 "</a>"))
29 29
30 30 (defun make-menu-delimiter ()
31 31 "<hr>")
32 32
33 33 (defun copy-obj (obj)
34 34 (chain *j-s-o-n (parse (chain *j-s-o-n (stringify obj)))))
35 35
36 36 (defun report-error (text)
37 37 (alert text))
38 38
39 39 (defun start-sleeping ()
40 40 (chain (by-id "qsp") class-list (add "disable")))
41 41
42 42 (defun finish-sleeping ()
43 43 (chain (by-id "qsp") class-list (remove "disable")))
44 44
45 45 (defun sleep (msec)
46 46 (with-sleep (resume)
47 47 (set-timeout resume msec)))
48 48
49 49 (defun init-dom ()
50 50 ;; Save/load buttons
51 51 (let ((btn (by-id "qsp-btn-save")))
52 52 (setf (@ btn onclick) savegame)
53 53 (setf (@ btn href) "#"))
54 54 (let ((btn (by-id "qsp-btn-open")))
55 55 (setf (@ btn onclick) opengame)
56 56 (setf (@ btn href) "#"))
57 57 ;; Close image on click
58 58 (setf (@ (by-id "qsp-image-container") onclick)
59 59 show-image)
60 60 ;; Enter in input field
61 61 (setf (@ (get-frame :input) onkeyup)
62 62 on-input-key)
63 63 ;; Close the dropdown on any click
64 64 (setf (@ window onclick)
65 65 (lambda (event)
66 66 (setf (@ window mouse)
67 67 (list (@ event page-x)
68 68 (@ event page-y)))
69 69 (finish-menu nil))))
70 70
71 71 (defun call-serv-loc (var-name &rest args)
72 72 (let ((loc-name (get-global var-name 0)))
73 73 (when loc-name
74 74 (let ((loc (getprop *locs loc-name)))
75 75 (when loc
76 76 (call-loc loc-name args))))))
77 77
78 78 (defun filename-game (filename)
79 79 (let ((game-name (chain filename (match "(.*/)?([^.]+)(\\.[a-zA-Z]+)?") 2))))
80 80 (getprop *games game-name))
81 81
82 82 (defun run-game (name)
83 83 (let ((game (filename-game name)))
84 84 (setf *main-game name)
85 85 ;; Replace locations with the new game's
86 86 (setf *locs game)
87 87 (funcall (getprop game
88 88 (chain *object (keys game) 0))
89 89 (list))))
90 90
91 91 ;;; Misc
92 92
93 93 (defun newline (key)
94 94 (append-id (key-to-id key) "<br>" t))
95 95
96 96 (defun clear-id (id)
97 97 (setf (inner-html (by-id id)) ""))
98 98
99 99 (defun escape-html (text)
100 100 (chain text
101 101 (replace (regex "/&/g") "&amp;")
102 102 (replace (regex "/</g") "&lt;")
103 103 (replace (regex "/>/g") "&gt;")
104 104 (replace (regex "/\"/g") "&quot;")
105 105 (replace (regex "/'/g") "&apos;")))
106 106
107 107 (defun prepare-contents (s &optional force-html)
108 108 (setf s (chain s (to-string)))
109 109 (if (or force-html (get-global "USEHTML" 0))
110 110 s
111 111 (escape-html s)))
112 112
113 113 (defun get-id (id &optional force-html)
114 114 (inner-html (by-id id)))
115 115
116 116 (defun set-id (id contents &optional force-html)
117 117 (setf (inner-html (by-id id)) (prepare-contents contents force-html)))
118 118
119 119 (defun append-id (id contents &optional force-html)
120 120 (when contents
121 121 (incf (inner-html (by-id id)) (prepare-contents contents force-html))))
122 122
123 123 (defun on-input-key (ev)
124 124 (when (= 13 (@ ev key-code))
125 125 (chain ev (prevent-default))
126 126 (call-serv-loc "$USERCOM")))
127 127
128 128 ;;; Function calls
129 129
130 130 (defun init-args (args)
131 131 (dotimes (i (length args))
132 132 (let ((arg (elt args i)))
133 133 (if (numberp arg)
134 134 (set-var args i :num arg)
135 135 (set-var args i :str arg)))))
136 136
137 137 (defun get-result ()
138 138 (or (get-global "$RESULT" 0)
139 139 (get-global "RESULT" 0)))
140 140
141 141 (defun call-loc (name args)
142 142 (setf name (chain name (to-upper-case)))
143 143 (with-frame
144 144 (with-call-args args
145 145 (funcall (getprop *locs name))))
146 146 (void))
147 147
148 148 (defun call-act (title)
149 149 (with-frame
150 150 (funcall (getprop *acts title :act)))
151 151 (void))
152 152
153 153 ;;; Text windows
154 154
155 155 (defun key-to-id (key)
156 156 (case key
157 157 (:all "qsp")
158 158 (:main "qsp-main")
159 159 (:stat "qsp-stat")
160 160 (:objs "qsp-objs")
161 161 (:acts "qsp-acts")
162 162 (:input "qsp-input")
163 163 (:image "qsp-image")
164 164 (:dropdown "qsp-dropdown")
165 165 (t (report-error "Internal error!"))))
166 166
167 167 (defun get-frame (key)
168 168 (by-id (key-to-id key)))
169 169
170 170 (defun add-text (key text)
171 171 (append-id (key-to-id key) text))
172 172
173 173 (defun get-text (key)
174 174 (get-id (key-to-id key)))
175 175
176 176 (defun clear-text (key)
177 177 (clear-id (key-to-id key)))
178 178
179 179 (defun enable-frame (key enable)
180 180 (let ((obj (get-frame key)))
181 181 (setf (@ obj style display) (if enable "block" "none"))
182 182 (void)))
183 183
184 184 ;;; Actions
185 185
186 186 (defun add-act (title img act)
187 187 (setf (getprop *acts title)
188 188 (create :title title :img img :act act :selected nil))
189 189 (update-acts))
190 190
191 191 (defun del-act (title)
192 192 (delete (getprop *acts title))
193 193 (update-acts))
194 194
195 195 (defun clear-act ()
196 196 (setf *acts (create))
197 197 (update-acts))
198 198
199 199 (defun update-acts ()
200 200 (clear-id "qsp-acts")
201 201 (let ((elt (by-id "qsp-acts")))
202 202 (for-in (title *acts)
203 203 (let ((obj (getprop *acts title)))
204 204 (incf (inner-html elt) (make-act-html title (getprop obj :img)))))))
205 205
206 206 (defun select-act (title)
207 207 (loop :for (k v) :of *acts
208 208 :do (setf (getprop v :selected) nil))
209 209 (setf (getprop *acts title :selected) t)
210 210 (call-serv-loc "$ONACTSEL"))
211 211
212 ;;; "Syntax"
213
214 (defun qspfor (name index from to step body)
215 (loop :for i :from from :to to :by step
216 :do (set-var name index :num i)
217 :do (unless (await (funcall body))
218 (return-from qspfor))))
219
220 212 ;;; Variables
221 213
222 214 (defun new-var (slot &rest indexes)
223 215 (let ((v (list)))
224 216 (dolist (index indexes)
225 217 (setf (elt v index) (if (eq #\$ (elt slot 0)) "" 0)))
226 218 (setf (@ v :indexes) (create))
227 219 v))
228 220
229 221 (defun set-str-element (slot index value)
230 222 (if (has index (getprop slot :indexes))
231 223 (setf (elt (getprop slot)
232 224 (getprop slot :indexes index))
233 225 value)
234 226 (progn
235 227 (chain slot (push value))
236 228 (setf (elt slot index)
237 229 (length slot))))
238 230 (void))
239 231
240 232 (defun set-any-element (slot index value)
241 233 (cond ((null index)
242 234 (chain (elt slot) (push value)))
243 235 ((numberp index)
244 236 (setf (elt slot index) value))
245 237 ((stringp index)
246 238 (set-str-element slot index value))
247 239 (t (report-error "INTERNAL ERROR")))
248 240 (void))
249 241
250 242 (defun set-serv-var (name index value)
251 243 (let ((slot (getprop *globals name)))
252 244 (set-any-element slot index value))
253 245 (funcall (getprop serv-vars name :body) value index)
254 246 (void))
255 247
256 248 (defun get-element (slot index)
257 249 (if (numberp index)
258 250 (elt slot index)
259 251 (elt slot (getprop slot :indexes index))))
260 252
261 253 (defun get-global (name index)
262 254 (elt (getprop *globals name) index))
263 255
264 256 (defun kill-var (store name &optional index)
265 257 (setf name (chain name (to-upper-case)))
266 258 (if (and index (not (= 0 index)))
267 259 (chain (getprop *globals name) (kill index))
268 260 (delete (getprop *globals name)))
269 261 (void))
270 262
271 263 (defun array-size (name)
272 264 (@ (var-ref name) :values length))
273 265
274 266 ;;; Locals
275 267
276 268 (defun push-local-frame ()
277 269 (chain *locals (push (create)))
278 270 (void))
279 271
280 272 (defun pop-local-frame ()
281 273 (chain *locals (pop))
282 274 (void))
283 275
284 276 (defun current-local-frame ()
285 277 (elt *locals (1- (length *locals))))
286 278
287 279 ;;; Objects
288 280
289 281 (defun select-obj (title img)
290 282 (loop :for (k v) :of *objs
291 283 :do (setf (getprop v :selected) nil))
292 284 (setf (getprop *objs title :selected) t)
293 285 (call-serv-loc "$ONOBJSEL" title img))
294 286
295 287 (defun update-objs ()
296 288 (let ((elt (by-id "qsp-objs")))
297 289 (setf (inner-html elt) "<ul>")
298 290 (loop :for (name obj) :of *objs
299 291 :do (incf (inner-html elt)
300 292 (make-obj name (@ obj :img) (@ obj :selected))))
301 293 (incf (inner-html elt) "</ul>")))
302 294
303 295 ;;; Menu
304 296
305 297 (defun open-menu (menu-data)
306 298 (let ((elt (get-frame :dropdown))
307 299 (i 0))
308 300 (loop :for item :in menu-data
309 301 :do (incf i)
310 302 :do (incf (inner-html elt)
311 303 (if (eq item :delimiter)
312 304 (make-menu-delimiter i)
313 305 (make-menu-item-html i
314 306 (@ item :text)
315 307 (@ item :icon)
316 308 (@ item :loc)))))
317 309 (let ((mouse (@ window mouse)))
318 310 (setf (@ elt style left) (+ (elt mouse 0) "px"))
319 311 (setf (@ elt style top) (+ (elt mouse 1) "px"))
320 312 ;; Make sure it's inside the viewport
321 313 (when (> (@ document body inner-width)
322 314 (+ (elt mouse 0) (@ elt inner-width)))
323 315 (incf (@ elt style left) (@ elt inner-width)))
324 316 (when (> (@ document body inner-height)
325 317 (+ (elt mouse 0) (@ elt inner-height)))
326 318 (incf (@ elt style top) (@ elt inner-height))))
327 319 (setf (@ elt style display) "block")))
328 320
329 321 (defun finish-menu (loc)
330 322 (when *menu-resume
331 323 (let ((elt (get-frame :dropdown)))
332 324 (setf (inner-html elt) "")
333 325 (setf (@ elt style display) "none")
334 326 (funcall *menu-resume)
335 327 (setf *menu-resume nil))
336 328 (when loc
337 329 (call-loc loc)))
338 330 (void))
339 331
340 332 (defun menu (menu-data)
341 333 (with-sleep (resume)
342 334 (open-menu menu-data)
343 335 (setf *menu-resume resume))
344 336 (void))
345 337
346 338 ;;; Content
347 339
348 340 (defun clean-audio ()
349 341 (loop :for k :in (chain *object (keys *playing))
350 342 :for v := (getprop *playing k)
351 343 :do (when (@ v ended)
352 344 (delete (@ *playing k)))))
353 345
354 346 (defun show-image (path)
355 347 (let ((img (get-frame :image)))
356 348 (cond (path
357 349 (setf (@ img src) path)
358 350 (setf (@ img style display) "flex"))
359 351 (t
360 352 (setf (@ img src) "")
361 353 (setf (@ img style display) "hidden")))))
362 354
363 (defun show-inline-images (frame-name images)
364 (let ((frame (get-frame frame-name))
365 (text ""))
366 (incf text "<div style='position:relative; display: inline-block'>")
367 (incf text (+ "<img src='" (@ images 0) "'>"))
368 (loop :for image :in (chain images (slice 1))
369 :do (incf text
370 (+ "<img style='position:absolute' src='" image "'>")))
371 (incf text "</div>")
372 (incf (inner-html frame) text)))
373
374 355 (defun rgb-string (rgb)
375 356 (let ((red (ps::>> rgb 16))
376 357 (green (logand (ps::>> rgb 8) 255))
377 358 (blue (logand rgb 255)))
378 359 (flet ((rgb-to-hex (comp)
379 360 (let ((hex (chain (*number comp) (to-string 16))))
380 361 (if (< (length hex) 2)
381 362 (+ "0" hex)
382 363 hex))))
383 364 (+ "#" (rgb-to-hex red) (rgb-to-hex green) (rgb-to-hex blue)))))
384 365
385 366 (defun store-obj (key obj)
386 367 (store-str key (btoa (encode-u-r-i-component (chain *j-s-o-n (stringify obj)))))
387 368 (void))
388 369 (defun store-str (key str)
389 370 (chain local-storage (set-item (+ "qsp_" key) str))
390 371 (void))
391 372
392 373 (defun load-obj (key)
393 374 (chain *j-s-o-n (parse (encode-u-r-i-component (atob (load-str key))))))
394 375 (defun load-str (key)
395 376 (chain local-storage (get-item (+ "qsp_" key))))
396 377
397 378 ;;; Saves
398 379
399 380 (defun slot-savegame (slot comment)
400 381 (let ((saves (load-obj "saves")))
401 382 (setf (@ saves slot) comment)
402 383 (store-obj saves))
403 384 (store-str slot (state-to-base64))
404 385 (void))
405 386
406 387 (defun slot-loadgame (slot)
407 388 (base64-to-state (load-str slot))
408 389 (void))
409 390
410 391 (defun slot-deletegame (slot)
411 392 (let ((saves (load-obj "saves")))
412 393 (setf (@ saves slot) undefined)
413 394 (store-obj saves))
414 395 (store-str slot undefined)
415 396 (void))
416 397
417 398 (defun slot-listgames ()
418 399 (load-obj "saves"))
419 400
420 401 (defun opengame ()
421 402 (let ((element (chain document (create-element :input))))
422 403 (chain element (set-attribute :type :file))
423 404 (chain element (set-attribute :id :qsp-opengame))
424 405 (chain element (set-attribute :tabindex -1))
425 406 (chain element (set-attribute "aria-hidden" t))
426 407 (setf (@ element style display) :block)
427 408 (setf (@ element style visibility) :hidden)
428 409 (setf (@ element style position) :fixed)
429 410 (setf (@ element onchange)
430 411 (lambda (event)
431 412 (let* ((file (@ event target files 0))
432 413 (reader (new (*file-reader))))
433 414 (setf (@ reader onload)
434 415 (lambda (ev)
435 416 (block nil
436 417 (let ((target (@ ev current-target)))
437 418 (unless (@ target result)
438 419 (return))
439 420 (base64-to-state (@ target result))
440 421 (unstash-state)))))
441 422 (chain reader (read-as-text file)))))
442 423 (chain document body (append-child element))
443 424 (chain element (click))
444 425 (chain document body (remove-child element))))
445 426
446 427 (defun savegame ()
447 428 (let ((element (chain document (create-element :a))))
448 429 (chain element (set-attribute :href (+ "data:text/plain;charset=utf-8," (state-to-base64))))
449 430 (chain element (set-attribute :download "savegame.sav"))
450 431 (setf (@ element style display) :none)
451 432 (chain document body (append-child element))
452 433 (chain element (click))
453 434 (chain document body (remove-child element))))
454 435
455 436 (defun stash-state (args)
456 437 (call-serv-loc "$ONGSAVE")
457 438 (setf *state-stash
458 439 (chain *j-s-o-n (stringify
459 440 (create :vars *globals
460 441 :objs *objs
461 442 :loc-args args
462 443 :msecs (- (chain *date (now)) *started-at)
463 444 :timer-interval *timer-interval
464 445 :main-html (inner-html
465 446 (get-frame :main))
466 447 :stat-html (inner-html
467 448 (get-frame :stat))
468 449 :next-location *current-location))))
469 450 (void))
470 451
471 452 (defun unstash-state ()
472 453 (let ((data (chain *j-s-o-n (parse *state-stash))))
473 454 (clear-act)
474 455 (setf *globals (@ data :vars))
475 456 (loop :for k :in (chain *object (keys *globals))
476 457 :do (chain *object (set-prototype-of (getprop *globals k)
477 458 (@ *var prototype))))
478 459 (setf *started-at (- (chain *date (now)) (@ data :msecs)))
479 460 (setf *objs (@ data :objs))
480 461 (setf *current-location (@ data :next-location))
481 462 (setf (inner-html (get-frame :main))
482 463 (@ data :main-html))
483 464 (setf (inner-html (get-frame :stat))
484 465 (@ data :stat-html))
485 466 (update-objs)
486 467 (set-timer (@ data :timer-interval))
487 468 (call-serv-loc "$ONGLOAD")
488 469 (call-loc *current-location (@ data :loc-args))
489 470 (void)))
490 471
491 472 (defun state-to-base64 ()
492 473 (btoa (encode-u-r-i-component *state-stash)))
493 474
494 475 (defun base64-to-state (data)
495 476 (setf *state-stash (decode-u-r-i-component (atob data))))
496 477
497 478 ;;; Timers
498 479
499 480 (defun set-timer (interval)
500 481 (setf *timer-interval interval)
501 482 (clear-interval *timer-obj)
502 483 (setf *timer-obj
503 484 (set-interval
504 485 (lambda ()
505 486 (call-serv-loc "$COUNTER"))
506 487 interval)))
507 488
508 489 ;;; Special variables
509 490
510 491 (defvar serv-vars (create))
511 492
512 493 (define-serv-var $backimage (path)
513 494 (setf (@ (get-frame :main) style background-image) path))
514 495
515 496 (define-serv-var bcolor (color)
516 497 (setf (@ (get-frame :all) style background-color) (rgb-string color)))
517 498
518 499 (define-serv-var fcolor (color)
519 500 (setf (@ (get-frame :all) style color) (rgb-string color)))
520 501
521 502 (define-serv-var lcolor (color)
522 503 (setf (@ (get-frame :style) inner-text)
523 504 (+ "a { color: " (rgb-string color) ";}")))
524 505
525 506 (define-serv-var fsize (size)
526 507 (setf (@ (get-frame :all) style font-size) size))
527 508
528 509 (define-serv-var $fname (font-name)
529 510 (setf (@ (get-frame :all) style font-family) (+ font-name ",serif")))
Show file before | Show file after | Hide comments
@@ -1,170 +1,164 b''
1 1
2 2 (in-package txt2web.lib)
3 3
4 4 ;;;; Macros implementing some intrinsics where it makes sense
5 5 ;;;; E.g. an equivalent JS function exists, or it's a direct API call
6 6
7 7 ;;; 1loc
8 8
9 9 ;;; 2var
10 10
11 11 (defpsmacro killvar (varname &optional index)
12 12 `(api-call kill-var ,varname ,index))
13 13
14 14 (defpsmacro killall ()
15 15 `(api-call kill-all))
16 16
17 17 ;;; 3expr
18 18
19 19 (defpsmacro no (arg)
20 20 `(- -1 ,arg))
21 21
22 22 ;;; 4code
23 23
24 24 (defpsmacro qspver ()
25 25 "0.0.1")
26 26
27 27 (defpsmacro curloc ()
28 28 `*current-location)
29 29
30 30 (defpsmacro rnd ()
31 31 `(funcall rand 1 1000))
32 32
33 33 (defpsmacro qspmax (&rest args)
34 34 (if (= 1 (length args))
35 35 `(*math.max.apply nil ,@args)
36 36 `(*math.max ,@args)))
37 37
38 38 (defpsmacro qspmin (&rest args)
39 39 (if (= 1 (length args))
40 40 `(*math.min.apply nil ,@args)
41 41 `(*math.min ,@args)))
42 42
43 43 ;;; 5arrays
44 44
45 45 (defpsmacro arrsize (name)
46 46 `(api-call array-size ,name))
47 47
48 48 ;;; 6str
49 49
50 50 (defpsmacro len (s)
51 51 `(length ,s))
52 52
53 53 (defpsmacro mid (s from &optional count)
54 54 `(chain ,s (substring ,from ,count)))
55 55
56 56 (defpsmacro ucase (s)
57 57 `(chain ,s (to-upper-case)))
58 58
59 59 (defpsmacro lcase (s)
60 60 `(chain ,s (to-lower-case)))
61 61
62 62 (defpsmacro trim (s)
63 63 `(chain ,s (trim)))
64 64
65 65 (defpsmacro qspreplace (s from to)
66 66 `(chain ,s (replace ,from ,to)))
67 67
68 68 (defpsmacro val (s)
69 69 `(parse-int ,s 10))
70 70
71 71 (defpsmacro qspstr (n)
72 72 `(chain ,n (to-string)))
73 73
74 74 ;;; 7if
75 75
76 76 ;;; 8sub
77 77
78 78 ;;; 9loops
79 79
80 80 ;; JUMP is in ps-macros.lisp (because it's a part of a huge kludge)
81 81
82 82 (defpsmacro exit ()
83 83 `(return-from nil (values)))
84 84
85 85 ;;; 10dynamic
86 86
87 87 ;;; 11main
88 88
89 89 (defpsmacro desc (s)
90 90 (declare (ignore s))
91 91 "")
92 92
93 93 ;;; 12stat
94 94
95 95 (defpsmacro showstat (enable)
96 96 `(api-call enable-frame :stat ,enable))
97 97
98 98 ;;; 13diag
99 99
100 100 (defpsmacro msg (text)
101 101 `(alert ,text))
102 102
103 103 ;;; 14act
104 104
105 105 (defpsmacro showacts (enable)
106 106 `(api-call enable-frame :acts ,enable))
107 107
108 108 (defpsmacro delact (&optional name)
109 109 (if name
110 110 `(api-call del-act ,name)
111 111 `(api-call del-act)))
112 112
113 113 (defpsmacro cla ()
114 114 `(api-call clear-act))
115 115
116 116 ;;; 15objs
117 117
118 118 (defpsmacro showobjs (enable)
119 119 `(api-call enable-frame :objs ,enable))
120 120
121 121 (defpsmacro countobj ()
122 122 `(length *objs))
123 123
124 124 (defpsmacro getobj (index)
125 125 `(or (elt *objs ,index) ""))
126 126
127 127 ;;; 16menu
128 128
129 129 ;;; 17sound
130 130
131 131 (defpsmacro isplay (filename)
132 132 `(funcall (@ playing includes) ,filename))
133 133
134 134 ;;; 18img
135 135
136 136 (defpsmacro view (&optional path)
137 137 `(api-call show-image ,path))
138 138
139 (defpsmacro img (&rest images)
140 `(api-call show-inline-images :stat (list ,@images)))
141
142 (defpsmacro *img (&rest images)
143 `(api-call show-inline-images :main (list ,@images)))
144
145 139 ;;; 19input
146 140
147 141 (defpsmacro showinput (enable)
148 142 `(api-call enable-frame :input ,enable))
149 143
150 144 ;;; 20time
151 145
152 146 (defpsmacro wait (msec)
153 147 `(await (api-call sleep ,msec)))
154 148
155 149 (defpsmacro settimer (interval)
156 150 `(api-call set-timer ,interval))
157 151
158 152 ;;; 21local
159 153
160 154 ;;; 22for
161 155
162 156 ;;; misc
163 157
164 158 (defpsmacro opengame (&optional filename)
165 159 (declare (ignore filename))
166 160 `(api-call opengame))
167 161
168 162 (defpsmacro savegame (&optional filename)
169 163 (declare (ignore filename))
170 164 `(api-call savegame))
Show file before | Show file after | Hide comments
@@ -1,157 +1,158 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 14 (write-compiled-file compiler))))
15 15 (values))
16 16
17 17 (defun parse-opts (args)
18 18 (let ((mode :sources)
19 19 (data (list :sources nil :target nil :js nil :css nil :body nil :compile nil :beautify nil)))
20 20 (loop :for arg :in args
21 21 :do (alexandria:switch (arg :test #'string=)
22 22 ("-o" (setf mode :target))
23 23 ("--js" (setf mode :js))
24 24 ("--css" (setf mode :css))
25 25 ("--body" (setf mode :body))
26 26 ("-c" (setf (getf data :compile) t))
27 27 ("--beautify" (setf (getf data :beautify) t))
28 28 (t (push arg (getf data mode)))))
29 29 (unless (< 0 (length (getf data :sources)))
30 30 (report-error "There should be at least one source"))
31 31 (unless (> 1 (length (getf data :target)))
32 32 (report-error "There should be no more than one target"))
33 33 (unless (> 1 (length (getf data :body)))
34 34 (report-error "There should be no more than one body"))
35 35 (unless (getf data :target)
36 36 (setf (getf data :target)
37 37 (let* ((sources (first (getf data :sources)))
38 38 (tokens (uiop:split-string sources :separator "."))
39 39 (target (format nil "~{~A~^.~}.html"
40 40 (butlast tokens))))
41 41 (list target))))
42 42 (list :sources (getf data :sources)
43 43 :target (first (getf data :target))
44 44 :js (getf data :js)
45 45 :css (getf data :css)
46 46 :body (first (getf data :body))
47 47 :compile (getf data :compile)
48 48 :beautify (getf data :beautify))))
49 49
50 50 (defun print-usage ()
51 51 (lformat t :usage *app-name*))
52 52
53 53 (defun parse-file (filename)
54 54 (handler-case
55 55 (p:parse 'txt2web-grammar
56 56 (alexandria:read-file-into-string filename :external-format :utf-8))
57 57 (p:esrap-parse-error (e)
58 58 (format t "~A~%" e)
59 59 (throw :terminate nil))))
60 60
61 61 (defun report-error (fmt &rest args)
62 62 (format t "ERROR: ~A~%" (apply #'format nil fmt args))
63 63 (print-usage)
64 64 (throw :terminate nil))
65 65
66 66 ;;; JS
67 67
68 68 (defun minify-package (package-designator minify prefix)
69 69 (setf (ps:ps-package-prefix package-designator) prefix)
70 70 (if minify
71 71 (ps:obfuscate-package package-designator)
72 72 (ps:unobfuscate-package package-designator)))
73 73
74 74 (defmethod js-sources ((compiler compiler))
75 75 (let ((ps:*ps-print-pretty* (beautify compiler)))
76 76 (cond ((beautify compiler)
77 77 (minify-package "TXT2WEB.MAIN" nil "qsp_")
78 78 (minify-package "TXT2WEB.API" nil "qsp_api_")
79 79 (minify-package "TXT2WEB.LIB" nil "qsp_lib_"))
80 80 (t
81 81 (minify-package "TXT2WEB.MAIN" t "_")
82 82 (minify-package "TXT2WEB.API" t "a_")
83 83 (minify-package "TXT2WEB.LIB" t "l_")))
84 84 (format nil "~{~A~^~%~%~}" (mapcar #'ps:ps* (reverse (js compiler))))))
85 85
86 86 ;;; CSS
87 87
88 88 (defmethod css-sources ((compiler compiler))
89 89 (format nil "~{~A~^~%~%~}" (css compiler)))
90 90
91 91 ;;; HTML
92 92
93 93 (defmethod html-sources ((compiler compiler))
94 94 (let ((flute:*escape-html* nil)
95 95 (body-template (body compiler))
96 96 (js (js-sources compiler))
97 97 (css (css-sources compiler)))
98 98 (with-output-to-string (out)
99 99 (write
100 100 (flute:h
101 101 (html
102 102 (head
103 (meta :charset "utf-8")
103 104 (title "txt2web"))
104 105 (body
105 106 body-template
106 107 (style css)
107 108 (script js))))
108 109 :stream out
109 110 :pretty nil))))
110 111
111 112 (defun filename-game (filename)
112 113 (let ((filename (alexandria:lastcar (uiop:split-string filename :separator "/"))))
113 114 (format nil "~{~A~^.~}" (butlast (uiop:split-string filename :separator ".")))))
114 115
115 116 (defmethod initialize-instance ((compiler compiler) &key sources ((:js js-files)) ((:css css-files)) ((:body body-file)) compile &allow-other-keys)
116 117 (call-next-method)
117 118 (with-slots (body css js)
118 119 compiler
119 120 ;; Compile the game's JS
120 121 (dolist (source sources)
121 122 (let ((ps (parse-file source))
122 123 (game-name (filename-game source)))
123 124 (destructuring-bind (kw &rest locations)
124 125 ps
125 126 (unless (eq kw 'lib:game)
126 127 (report-error "Internal error!"))
127 128 (push
128 129 `(lib:game (,game-name) ,@locations)
129 130 js))))
130 131 ;; Does the user need us to do anything else
131 132 (unless compile
132 133 ;; Read in body
133 134 (when body-file
134 135 (setf body
135 136 (alexandria:read-file-into-string body-file :external-format :utf-8)))
136 137 ;; Include js files
137 138 (dolist (js-file js-files)
138 139 (push (format nil "////// Included file ~A~%~A" js-file
139 140 (alexandria:read-file-into-string js-file :external-format :utf-8))
140 141 js))
141 142 ;; Include css files
142 143 (when css-files
143 144 ;; User option overrides the default css
144 145 (setf css nil)
145 146 (dolist (css-file css-files)
146 147 (push (format nil "////// Included file ~A~%~A" css-file
147 148 (alexandria:read-file-into-string css-file :external-format :utf-8))
148 149 css))))))
149 150
150 151 (defmethod write-compiled-file ((compiler compiler))
151 152 (alexandria:write-string-into-file
152 153 (if (compile-only compiler)
153 154 ;; Just the JS
154 155 (js-sources compiler)
155 156 ;; All of it
156 157 (html-sources compiler))
157 158 (target compiler) :if-exists :supersede))
Show file before | Show file after | Hide comments
@@ -1,108 +1,108 b''
1 1
2 2 (in-package cl-user)
3 3
4 4 (defpackage :txt2web.js)
5 5
6 6 (defpackage :txt2web.main
7 7 (:use :cl :ps :txt2web.js)
8 8 (:export #:api-call #:by-id
9 9 #:has
10 10
11 11 #:*globals #:*objs #:*current-location
12 12 #:*started-at #:*timer-interval #:*timer-obj #:*loaded-games
13 13
14 14 #:*acts #:*state-stash #:*playing #:*locals
15 15
16 16 #:*games #:*main-game #:*locs #:*menu-resume
17 17 ))
18 18
19 19 (defpackage :code-walker
20 20 (:use :cl)
21 21 (:export #:deftransform
22 22 #:deftransform-stop
23 23 #:walk
24 24 #:whole
25 25 #:walk-continue))
26 26
27 27 ;;; API functions
28 28 (defpackage :txt2web.api
29 29 (:use :cl :ps :txt2web.main :txt2web.js)
30 30 (:export #:with-frame #:with-call-args
31 31 #:stash-state
32 32
33 33 #:report-error #:sleep #:init-dom #:call-serv-loc #:*serv-vars*
34 34 #:newline #:clear-id #:prepare-contents #:get-id #:set-id #:append-id
35 35 #:init-args #:get-result #:call-loc #:call-act
36 36 #:get-frame #:add-text #:get-text #:clear-text #:enable-frame
37 37 #:add-act #:del-act #:clear-act #:update-acts
38 38 #:set-str-element #:set-any-element #:set-serv-var
39 39 #:*var #:new-value #:index-num #:get #:set #:kill
40 40 #:var-real-name #:ensure-var #:var-ref #:get-var #:set-var
41 41 #:get-array #:set-array #:kill-var #:array-size
42 42 #:push-local-frame #:pop-local-frame #:current-local-frame #:new-local
43 43 #:update-objs
44 44 #:menu
45 45 #:clean-audio
46 46 #:show-image
47 47 #:opengame #:savegame
48 48 ))
49 49
50 50 ;;; QSP library functions and macros
51 51 (defpackage :txt2web.lib
52 52 (:use :cl :ps :txt2web.main :txt2web.js)
53 53 (:local-nicknames (#:api :txt2web.api)
54 54 (#:walker :code-walker))
55 (:export #:str #:exec #:qspblock #:qspfor #:game #:location
55 (:export #:str #:exec #:qspblock #:qsploop #:game #:location
56 56 #:qspcond #:qspvar #:set #:local #:jump
57 57
58 58 #:killvar #:killall
59 59 #:obj #:loc #:no
60 60 #:qspver #:curloc
61 61 #:rnd #:qspmax #:qspmin
62 62 #:arrsize #:len
63 63 #:mid #:ucase #:lcase #:trim #:replace #:val #:qspstr
64 64 #:exit #:desc
65 65 #:showstat #:msg
66 66 #:showacts #:delact #:cla
67 67 #:showobjs #:countobj #:getobj
68 68 #:isplay
69 69 #:view
70 70 #:showinput
71 71 #:wait #:settimer
72 72 #:local
73 73 #:opengame #:savegame
74 74
75 75 #:goto #:xgoto
76 76 #:rand
77 77 #:copyarr #:arrpos #:arrcomp
78 78 #:instr #:isnum #:strcomp #:strfind #:strpos
79 79 #:iif
80 80 #:gosub #:func
81 81 #:dynamic #:dyneval
82 82 #:main-p #:main-pl #:main-nl #:maintxt #:desc #:main-clear
83 83 #:stat-p #:stat-pl #:stat-nl #:stattxt #:stat-clear #:cls
84 84 #:curacts
85 85 #:addobj #:delobj #:killobj
86 86 #:menu
87 87 #:play #:close #:closeall
88 88 #:refint
89 89 #:usertxt #:cmdclear #:input
90 90 #:msecscount
91 91 #:rgb
92 92 #:openqst #:addqst #:killqst
93 93 ))
94 94
95 95 (setf (ps:ps-package-prefix "TXT2WEB.MAIN") "qsp_")
96 96 (setf (ps:ps-package-prefix "TXT2WEB.API") "qsp_api_")
97 97 (setf (ps:ps-package-prefix "TXT2WEB.LIB") "qsp_lib_")
98 98
99 99 ;;; The compiler
100 100 (defpackage :txt2web
101 101 (:use :cl)
102 102 (:local-nicknames (#:p #:esrap)
103 103 (#:lib :txt2web.lib)
104 104 (#:api :txt2web.api)
105 105 (#:main :txt2web.main)
106 106 (#:walker :code-walker))
107 107 (:export #:parse-file #:entry-point))
108 108
Show file before | Show file after | Hide comments
@@ -1,660 +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 for 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 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 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))
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 (p:defrule block (or block-act block-if block-for))
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 (p:defrule block-for (and block-for-head (or block-ml block-sl))
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 (p:defrule block-for-head (and (p:~ "for") spaces variable spaces? equal spaces? expression
387 (p:~ "to") spaces expression
388 block-for-head-step
386 (p:defrule block-loop-head (and (p:~ "loop") spaces
387 (p:? (and block-loop-head-init spaces?))
388 block-loop-head-while spaces?
389 (p:? (and block-loop-head-step spaces?))
389 390 colon spaces?)
390 391 (:lambda (list)
391 (list 'lib:qspfor
392 (break "~S" list)
393 (list 'lib:qsploop
392 394 (elt list 2)
393 395 (elt list 6)
394 396 (elt list 9)
395 397 (elt list 10))))
396 398
397 (p:defrule block-for-head-step (p:? (and (p:~ "step") spaces expression spaces?))
398 (:lambda (list)
399 (if list
400 (third list)
401 1)))
399 (p:defrule block-loop-head-init (or local plain-assignment))
400
401 (p:defrule block-loop-head-while (and (p:~ "while") eq-expr)
402 (:function second))
403
404 (p:defrule block-loop-head-step (and (p:~ "step") (or plain-assignment op-assignment))
405 (:function second))
402 406
403 407 (p:defrule block-sl line-body)
404 408
405 409 (p:defrule block-ml (and newline-block-body block-end)
406 410 (:lambda (list)
407 411 (apply #'list* (butlast list))))
408 412
409 413 (p:defrule block-end (and (p:~ "end"))
410 414 (:constant nil))
411 415
412 416 ;;; Calls
413 417
414 418 (p:defrule first-argument (and expression spaces?)
415 419 (:function first))
416 420 (p:defrule next-argument (and "," spaces? expression)
417 421 (:function third))
418 422 (p:defrule arguments (or parenthesized-arguments plain-arguments no-arguments))
419 423 (p:defrule parenthesized-arguments (and spaces? #\( base-arguments #\))
420 424 (:function third))
421 425 (p:defrule plain-arguments (and spaces? base-arguments)
422 426 (:function second))
423 427 (p:defrule no-arguments (or (and spaces? (p:& #\newline))
424 428 (and spaces? (p:& #\&))
425 429 spaces?)
426 430 (:constant nil))
427 431 (p:defrule base-arguments (or (and first-argument (* next-argument)) spaces?)
428 432 (:lambda (list)
429 433 (if (null list)
430 434 nil
431 435 (list* (first list) (second list)))))
432 436
433 437 ;;; Intrinsics
434 438
435 439 (defmacro defintrinsics ((rule-name returning-rule-name non-returning-rule-name) &body clauses)
436 440 `(progn
437 441 ,@(loop :for clause :in clauses
438 442 :collect `(defintrinsic ,@clause))
439 443 (p:defrule ,returning-rule-name (or ,@(remove-nil
440 444 (mapcar (lambda (clause)
441 445 (when (second clause)
442 446 (alexandria:symbolicate
443 447 'intrinsic- (first clause))))
444 448 clauses))))
445 449 (p:defrule ,non-returning-rule-name (or ,@(remove-nil
446 450 (mapcar (lambda (clause)
447 451 (unless (second clause)
448 452 (alexandria:symbolicate
449 453 'intrinsic- (first clause))))
450 454 clauses))))
451 455 (p:defrule ,rule-name (or ,returning-rule-name ,non-returning-rule-name))))
452 456
453 457 (defmacro defintrinsic (sym returning &optional (min-arity 0) max-arity &rest names)
454 458 (declare (ignore returning))
455 459 (unless max-arity
456 460 (setf max-arity *max-args*))
457 461 (setf names
458 462 (if names
459 463 (mapcar #'string-upcase names)
460 464 (list (string sym))))
461 465 `(p:defrule ,(alexandria:symbolicate 'intrinsic- sym)
462 466 (and (p:? #\$) (or ,@(loop :for name :in names :collect `(p:~ ,name)))
463 467 arguments)
464 468 (:destructure (dollar name arguments)
465 469 (declare (ignore dollar))
466 470 (unless (<= ,min-arity (length arguments) ,max-arity)
467 471 (error "Intrinsic ~A expects between ~A and ~A arguments but ~A were provided:~%~S"
468 472 name ,min-arity ,max-arity (length arguments) arguments))
469 473 (list* ',(intern (string sym) "TXT2WEB.LIB") arguments))))
470 474
471 475 (defintrinsics (intrinsic returning-intrinsic non-returning-intrinsic)
472 476 ;; Transitions
473 477 (goto% nil 0 nil "gt" "goto")
474 478 (xgoto% nil 0 nil "xgt" "xgoto")
475 479 ;; Variables
476 480 (killvar nil 0 2)
477 481 ;; Expressions
478 482 (obj t 1 1)
479 483 (loc t 1 1)
480 484 (no t 1 1)
481 485 ;; Basic
482 486 (qspver t 0 0)
483 487 (curloc t 0 0)
484 488 (rand t 1 2)
485 489 (rnd t 0 0)
486 490 (qspmax t 1 nil "max")
487 491 (qspmin t 1 nil "min")
488 492 ;; Arrays
489 493 (killall nil 0 0)
490 494 (copyarr nil 2 4)
491 495 (arrsize t 1 1)
492 496 (arrpos t 2 3)
493 497 (arrcomp t 2 3)
494 498 ;; Strings
495 499 (len t 1 1)
496 500 (mid t 2 3)
497 501 (ucase t 1 1)
498 502 (lcase t 1 1)
499 503 (trim t 1 1)
500 504 (qspreplace t 2 3 "replace")
501 505 (instr t 2 3)
502 506 (isnum t 1 1)
503 507 (val t 1 1)
504 508 (qspstr t 1 1 "str")
505 509 (strcomp t 2 2)
506 510 (strfind t 2 3)
507 511 (strpos t 2 3)
508 512 ;; IF
509 513 (iif t 2 3)
510 514 ;; Subs
511 515 (gosub nil 1 nil "gosub" "gs")
512 516 (func t 1 nil)
513 517 (exit nil 0 0)
514 518 ;; Jump
515 519 (jump nil 1 1)
516 520 ;; Dynamic
517 521 (dynamic nil 1 nil)
518 522 (dyneval t 1 nil)
519 523 ;; Sound
520 524 (play nil 1 2)
521 525 (isplay t 1 1)
522 526 (close nil 1 1)
523 527 (closeall nil 0 0 "close all")
524 528 ;; Main window
525 529 (main-pl nil 1 1 "*pl")
526 530 (main-nl nil 0 1 "*nl")
527 531 (main-p nil 1 1 "*p")
528 532 (maintxt t 0 0)
529 533 (desc t 1 1)
530 534 (main-clear nil 0 0 "*clear" "*clr")
531 535 ;; Aux window
532 536 (showstat nil 1 1)
533 537 (stat-pl nil 1 1 "pl")
534 538 (stat-nl nil 0 1 "nl")
535 539 (stat-p nil 1 1 "p")
536 540 (stattxt t 0 0)
537 541 (stat-clear nil 0 0 "clear" "clr")
538 542 (cls nil 0 0)
539 543 ;; Dialog
540 544 (msg nil 1 1)
541 545 ;; Acts
542 546 (showacts nil 1 1)
543 547 (delact nil 1 1 "delact" "del act")
544 548 (curacts t 0 0)
545 549 (selact t 0 0)
546 550 (cla nil 0 0)
547 551 ;; Objects
548 552 (showobjs nil 1 1)
549 553 (addobj nil 1 3 "addobj" "add obj")
550 554 (delobj nil 1 1 "delobj" "del obj")
551 555 (killobj nil 0 1)
552 556 (countobj t 0 0)
553 557 (getobj t 1 1)
554 558 (selobj t 0 0)
555 559 (unsel nil 0 0 "unsel" "unselect")
556 560 ;; Menu
557 561 (menu nil 1 1)
558 562 ;; Images
559 563 (refint nil 0 0)
560 564 (view nil 0 1)
561 565 (img nil 1)
562 566 (*img nil 1)
563 567 ;; Fonts
564 568 (rgb t 3 3)
565 569 ;; Input
566 570 (showinput nil 1 1)
567 571 (usertxt t 0 0 "user_text" "usrtxt")
568 572 (cmdclear nil 0 0 "cmdclear" "cmdclr")
569 573 (input t 1 1)
570 574 ;; Files
571 575 (openqst nil 1 1)
572 576 (addqst nil 1 1 "addqst" "addlib" "inclib")
573 577 (killqst nil 1 1 "killqst" "dellib" "freelib")
574 578 (opengame nil 0 0)
575 579 (savegame nil 0 0)
576 580 ;; Real time
577 581 (wait nil 1 1)
578 582 (msecscount t 0 0)
579 583 (settimer nil 1 1))
580 584
581 585 ;;; Expression
582 586
583 587 (p:defrule expression or-expr)
584 588
585 589 (p:defrule or-expr (and and-expr (* (and spaces? or-op spaces? and-expr)))
586 590 (:function do-binop))
587 591
588 592 (p:defrule and-expr (and eq-expr (* (and spaces? and-op spaces? eq-expr)))
589 593 (:function do-binop))
590 594
591 595 (p:defrule eq-expr (and sum-expr (* (and spaces? (or "<=" ">=" "=<" "=>" "<>"
592 596 "=" "<" ">" "!")
593 597 spaces? sum-expr)))
594 598 (:function do-binop))
595 599
596 600 (p:defrule sum-expr (and mod-expr (* (and spaces? (or #\+ #\-) spaces? mod-expr)))
597 601 (:function do-binop))
598 602
599 603 (p:defrule mod-expr (and mul-expr (* (and spaces? (p:~ "mod") spaces? mul-expr)))
600 604 (:function do-binop))
601 605
602 606 (p:defrule mul-expr (and unary-expr (* (and spaces? (or #\* #\/) spaces? unary-expr)))
603 607 (:function do-binop))
604 608
605 609 (p:defrule unary-expr (and (p:? (or #\+ #\-)) atom-expr)
606 610 (:lambda (list)
607 611 (let ((expr (remove-nil list)))
608 612 (if (= 1 (length expr))
609 613 (first expr)
610 614 (intern-first expr)))))
611 615
612 616 (p:defrule atom-expr (and (or variable literal returning-intrinsic paren-expr) spaces?)
613 617 (:function first))
614 618
615 619 (p:defrule paren-expr (and #\( spaces? expression spaces? #\))
616 620 (:function third))
617 621
618 622 (p:defrule or-op (p:~ "or")
619 623 (:constant "or"))
620 624
621 625 (p:defrule and-op (p:~ "and")
622 626 (:constant "and"))
623 627
624 628 ;;; Variables
625 629
626 630 (p:defrule variable (and identifier (p:? array-index))
627 631 (:destructure (id idx-raw)
628 632 (let ((idx (case idx-raw
629 633 ((nil) 0)
630 634 (:last nil)
631 635 (t idx-raw))))
632 636 (list 'lib:qspvar id idx))))
633 637
634 638 (p:defrule array-index (and #\[ spaces? (p:? expression) spaces? #\])
635 639 (:lambda (list)
636 640 (or (third list) :last)))
637 641
638 642 (p:defrule assignment (or kw-assignment plain-assignment op-assignment)
639 643 (:destructure (qspvar eq expr)
640 644 (declare (ignore eq))
641 645 (list 'lib:set qspvar expr)))
642 646
643 647 (p:defrule kw-assignment (and (or (p:~ "let") (p:~ "set")) spaces? (or op-assignment plain-assignment))
644 648 (:function third))
645 649
646 650 (p:defrule op-assignment (and variable spaces? (or "+" "-" "*" "/") #\= spaces? expression)
647 651 (:destructure (qspvar ws1 op eq ws2 expr)
648 652 (declare (ignore ws1 ws2))
649 653 (list qspvar eq (intern-first (list op qspvar expr)))))
650 654
651 655 (p:defrule plain-assignment (and variable spaces? #\= spaces? expression)
652 656 (:function remove-nil))
653 657
654 658 ;;; Non-string literals
655 659
656 660 (p:defrule literal (or qsp-string brace-string number))
657 661
658 662 (p:defrule number (+ (or #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
659 663 (:lambda (list)
660 664 (parse-integer (p:text list))))
Show file before | Show file after | Hide comments
@@ -1,386 +1,394 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 228 (defpsmacro ! (op1 op2)
229 229 `(not (equal ,op1 ,op2)))
230 230
231 231 (defpsmacro qspmod (&rest ops)
232 232 (case (length ops)
233 233 (1 (first ops))
234 234 (2 `(mod ,@ops))
235 235 (t `(mod ,(first ops) (qspmod ,@(rest ops))))))
236 236
237 237 ;;; 4code
238 238
239 239 (defpsmacro exec (&body body)
240 240 (format nil "javascript: ~{~A~^~%~}" (mapcar #'ps* body)))
241 241
242 242 ;;; 5arrays
243 243
244 244 ;;; 6str
245 245
246 246 (defpsmacro & (&rest args)
247 247 `(chain "" (concat ,@args)))
248 248
249 249 ;;; 7if
250 250
251 251 (defpsmacro qspcond (&rest clauses)
252 252 `(cond ,@(loop :for clause :in clauses
253 253 :for f := (if (eq 'txt2web::else (first clause))
254 254 't
255 255 (first clause))
256 256 :collect (list f
257 257 `(tagbody
258 258 ,@(rest clause))))))
259 259
260 260 ;;; 8sub
261 261
262 ;;; 9loops
262 ;;; 9jump
263 263 ;;; Yep, that's a huge kludge since Javascript doesn't support arbitrary labels
264 264
265 265 (defpsmacro jump (target)
266 266 `(return-from label-body ,(string-upcase (second target))))
267 267
268 268 (defpsmacro tagbody (&body body)
269 269 (let ((create-locals (if (eq (caar body) 'create-locals)
270 270 (list (car body))))
271 271 (void (if (equal (car (last body)) '(void))
272 272 '((void)))))
273 273 (when create-locals
274 274 (setf body (cdr body)))
275 275 (when void
276 276 (setf body (butlast body)))
277 277 (let ((funcs (list nil "_nil")))
278 278 (dolist (form body)
279 279 (cond ((keywordp form)
280 280 (setf (first funcs) (reverse (first funcs)))
281 281 (push (string-upcase form) funcs)
282 282 (push nil funcs))
283 283 (t
284 284 (push form (first funcs)))))
285 285 (setf (first funcs) (reverse (first funcs)))
286 286 (setf funcs (reverse funcs))
287 287 `(progn
288 288 ,@create-locals
289 289 ,(if (= 2 (length funcs))
290 290 `(progn
291 291 ,@body)
292 292 `(progn
293 293 (tagbody-blocks ,funcs)
294 294 (loop
295 295 :for _nextblock
296 296 := :_nil
297 297 :then (await (funcall (getprop _labels _nextblock)))
298 298 :while _nextblock)))
299 299 ,@void))))
300 300
301 301 (defvar *current-label*)
302 302 (defvar *has-jump-back*)
303 303 (walker:deftransform optimize-jump jump (target)
304 304 (cond ((string= (string-upcase (second target)) *current-label*)
305 305 (setf *has-jump-back* t)
306 306 '(continue))
307 307 (t
308 308 (walker:walk-continue))))
309 309
310 310 (defpsmacro tagbody-blocks (funcs)
311 311 `(setf ,@(loop :for (label code . rest-labels) :on funcs :by #'cddr
312 312 :append `((@ _labels ,label)
313 313 (async-lambda ()
314 314 (block label-body
315 315 (tagbody-block-body ,label ,code
316 316 ,(first rest-labels))))))))
317 317
318 318 (defpsmacro tagbody-block-body (label code next-label)
319 319 (let ((*current-label* label)
320 320 (*has-jump-back* nil))
321 321 (let ((code (walker:walk 'optimize-jump code)))
322 322 (if *has-jump-back*
323 323 `(progn
324 324 (loop :do (progn
325 325 ,@code
326 326 (break)))
327 327 ,@(if next-label
328 328 (list next-label)
329 329 nil))
330 330 `(progn
331 331 ,@code
332 332 ,@(if next-label
333 333 (list next-label)
334 334 nil))))))
335 335
336 336 (defpsmacro exit ()
337 337 '(return-from nil (values)))
338 338
339 339 ;;; 10dynamic
340 340
341 341 (defpsmacro qspblock (&body body)
342 342 `(locals-block
343 343 ,@body))
344 344
345 345 (defpsmacro qsp-lambda (&body body)
346 346 `(async-lambda (args)
347 347 (label-block ()
348 348 ,@body)))
349 349
350 350 ;;; 11main
351 351
352 352 (defpsmacro act (name img &body body)
353 353 `(api-call add-act ,name ,img
354 354 (locals-block
355 355 ,@body)))
356 356
357 357 ;;; 12aux
358 358
359 359 ;;; 13diag
360 360
361 361 ;;; 14act
362 362
363 363 ;;; 15objs
364 364
365 365 ;;; 16menu
366 366
367 367 ;;; 17sound
368 368
369 369 ;;; 18img
370 370
371 371 ;;; 19input
372 372
373 373 ;;; 20time
374 374
375 375 ;;; 21local
376 376
377 ;;; 22for
377 ;;; 22loop
378
379 (defpsmacro qsploop (init cond step &body body)
380 `(progn
381 ,init
382 (loop :while ,cond
383 :do (progn
384 ,@body
385 ,step))))
378 386
379 387 ;; Transform because it creates a (set ...) hence it has to be processed
380 388 ;; before the apply-vars transform. And macros are processed after all
381 389 ;; the transforms
382 390 (walker:deftransform for-transform qspfor (var from to step &rest body)
383 391 `(loop :for i :from ,from :to ,to :by ,step
384 392 :do (set ,var i)
385 393 :do (block nil
386 394 ,@(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