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