Show More
@@ -1,14 +1,16 b'' | |||||
1 |
|
1 | |||
2 | * Duplicate label error (in the parser) |
|
|||
3 | * Reporting error lines in the parser |
|
|||
4 | * MENU with async/await |
|
2 | * MENU with async/await | |
5 | * Special locations |
|
3 | * Special locations | |
6 | * Special variables |
|
4 | * Special variables | |
7 | * CLI build for Linux |
|
5 | * CLI build for Linux | |
8 | * CLI build for Windows |
|
6 | * CLI build for Windows | |
9 | * Storing error lines in the parser to report it in runtime errors |
|
7 | ||
|
8 | * Reporting error lines in the parser | |||
|
9 | * Report duplicate label (in the parser) | |||
|
10 | * reporting error lines at runtime (by storing them in every form in the parser | |||
|
11 | * Report JUMP with missing label (in tagbody) | |||
10 |
|
12 | |||
11 | * Build Istreblenie |
|
13 | * Build Istreblenie | |
12 | * Windows GUI (for the compiler) |
|
14 | * Windows GUI (for the compiler) | |
13 | * Save-load game in slots |
|
15 | * Save-load game in slots | |
14 | * Resizable frames |
|
16 | * Resizable frames |
@@ -1,95 +1,96 b'' | |||||
1 |
|
1 | |||
2 | # start |
|
2 | # start | |
3 | USEHTML=1 |
|
3 | USEHTML=1 | |
4 | '<center><font size="20" color="#FF0000" face="Times New Roman"><b>Π’Π΅ΠΊΡΡΠΎΠ²ΡΠΉ ΠΊΠ²Π΅ΡΡ</b></font></center><br>' |
|
4 | '<center><font size="20" color="#FF0000" face="Times New Roman"><b>Π’Π΅ΠΊΡΡΠΎΠ²ΡΠΉ ΠΊΠ²Π΅ΡΡ</b></font></center><br>' | |
5 | ' <b>ΠΠ°ΡΠ° ΡΠ΅Π»Ρ</b> - Π·Π°ΡΠ°Π±Π°ΡΡΠ²Π°ΡΡ <i>Π΄Π΅Π½ΡΠ³ΠΈ</i>, ΠΏΠΎΠΊΡΠΏΠ°ΡΡ Π½Π° Π½ΠΈΡ <i>ΠΏΠΎΠ΄Π°ΡΠΊΠΈ</i> ΠΈ Π΄Π°ΡΠΈΡΡ ΡΠ²ΠΎΠΈΠΌ <i>Π±Π»ΠΈΠ·ΠΊΠΈΠΌ</i>.' |
|
5 | ' <b>ΠΠ°ΡΠ° ΡΠ΅Π»Ρ</b> - Π·Π°ΡΠ°Π±Π°ΡΡΠ²Π°ΡΡ <i>Π΄Π΅Π½ΡΠ³ΠΈ</i>, ΠΏΠΎΠΊΡΠΏΠ°ΡΡ Π½Π° Π½ΠΈΡ <i>ΠΏΠΎΠ΄Π°ΡΠΊΠΈ</i> ΠΈ Π΄Π°ΡΠΈΡΡ ΡΠ²ΠΎΠΈΠΌ <i>Π±Π»ΠΈΠ·ΠΊΠΈΠΌ</i>.' | |
6 | ACT '<b>ΠΠ°ΡΠ°ΡΡ ΠΈΠ³ΡΡ</b>':GOTO 'ΠΠΎΠΌ' |
|
6 | ACT '<b>ΠΠ°ΡΠ°ΡΡ ΠΈΠ³ΡΡ</b>':GOTO 'ΠΠΎΠΌ' | |
7 | - |
|
7 | - | |
8 | #Π Π°Π±ΠΎΡΠ° |
|
8 | #Π Π°Π±ΠΎΡΠ° | |
9 | '<center><b>ΠΠΎΡΡ</b></center><br>' |
|
9 | '<center><b>ΠΠΎΡΡ</b></center><br>' | |
10 | ' ΠΠΎΡΡ Π½Π°Ρ ΠΎΠ΄ΠΈΡΡΡ Π½Π° ΡΠ°ΠΌΠΎΠΉ ΡΠΆΠ½ΠΎΠΉ ΠΎΠΊΡΠ°ΠΈΠ½Π΅ Π³ΠΎΡΠΎΠ΄Π°. ΠΠ΄Π΅ΡΡ ΠΏΠΎΡΡΠΎΡΠ½Π½ΠΎ Π·Π°Π³ΡΡΠΆΠ°ΡΡΡΡ ΠΈ ΡΠ°Π·Π³ΡΡΠΆΠ°ΡΡΡΡ ΡΠ°Π·Π»ΠΈΡΠ½ΡΠ΅ ΡΡΠ΄Π°. Π Π°Π±ΠΎΡΠΈΡ ΡΡΠΊ Π½Π΅ Ρ Π²Π°ΡΠ°Π΅Ρ ΠΈ ΡΠΊΠ»Π°Π΄ΡΠΊΠΎΠΉ Π±ΡΠΈΠ³Π°Π΄ΠΈΡ Π²ΡΠ΅Π³Π΄Π° ΡΠ°Π΄ Π·Π°ΠΏΠ»Π°ΡΠΈΡΡ <i>Π΄Π΅Π½ΡΠ³ΠΈ</i> Π·Π° ΠΏΠΎΠΌΠΎΡΡ.' |
|
10 | ' ΠΠΎΡΡ Π½Π°Ρ ΠΎΠ΄ΠΈΡΡΡ Π½Π° ΡΠ°ΠΌΠΎΠΉ ΡΠΆΠ½ΠΎΠΉ ΠΎΠΊΡΠ°ΠΈΠ½Π΅ Π³ΠΎΡΠΎΠ΄Π°. ΠΠ΄Π΅ΡΡ ΠΏΠΎΡΡΠΎΡΠ½Π½ΠΎ Π·Π°Π³ΡΡΠΆΠ°ΡΡΡΡ ΠΈ ΡΠ°Π·Π³ΡΡΠΆΠ°ΡΡΡΡ ΡΠ°Π·Π»ΠΈΡΠ½ΡΠ΅ ΡΡΠ΄Π°. Π Π°Π±ΠΎΡΠΈΡ ΡΡΠΊ Π½Π΅ Ρ Π²Π°ΡΠ°Π΅Ρ ΠΈ ΡΠΊΠ»Π°Π΄ΡΠΊΠΎΠΉ Π±ΡΠΈΠ³Π°Π΄ΠΈΡ Π²ΡΠ΅Π³Π΄Π° ΡΠ°Π΄ Π·Π°ΠΏΠ»Π°ΡΠΈΡΡ <i>Π΄Π΅Π½ΡΠ³ΠΈ</i> Π·Π° ΠΏΠΎΠΌΠΎΡΡ.' | |
11 | ' Π£ Π²Π°Ρ <font size="16"><b><<ΠΠ΅Π½ΡΠ³ΠΈ>></b></font> ΠΌΠΎΠ½Π΅Ρ.' |
|
11 | ' Π£ Π²Π°Ρ <font size="16"><b><<ΠΠ΅Π½ΡΠ³ΠΈ>></b></font> ΠΌΠΎΠ½Π΅Ρ.' | |
12 | ' ΠΠ°ΠΌ Π½ΡΠΆΠ½ΠΎ ΠΏΠ΅ΡΠ΅Π½Π΅ΡΡΠΈ <font size="16" color="#00AA00"><b><<3-Π―ΡΠΈΠΊ>></b></font> ΡΡΠΈΠΊΠ°.' |
|
12 | ' ΠΠ°ΠΌ Π½ΡΠΆΠ½ΠΎ ΠΏΠ΅ΡΠ΅Π½Π΅ΡΡΠΈ <font size="16" color="#00AA00"><b><<3-Π―ΡΠΈΠΊ>></b></font> ΡΡΠΈΠΊΠ°.' | |
13 | ACT 'ΠΠ΄ΡΠΈ Π΄ΠΎΠΌΠΎΠΉ':GOTO 'ΠΠΎΠΌ' |
|
13 | ACT 'ΠΠ΄ΡΠΈ Π΄ΠΎΠΌΠΎΠΉ':GOTO 'ΠΠΎΠΌ' | |
14 | ACT 'ΠΠ΄ΡΠΈ Π² ΠΌΠ°Π³Π°Π·ΠΈΠ½':GOTO 'ΠΠ°Π³Π°Π·ΠΈΠ½' |
|
14 | ACT 'ΠΠ΄ΡΠΈ Π² ΠΌΠ°Π³Π°Π·ΠΈΠ½':GOTO 'ΠΠ°Π³Π°Π·ΠΈΠ½' | |
15 | ACT 'ΠΠ΅ΡΠ΅Π½Π΅ΡΡΠΈ ΡΡΠΈΠΊ': |
|
15 | ACT 'ΠΠ΅ΡΠ΅Π½Π΅ΡΡΠΈ ΡΡΠΈΠΊ': | |
16 | Π―ΡΠΈΠΊ = Π―ΡΠΈΠΊ + 1 |
|
16 | Π―ΡΠΈΠΊ = Π―ΡΠΈΠΊ + 1 | |
|
17 | WAIT 500 | |||
17 |
|
|
18 | IF Π―ΡΠΈΠΊ = 3: | |
18 | ΠΠ΅Π½ΡΠ³ΠΈ = ΠΠ΅Π½ΡΠ³ΠΈ + 5 |
|
19 | ΠΠ΅Π½ΡΠ³ΠΈ = ΠΠ΅Π½ΡΠ³ΠΈ + 5 | |
19 | Π―ΡΠΈΠΊ = 0 |
|
20 | Π―ΡΠΈΠΊ = 0 | |
20 | END |
|
21 | END | |
21 | GOTO 'Π Π°Π±ΠΎΡΠ°' |
|
22 | GOTO 'Π Π°Π±ΠΎΡΠ°' | |
22 | END |
|
23 | END | |
23 | - |
|
24 | - | |
24 | #ΠΠ°Π³Π°Π·ΠΈΠ½ |
|
25 | #ΠΠ°Π³Π°Π·ΠΈΠ½ | |
25 | '<center><b>ΠΠ°Π³Π°Π·ΠΈΠ½</b></center><br>' |
|
26 | '<center><b>ΠΠ°Π³Π°Π·ΠΈΠ½</b></center><br>' | |
26 | ' ΠΠ°Π³Π°Π·ΠΈΠ½ Π½Π΅Π±ΠΎΠ»ΡΡΠΎΠΉ, Π½ΠΎ ΡΡΡ ΠΎΠ±ΡΡΠ½ΠΎ Π΅ΡΡΡ Π²ΡΡ, ΡΡΠΎ Π½ΡΠΆΠ½ΠΎ ΠΏΡΠΎΡΡΠΎΠΌΡ Π³ΠΎΡΠΎΠΆΠ°Π½ΠΈΠ½Ρ. ΠΠΈΡΡΠΈΠ½Ρ Π·Π°ΡΡΠ°Π²Π»Π΅Π½Ρ ΡΠ°Π·Π»ΠΈΡΠ½ΡΠΌΠΈ ΡΠΎΠ²Π°ΡΠ°ΠΌΠΈ. Π£ ΠΊΠ°ΡΡΡ ΡΡΠΎΠΈΡ ΠΏΠΎΠ»Π½Π°Ρ ΠΆΠ΅Π½ΡΠΈΠ½Π° ΠΈ Ρ ΠΌΡΡΠΎ ΡΠΌΠΎΡΡΠΈΡ Π½Π° Π²Π°Ρ.' |
|
27 | ' ΠΠ°Π³Π°Π·ΠΈΠ½ Π½Π΅Π±ΠΎΠ»ΡΡΠΎΠΉ, Π½ΠΎ ΡΡΡ ΠΎΠ±ΡΡΠ½ΠΎ Π΅ΡΡΡ Π²ΡΡ, ΡΡΠΎ Π½ΡΠΆΠ½ΠΎ ΠΏΡΠΎΡΡΠΎΠΌΡ Π³ΠΎΡΠΎΠΆΠ°Π½ΠΈΠ½Ρ. ΠΠΈΡΡΠΈΠ½Ρ Π·Π°ΡΡΠ°Π²Π»Π΅Π½Ρ ΡΠ°Π·Π»ΠΈΡΠ½ΡΠΌΠΈ ΡΠΎΠ²Π°ΡΠ°ΠΌΠΈ. Π£ ΠΊΠ°ΡΡΡ ΡΡΠΎΠΈΡ ΠΏΠΎΠ»Π½Π°Ρ ΠΆΠ΅Π½ΡΠΈΠ½Π° ΠΈ Ρ ΠΌΡΡΠΎ ΡΠΌΠΎΡΡΠΈΡ Π½Π° Π²Π°Ρ.' | |
27 | ' Π£ Π²Π°Ρ <font size="16"><b><<ΠΠ΅Π½ΡΠ³ΠΈ>></b></font> ΠΌΠΎΠ½Π΅Ρ.' |
|
28 | ' Π£ Π²Π°Ρ <font size="16"><b><<ΠΠ΅Π½ΡΠ³ΠΈ>></b></font> ΠΌΠΎΠ½Π΅Ρ.' | |
28 | IF ΠΠ΅Π½ΡΠ³ΠΈ >= 3: |
|
29 | IF ΠΠ΅Π½ΡΠ³ΠΈ >= 3: | |
29 | ACT 'ΠΡΠΏΠΈΡΡ ΠΊΠΎΠ½ΡΡΡΡΠΊΡΠΎΡ': |
|
30 | ACT 'ΠΡΠΏΠΈΡΡ ΠΊΠΎΠ½ΡΡΡΡΠΊΡΠΎΡ': | |
30 | ΠΠ΅Π½ΡΠ³ΠΈ = ΠΠ΅Π½ΡΠ³ΠΈ - 3 |
|
31 | ΠΠ΅Π½ΡΠ³ΠΈ = ΠΠ΅Π½ΡΠ³ΠΈ - 3 | |
31 | ADDOBJ 'ΠΠΎΠ½ΡΡΡΡΠΊΡΠΎΡ' |
|
32 | ADDOBJ 'ΠΠΎΠ½ΡΡΡΡΠΊΡΠΎΡ' | |
32 | GOTO 'ΠΠ°Π³Π°Π·ΠΈΠ½' |
|
33 | GOTO 'ΠΠ°Π³Π°Π·ΠΈΠ½' | |
33 | END |
|
34 | END | |
34 | END |
|
35 | END | |
35 | IF ΠΠ΅Π½ΡΠ³ΠΈ >= 5: |
|
36 | IF ΠΠ΅Π½ΡΠ³ΠΈ >= 5: | |
36 | ACT 'ΠΡΠΏΠΈΡΡ ΠΏΠ»ΡΡΠ΅Π²ΠΎΠ³ΠΎ ΠΌΠ΅Π΄Π²Π΅Π΄Ρ': |
|
37 | ACT 'ΠΡΠΏΠΈΡΡ ΠΏΠ»ΡΡΠ΅Π²ΠΎΠ³ΠΎ ΠΌΠ΅Π΄Π²Π΅Π΄Ρ': | |
37 | ΠΠ΅Π½ΡΠ³ΠΈ = ΠΠ΅Π½ΡΠ³ΠΈ - 5 |
|
38 | ΠΠ΅Π½ΡΠ³ΠΈ = ΠΠ΅Π½ΡΠ³ΠΈ - 5 | |
38 | ADDOBJ 'ΠΠ»ΡΡΠ΅Π²ΡΠΉ ΠΌΠ΅Π΄Π²Π΅Π΄Ρ' |
|
39 | ADDOBJ 'ΠΠ»ΡΡΠ΅Π²ΡΠΉ ΠΌΠ΅Π΄Π²Π΅Π΄Ρ' | |
39 | GOTO 'ΠΠ°Π³Π°Π·ΠΈΠ½' |
|
40 | GOTO 'ΠΠ°Π³Π°Π·ΠΈΠ½' | |
40 | END |
|
41 | END | |
41 | ACT 'ΠΡΠΏΠΈΡΡ Π²ΡΠ·Π°Π»ΡΠ½ΡΠΉ Π½Π°Π±ΠΎΡ': |
|
42 | ACT 'ΠΡΠΏΠΈΡΡ Π²ΡΠ·Π°Π»ΡΠ½ΡΠΉ Π½Π°Π±ΠΎΡ': | |
42 | ΠΠ΅Π½ΡΠ³ΠΈ = ΠΠ΅Π½ΡΠ³ΠΈ - 5 |
|
43 | ΠΠ΅Π½ΡΠ³ΠΈ = ΠΠ΅Π½ΡΠ³ΠΈ - 5 | |
43 | ADDOBJ 'ΠΡΠ·Π°Π»ΡΠ½ΡΠΉ Π½Π°Π±ΠΎΡ' |
|
44 | ADDOBJ 'ΠΡΠ·Π°Π»ΡΠ½ΡΠΉ Π½Π°Π±ΠΎΡ' | |
44 | GOTO 'ΠΠ°Π³Π°Π·ΠΈΠ½' |
|
45 | GOTO 'ΠΠ°Π³Π°Π·ΠΈΠ½' | |
45 | END |
|
46 | END | |
46 | END |
|
47 | END | |
47 | IF ΠΠ΅Π½ΡΠ³ΠΈ >= 7: |
|
48 | IF ΠΠ΅Π½ΡΠ³ΠΈ >= 7: | |
48 | ACT 'ΠΡΠΏΠΈΡΡ ΠΈΠ½ΡΡΡΡΠΌΠ΅Π½ΡΡ': |
|
49 | ACT 'ΠΡΠΏΠΈΡΡ ΠΈΠ½ΡΡΡΡΠΌΠ΅Π½ΡΡ': | |
49 | ΠΠ΅Π½ΡΠ³ΠΈ = ΠΠ΅Π½ΡΠ³ΠΈ - 7 |
|
50 | ΠΠ΅Π½ΡΠ³ΠΈ = ΠΠ΅Π½ΡΠ³ΠΈ - 7 | |
50 | ADDOBJ 'ΠΠ½ΡΡΡΡΠΌΠ΅Π½ΡΡ' |
|
51 | ADDOBJ 'ΠΠ½ΡΡΡΡΠΌΠ΅Π½ΡΡ' | |
51 | GOTO 'ΠΠ°Π³Π°Π·ΠΈΠ½' |
|
52 | GOTO 'ΠΠ°Π³Π°Π·ΠΈΠ½' | |
52 | END |
|
53 | END | |
53 | END |
|
54 | END | |
54 | ACT 'ΠΠ΄ΡΠΈ Π΄ΠΎΠΌΠΎΠΉ':GOTO 'ΠΠΎΠΌ' |
|
55 | ACT 'ΠΠ΄ΡΠΈ Π΄ΠΎΠΌΠΎΠΉ':GOTO 'ΠΠΎΠΌ' | |
55 | ACT 'ΠΠ΄ΡΠΈ Π² ΠΏΠΎΡΡ':GOTO 'Π Π°Π±ΠΎΡΠ°' |
|
56 | ACT 'ΠΠ΄ΡΠΈ Π² ΠΏΠΎΡΡ':GOTO 'Π Π°Π±ΠΎΡΠ°' | |
56 | - |
|
57 | - | |
57 | #ΠΠΎΠΌ |
|
58 | #ΠΠΎΠΌ | |
58 | '<center><b>ΠΠΎΠΌ</b></center><br>' |
|
59 | '<center><b>ΠΠΎΠΌ</b></center><br>' | |
59 | ' ΠΠΎΠΌΠ° Π²ΡΠ΅Π³Π΄Π° ΠΎΡΠ΅Π½Ρ ΡΡΡΠ½ΠΎ. Π Π²ΠΊΡΡΠ½ΠΎ ΠΏΠ°Ρ Π½Π΅Ρ Π΅Π΄ΠΎΠΉ. ΠΠ°ΠΌΠ°, ΡΠΈΠ΄Ρ Π² ΠΊΡΠ΅ΡΠ»Π΅, Π²ΡΠΆΠ΅Ρ Π½ΠΎΡΠΊΠΈ. ΠΡΠ΅Ρ Ρ Π²Π°ΡΠΈΠΌ Π±ΡΠ°ΡΠΎΠΌ ΡΠΈΠ½ΠΈΡ ΡΠΊΠ²ΠΎΡΠ΅ΡΠ½ΠΈΠΊ. Π‘Π΅ΡΡΡΠ° Ρ Π»ΠΎΠΏΠΎΡΠ΅Ρ Π½Π° ΠΊΡΡ Π½Π΅. ΠΠΎΠΌΠ° Π²ΡΠ΅Π³Π΄Π° Ρ ΠΎΡΠΎΡΠΎ.' |
|
60 | ' ΠΠΎΠΌΠ° Π²ΡΠ΅Π³Π΄Π° ΠΎΡΠ΅Π½Ρ ΡΡΡΠ½ΠΎ. Π Π²ΠΊΡΡΠ½ΠΎ ΠΏΠ°Ρ Π½Π΅Ρ Π΅Π΄ΠΎΠΉ. ΠΠ°ΠΌΠ°, ΡΠΈΠ΄Ρ Π² ΠΊΡΠ΅ΡΠ»Π΅, Π²ΡΠΆΠ΅Ρ Π½ΠΎΡΠΊΠΈ. ΠΡΠ΅Ρ Ρ Π²Π°ΡΠΈΠΌ Π±ΡΠ°ΡΠΎΠΌ ΡΠΈΠ½ΠΈΡ ΡΠΊΠ²ΠΎΡΠ΅ΡΠ½ΠΈΠΊ. Π‘Π΅ΡΡΡΠ° Ρ Π»ΠΎΠΏΠΎΡΠ΅Ρ Π½Π° ΠΊΡΡ Π½Π΅. ΠΠΎΠΌΠ° Π²ΡΠ΅Π³Π΄Π° Ρ ΠΎΡΠΎΡΠΎ.' | |
60 | ' Π£ Π²Π°Ρ <font size="16"><b><<ΠΠ΅Π½ΡΠ³ΠΈ>></b></font> ΠΌΠΎΠ½Π΅Ρ.' |
|
61 | ' Π£ Π²Π°Ρ <font size="16"><b><<ΠΠ΅Π½ΡΠ³ΠΈ>></b></font> ΠΌΠΎΠ½Π΅Ρ.' | |
61 | IF OBJ 'ΠΠΎΠ½ΡΡΡΡΠΊΡΠΎΡ': |
|
62 | IF OBJ 'ΠΠΎΠ½ΡΡΡΡΠΊΡΠΎΡ': | |
62 | ACT 'ΠΠΎΠ΄Π°ΡΠΈΡΡ ΠΊΠΎΠ½ΡΡΡΡΠΊΡΠΎΡ Π±ΡΠ°ΡΡ': |
|
63 | ACT 'ΠΠΎΠ΄Π°ΡΠΈΡΡ ΠΊΠΎΠ½ΡΡΡΡΠΊΡΠΎΡ Π±ΡΠ°ΡΡ': | |
63 | DELOBJ 'ΠΠΎΠ½ΡΡΡΡΠΊΡΠΎΡ' |
|
64 | DELOBJ 'ΠΠΎΠ½ΡΡΡΡΠΊΡΠΎΡ' | |
64 | ' - ΠΠΎΡ ΡΠ΅Π±Π΅ ΠΊΠΎΠ½ΡΡΡΡΠΊΡΠΎΡ.' |
|
65 | ' - ΠΠΎΡ ΡΠ΅Π±Π΅ ΠΊΠΎΠ½ΡΡΡΡΠΊΡΠΎΡ.' | |
65 | ' - Π‘ΠΏΠ°ΡΠΈΠ±ΠΎ, Π±ΡΠ°Ρ.' |
|
66 | ' - Π‘ΠΏΠ°ΡΠΈΠ±ΠΎ, Π±ΡΠ°Ρ.' | |
66 | DELACT 'ΠΠΎΠ΄Π°ΡΠΈΡΡ ΠΊΠΎΠ½ΡΡΡΡΠΊΡΠΎΡ Π±ΡΠ°ΡΡ' |
|
67 | DELACT 'ΠΠΎΠ΄Π°ΡΠΈΡΡ ΠΊΠΎΠ½ΡΡΡΡΠΊΡΠΎΡ Π±ΡΠ°ΡΡ' | |
67 | END |
|
68 | END | |
68 | END |
|
69 | END | |
69 | IF OBJ 'ΠΠ»ΡΡΠ΅Π²ΡΠΉ ΠΌΠ΅Π΄Π²Π΅Π΄Ρ': |
|
70 | IF OBJ 'ΠΠ»ΡΡΠ΅Π²ΡΠΉ ΠΌΠ΅Π΄Π²Π΅Π΄Ρ': | |
70 | ACT 'ΠΠΎΠ΄Π°ΡΠΈΡΡ ΠΌΠ΅Π΄Π²Π΅Π΄Ρ ΡΠ΅ΡΡΡΠ΅': |
|
71 | ACT 'ΠΠΎΠ΄Π°ΡΠΈΡΡ ΠΌΠ΅Π΄Π²Π΅Π΄Ρ ΡΠ΅ΡΡΡΠ΅': | |
71 | DELOBJ 'ΠΠ»ΡΡΠ΅Π²ΡΠΉ ΠΌΠ΅Π΄Π²Π΅Π΄Ρ' |
|
72 | DELOBJ 'ΠΠ»ΡΡΠ΅Π²ΡΠΉ ΠΌΠ΅Π΄Π²Π΅Π΄Ρ' | |
72 | ' - ΠΠΎΡ ΡΠ΅Π±Π΅ ΠΏΠ»ΡΡΠ΅Π²ΡΠΉ ΠΌΠ΅Π΄Π²Π΅Π΄Ρ.' |
|
73 | ' - ΠΠΎΡ ΡΠ΅Π±Π΅ ΠΏΠ»ΡΡΠ΅Π²ΡΠΉ ΠΌΠ΅Π΄Π²Π΅Π΄Ρ.' | |
73 | ' - Π‘ΠΏΠ°ΡΠΈΠ±ΠΎ, Π±ΡΠ°Ρ.' |
|
74 | ' - Π‘ΠΏΠ°ΡΠΈΠ±ΠΎ, Π±ΡΠ°Ρ.' | |
74 | DELACT 'ΠΠΎΠ΄Π°ΡΠΈΡΡ ΠΌΠ΅Π΄Π²Π΅Π΄Ρ ΡΠ΅ΡΡΡΠ΅' |
|
75 | DELACT 'ΠΠΎΠ΄Π°ΡΠΈΡΡ ΠΌΠ΅Π΄Π²Π΅Π΄Ρ ΡΠ΅ΡΡΡΠ΅' | |
75 | END |
|
76 | END | |
76 | END |
|
77 | END | |
77 | IF OBJ 'ΠΡΠ·Π°Π»ΡΠ½ΡΠΉ Π½Π°Π±ΠΎΡ': |
|
78 | IF OBJ 'ΠΡΠ·Π°Π»ΡΠ½ΡΠΉ Π½Π°Π±ΠΎΡ': | |
78 | ACT 'ΠΠΎΠ΄Π°ΡΠΈΡΡ Π½Π°Π±ΠΎΡ ΠΌΠ°ΠΌΠ΅': |
|
79 | ACT 'ΠΠΎΠ΄Π°ΡΠΈΡΡ Π½Π°Π±ΠΎΡ ΠΌΠ°ΠΌΠ΅': | |
79 | DELOBJ 'ΠΡΠ·Π°Π»ΡΠ½ΡΠΉ Π½Π°Π±ΠΎΡ' |
|
80 | DELOBJ 'ΠΡΠ·Π°Π»ΡΠ½ΡΠΉ Π½Π°Π±ΠΎΡ' | |
80 | ' - ΠΠΎΡ ΡΠ΅Π±Π΅ Π²ΡΠ·Π°Π»ΡΠ½ΡΠΉ Π½Π°Π±ΠΎΡ.' |
|
81 | ' - ΠΠΎΡ ΡΠ΅Π±Π΅ Π²ΡΠ·Π°Π»ΡΠ½ΡΠΉ Π½Π°Π±ΠΎΡ.' | |
81 | ' - Π‘ΠΏΠ°ΡΠΈΠ±ΠΎ, ΡΡΠ½ΠΎΠΊ.' |
|
82 | ' - Π‘ΠΏΠ°ΡΠΈΠ±ΠΎ, ΡΡΠ½ΠΎΠΊ.' | |
82 | DELACT 'ΠΠΎΠ΄Π°ΡΠΈΡΡ Π½Π°Π±ΠΎΡ ΠΌΠ°ΠΌΠ΅' |
|
83 | DELACT 'ΠΠΎΠ΄Π°ΡΠΈΡΡ Π½Π°Π±ΠΎΡ ΠΌΠ°ΠΌΠ΅' | |
83 | END |
|
84 | END | |
84 | END |
|
85 | END | |
85 | IF OBJ 'ΠΠ½ΡΡΡΡΠΌΠ΅Π½ΡΡ': |
|
86 | IF OBJ 'ΠΠ½ΡΡΡΡΠΌΠ΅Π½ΡΡ': | |
86 | ACT 'ΠΠΎΠ΄Π°ΡΠΈΡΡ ΠΈΠ½ΡΡΡΡΠΌΠ΅Π½ΡΡ ΠΎΡΡΡ': |
|
87 | ACT 'ΠΠΎΠ΄Π°ΡΠΈΡΡ ΠΈΠ½ΡΡΡΡΠΌΠ΅Π½ΡΡ ΠΎΡΡΡ': | |
87 | DELOBJ 'ΠΠ½ΡΡΡΡΠΌΠ΅Π½ΡΡ' |
|
88 | DELOBJ 'ΠΠ½ΡΡΡΡΠΌΠ΅Π½ΡΡ' | |
88 | ' - ΠΠΎΡ ΡΠ΅Π±Π΅ ΠΈΠ½ΡΡΡΡΠΌΠ΅Π½ΡΡ.' |
|
89 | ' - ΠΠΎΡ ΡΠ΅Π±Π΅ ΠΈΠ½ΡΡΡΡΠΌΠ΅Π½ΡΡ.' | |
89 | ' - Π‘ΠΏΠ°ΡΠΈΠ±ΠΎ, ΡΡΠ½.' |
|
90 | ' - Π‘ΠΏΠ°ΡΠΈΠ±ΠΎ, ΡΡΠ½.' | |
90 | DELACT 'ΠΠΎΠ΄Π°ΡΠΈΡΡ ΠΈΠ½ΡΡΡΡΠΌΠ΅Π½ΡΡ ΠΎΡΡΡ' |
|
91 | DELACT 'ΠΠΎΠ΄Π°ΡΠΈΡΡ ΠΈΠ½ΡΡΡΡΠΌΠ΅Π½ΡΡ ΠΎΡΡΡ' | |
91 | END |
|
92 | END | |
92 | END |
|
93 | END | |
93 | ACT 'ΠΠ΄ΡΠΈ Π² ΠΏΠΎΡΡ':GOTO 'Π Π°Π±ΠΎΡΠ°' |
|
94 | ACT 'ΠΠ΄ΡΠΈ Π² ΠΏΠΎΡΡ':GOTO 'Π Π°Π±ΠΎΡΠ°' | |
94 | ACT 'ΠΠ΄ΡΠΈ Π² ΠΌΠ°Π³Π°Π·ΠΈΠ½':GOTO 'ΠΠ°Π³Π°Π·ΠΈΠ½' |
|
95 | ACT 'ΠΠ΄ΡΠΈ Π² ΠΌΠ°Π³Π°Π·ΠΈΠ½':GOTO 'ΠΠ°Π³Π°Π·ΠΈΠ½' | |
95 | - |
|
96 | - |
@@ -1,114 +1,121 b'' | |||||
1 |
|
1 | |||
2 | .qsp-frame { |
|
2 | .qsp-frame { | |
3 | border: 1px solid black; |
|
3 | border: 1px solid black; | |
4 | overflow: auto; |
|
4 | overflow: auto; | |
5 | padding: 5px; |
|
5 | padding: 5px; | |
6 | box-sizing: border-box; |
|
6 | box-sizing: border-box; | |
7 | } |
|
7 | } | |
8 |
|
8 | |||
9 | #qsp { |
|
9 | #qsp { | |
10 | position: absolute; |
|
10 | position: absolute; | |
11 | display: flex; |
|
11 | display: flex; | |
12 | flex-flow: row; |
|
12 | flex-flow: row; | |
13 | top: 0; |
|
13 | top: 0; | |
14 | left: 0; |
|
14 | left: 0; | |
15 | width: 100%; |
|
15 | width: 100%; | |
16 | height: 100%; |
|
16 | height: 100%; | |
17 | } |
|
17 | } | |
18 |
|
18 | |||
19 | .qsp-col { |
|
19 | .qsp-col { | |
20 | display: flex; |
|
20 | display: flex; | |
21 | flex-flow: column; |
|
21 | flex-flow: column; | |
22 | } |
|
22 | } | |
23 |
|
23 | |||
24 | .qsp-col1 { |
|
24 | .qsp-col1 { | |
25 | flex: 7 7 70px; |
|
25 | flex: 7 7 70px; | |
26 | } |
|
26 | } | |
27 |
|
27 | |||
28 | .qsp-col2 { |
|
28 | .qsp-col2 { | |
29 | flex: 3 3 30px; |
|
29 | flex: 3 3 30px; | |
30 | } |
|
30 | } | |
31 |
|
31 | |||
32 | .qsp-col3 { |
|
32 | .qsp-col3 { | |
33 | flex: 0 0 40px; |
|
33 | flex: 0 0 40px; | |
34 | } |
|
34 | } | |
35 |
|
35 | |||
36 | #qsp-main { |
|
36 | #qsp-main { | |
37 | flex: 6 6 60px; |
|
37 | flex: 6 6 60px; | |
38 | } |
|
38 | } | |
39 |
|
39 | |||
40 | #qsp-acts { |
|
40 | #qsp-acts { | |
41 | flex: 4 4 40px; |
|
41 | flex: 4 4 40px; | |
42 | } |
|
42 | } | |
43 |
|
43 | |||
44 | #qsp-input { |
|
44 | #qsp-input { | |
45 | } |
|
45 | } | |
46 |
|
46 | |||
47 | #qsp-stat { |
|
47 | #qsp-stat { | |
48 | flex: 5 5 50px; |
|
48 | flex: 5 5 50px; | |
49 | } |
|
49 | } | |
50 |
|
50 | |||
51 | #qsp-objs { |
|
51 | #qsp-objs { | |
52 | flex: 5 5 50px; |
|
52 | flex: 5 5 50px; | |
53 | } |
|
53 | } | |
54 |
|
54 | |||
55 | .qsp-act { |
|
55 | .qsp-act { | |
56 | display: block; |
|
56 | display: block; | |
57 | padding: 2px; |
|
57 | padding: 2px; | |
58 | font-size: large; |
|
58 | font-size: large; | |
59 | } |
|
59 | } | |
60 |
|
60 | |||
61 | .qsp-act:hover { |
|
61 | .qsp-act:hover { | |
62 | outline: #9E9E9E outset 3px |
|
62 | outline: #9E9E9E outset 3px | |
63 | } |
|
63 | } | |
64 |
|
64 | |||
65 | /* Dropdown */ |
|
65 | /* Dropdown */ | |
66 |
|
66 | |||
67 | #qsp-dropdown { |
|
67 | #qsp-dropdown { | |
68 | display: none; |
|
68 | display: none; | |
69 | position: absolute; |
|
69 | position: absolute; | |
70 | background-color: #f1f1f1; |
|
70 | background-color: #f1f1f1; | |
71 | min-width: 160px; |
|
71 | min-width: 160px; | |
72 | overflow: auto; |
|
72 | overflow: auto; | |
73 | box-shadow: 0px 8px 16px 0px rgba(0,0,0,0.2); |
|
73 | box-shadow: 0px 8px 16px 0px rgba(0,0,0,0.2); | |
74 | z-index: 1; |
|
74 | z-index: 1; | |
75 | margin: auto; |
|
75 | margin: auto; | |
76 | top: 200; |
|
76 | top: 200; | |
77 | } |
|
77 | } | |
78 |
|
78 | |||
79 | #qsp-dropdown a { |
|
79 | #qsp-dropdown a { | |
80 | color: black; |
|
80 | color: black; | |
81 | padding: 12px 16px; |
|
81 | padding: 12px 16px; | |
82 | text-decoration: none; |
|
82 | text-decoration: none; | |
83 | display: block; |
|
83 | display: block; | |
84 | } |
|
84 | } | |
85 |
|
85 | |||
86 | #qsp-dropdown a:hover { |
|
86 | #qsp-dropdown a:hover { | |
87 | background-color: #ddd; |
|
87 | background-color: #ddd; | |
88 | } |
|
88 | } | |
89 |
|
89 | |||
90 | /* Buttons */ |
|
90 | /* Buttons */ | |
91 |
|
91 | |||
92 | .qsp-col3 a, .qsp-col3 img { |
|
92 | .qsp-col3 a, .qsp-col3 img { | |
93 | width: 50px; |
|
93 | width: 50px; | |
94 | height: 50px; |
|
94 | height: 50px; | |
95 | } |
|
95 | } | |
96 |
|
96 | |||
97 | #qsp-btn-save img { |
|
97 | #qsp-btn-save img { | |
98 | 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=='); |
|
98 | 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=='); | |
99 | } |
|
99 | } | |
100 |
|
100 | |||
101 | #qsp-btn-open img { |
|
101 | #qsp-btn-open img { | |
102 | 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'); |
|
102 | 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'); | |
103 | } |
|
103 | } | |
104 |
|
104 | |||
105 | #qsp-image-container { |
|
105 | #qsp-image-container { | |
106 | position: absolute; |
|
106 | position: absolute; | |
107 | top: 0; |
|
107 | top: 0; | |
108 | left: 0; |
|
108 | left: 0; | |
109 | height: 100%; |
|
109 | height: 100%; | |
110 | width: 100%; |
|
110 | width: 100%; | |
111 | display: none; |
|
111 | display: none; | |
112 | justify-content: center; |
|
112 | justify-content: center; | |
113 | align-items: center; |
|
113 | align-items: center; | |
114 | } |
|
114 | } | |
|
115 | ||||
|
116 | /* misc */ | |||
|
117 | ||||
|
118 | .disable a { | |||
|
119 | pointer-events: none; | |||
|
120 | cursor: default; | |||
|
121 | } |
@@ -1,407 +1,423 b'' | |||||
1 |
|
1 | |||
2 | (in-package sugar-qsp.api) |
|
2 | (in-package sugar-qsp.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='" (ps-inline call-act) "(\"" title "\");'>" |
|
12 | (+ "<a class='qsp-act' href='" (ps-inline call-act) "(\"" title "\");'>" | |
13 | title |
|
13 | title | |
14 | "</a>")) |
|
14 | "</a>")) | |
15 |
|
15 | |||
16 | (defun make-menu-item-html (num title img loc) |
|
16 | (defun make-menu-item-html (num title img loc) | |
17 | (+ "<a href='" (ps-inline run-menu) "(" num ", \"" loc "\")();'>" |
|
17 | (+ "<a href='" (ps-inline run-menu) "(" num ", \"" loc "\")();'>" | |
18 | "<img src='" img "'>" |
|
18 | "<img src='" img "'>" | |
19 | title |
|
19 | title | |
20 | "</a>")) |
|
20 | "</a>")) | |
21 |
|
21 | |||
22 | (defun report-error (text) |
|
22 | (defun report-error (text) | |
23 | (alert text)) |
|
23 | (alert text)) | |
24 |
|
24 | |||
|
25 | (defun start-sleeping () | |||
|
26 | (chain (by-id "qsp") class-list (add "disable")) | |||
|
27 | (setf (root sleeping) t)) | |||
|
28 | ||||
|
29 | (defun finish-sleeping () | |||
|
30 | (chain (by-id "qsp") class-list (remove "disable")) | |||
|
31 | (setf (root sleeping) nil)) | |||
|
32 | ||||
25 | (defun sleep (msec) |
|
33 | (defun sleep (msec) | |
26 | (new (*promise (=> resolve (set-timeout resolve msec))))) |
|
34 | (start-sleeping) | |
|
35 | (new (*promise | |||
|
36 | (lambda (resolve) | |||
|
37 | (set-timeout | |||
|
38 | (lambda () | |||
|
39 | (finish-sleeping) | |||
|
40 | (resolve)) | |||
|
41 | msec))))) | |||
27 |
|
42 | |||
28 | (defun init-dom () |
|
43 | (defun init-dom () | |
29 | ;; Save/load buttons |
|
44 | ;; Save/load buttons | |
30 | (let ((btn (by-id "qsp-btn-save"))) |
|
45 | (let ((btn (by-id "qsp-btn-save"))) | |
31 | (setf (@ btn onclick) savegame) |
|
46 | (setf (@ btn onclick) savegame) | |
32 | (setf (@ btn href) "#")) |
|
47 | (setf (@ btn href) "#")) | |
33 | (let ((btn (by-id "qsp-btn-open"))) |
|
48 | (let ((btn (by-id "qsp-btn-open"))) | |
34 | (setf (@ btn onclick) opengame) |
|
49 | (setf (@ btn onclick) opengame) | |
35 | (setf (@ btn href) "#")) |
|
50 | (setf (@ btn href) "#")) | |
36 | ;; Close image on click |
|
51 | ;; Close image on click | |
37 | (setf (@ (by-id "qsp-image-container") onclick) |
|
52 | (setf (@ (by-id "qsp-image-container") onclick) | |
38 | (show-image nil)) |
|
53 | (show-image nil)) | |
39 | ;; Close the dropdown on any click |
|
54 | ;; Close the dropdown on any click | |
40 | (setf (@ window onclick) |
|
55 | (setf (@ window onclick) | |
41 | (lambda (event) |
|
56 | (lambda (event) | |
42 | (setf (@ (get-frame :dropdown) style display) "none")))) |
|
57 | (setf (@ (get-frame :dropdown) style display) "none")))) | |
43 |
|
58 | |||
44 | (defun call-serv-loc (var-name &rest args) |
|
59 | (defun call-serv-loc (var-name &rest args) | |
45 | (let ((loc-name (get-var var-name 0 :str))) |
|
60 | (let ((loc-name (get-var var-name 0 :str))) | |
46 | (when loc-name |
|
61 | (when loc-name | |
47 | (let ((loc (getprop (root locs) loc-name))) |
|
62 | (let ((loc (getprop (root locs) loc-name))) | |
48 | (when loc |
|
63 | (when loc | |
49 | (funcall loc args)))))) |
|
64 | (funcall loc args)))))) | |
50 |
|
65 | |||
51 | ;;; Misc |
|
66 | ;;; Misc | |
52 |
|
67 | |||
53 | (defun newline (key) |
|
68 | (defun newline (key) | |
54 | (append-id (key-to-id key) "<br>" t)) |
|
69 | (append-id (key-to-id key) "<br>" t)) | |
55 |
|
70 | |||
56 | (defun clear-id (id) |
|
71 | (defun clear-id (id) | |
57 | (setf (inner-html (by-id id)) "")) |
|
72 | (setf (inner-html (by-id id)) "")) | |
58 |
|
73 | |||
59 | (defvar text-escaper (chain document (create-element :textarea))) |
|
74 | (defvar text-escaper (chain document (create-element :textarea))) | |
60 |
|
75 | |||
61 | (defun prepare-contents (s &optional force-html) |
|
76 | (defun prepare-contents (s &optional force-html) | |
62 | (if (or force-html (get-var "USEHTML" 0 :num)) |
|
77 | (if (or force-html (get-var "USEHTML" 0 :num)) | |
63 | s |
|
78 | s | |
64 | (progn |
|
79 | (progn | |
65 | (setf (@ text-escaper text-content) s) |
|
80 | (setf (@ text-escaper text-content) s) | |
66 | (inner-html text-escaper)))) |
|
81 | (inner-html text-escaper)))) | |
67 |
|
82 | |||
68 | (defun get-id (id &optional force-html) |
|
83 | (defun get-id (id &optional force-html) | |
69 | (inner-html (by-id id))) |
|
84 | (inner-html (by-id id))) | |
70 |
|
85 | |||
71 | (defun set-id (id contents &optional force-html) |
|
86 | (defun set-id (id contents &optional force-html) | |
72 | (setf (inner-html (by-id id)) (prepare-contents contents force-html))) |
|
87 | (setf (inner-html (by-id id)) (prepare-contents contents force-html))) | |
73 |
|
88 | |||
74 | (defun append-id (id contents &optional force-html) |
|
89 | (defun append-id (id contents &optional force-html) | |
75 | (when contents |
|
90 | (when contents | |
76 | (incf (inner-html (by-id id)) (prepare-contents contents force-html)))) |
|
91 | (incf (inner-html (by-id id)) (prepare-contents contents force-html)))) | |
77 |
|
92 | |||
78 | ;;; Function calls |
|
93 | ;;; Function calls | |
79 |
|
94 | |||
80 | (defun init-args (args) |
|
95 | (defun init-args (args) | |
81 | (dotimes (i (length args)) |
|
96 | (dotimes (i (length args)) | |
82 | (let ((arg (elt args i))) |
|
97 | (let ((arg (elt args i))) | |
83 | (if (numberp arg) |
|
98 | (if (numberp arg) | |
84 | (set-var args i :num arg) |
|
99 | (set-var args i :num arg) | |
85 | (set-var args i :str arg))))) |
|
100 | (set-var args i :str arg))))) | |
86 |
|
101 | |||
87 | (defun get-result () |
|
102 | (defun get-result () | |
88 | (if (not (equal "" (get-var "RESULT" 0 :str))) |
|
103 | (if (not (equal "" (get-var "RESULT" 0 :str))) | |
89 | (get-var "RESULT" 0 :str) |
|
104 | (get-var "RESULT" 0 :str) | |
90 | (get-var "RESULT" 0 :num))) |
|
105 | (get-var "RESULT" 0 :num))) | |
91 |
|
106 | |||
92 | (defun call-loc (name args) |
|
107 | (defun call-loc (name args) | |
93 | (with-frame |
|
108 | (with-frame | |
94 | (with-call-args args |
|
109 | (with-call-args args | |
95 | (funcall (getprop (root locs) name) args)))) |
|
110 | (funcall (getprop (root locs) name) args)))) | |
96 |
|
111 | |||
97 | (defun call-act (title) |
|
112 | (defun call-act (title) | |
|
113 | (unless (root sleeping) | |||
98 | (with-frame |
|
114 | (with-frame | |
99 | (funcall (getprop (root acts) title 'act)))) |
|
115 | (funcall (getprop (root acts) title 'act))))) | |
100 |
|
116 | |||
101 | ;;; Text windows |
|
117 | ;;; Text windows | |
102 |
|
118 | |||
103 | (defun key-to-id (key) |
|
119 | (defun key-to-id (key) | |
104 | (case key |
|
120 | (case key | |
105 | (:main "qsp-main") |
|
121 | (:main "qsp-main") | |
106 | (:stat "qsp-stat") |
|
122 | (:stat "qsp-stat") | |
107 | (:objs "qsp-objs") |
|
123 | (:objs "qsp-objs") | |
108 | (:acts "qsp-acts") |
|
124 | (:acts "qsp-acts") | |
109 | (:input "qsp-input") |
|
125 | (:input "qsp-input") | |
110 | (:dropdown "qsp-dropdown") |
|
126 | (:dropdown "qsp-dropdown") | |
111 | (t (report-error "Internal error!")))) |
|
127 | (t (report-error "Internal error!")))) | |
112 |
|
128 | |||
113 | (defun get-frame (key) |
|
129 | (defun get-frame (key) | |
114 | (by-id (key-to-id key))) |
|
130 | (by-id (key-to-id key))) | |
115 |
|
131 | |||
116 | (defun add-text (key text) |
|
132 | (defun add-text (key text) | |
117 | (append-id (key-to-id key) text)) |
|
133 | (append-id (key-to-id key) text)) | |
118 |
|
134 | |||
119 | (defun get-text (key) |
|
135 | (defun get-text (key) | |
120 | (get-id (key-to-id key))) |
|
136 | (get-id (key-to-id key))) | |
121 |
|
137 | |||
122 | (defun clear-text (key) |
|
138 | (defun clear-text (key) | |
123 | (clear-id (key-to-id key))) |
|
139 | (clear-id (key-to-id key))) | |
124 |
|
140 | |||
125 | (defun enable-frame (key enable) |
|
141 | (defun enable-frame (key enable) | |
126 | (let ((obj (get-frame key))) |
|
142 | (let ((obj (get-frame key))) | |
127 | (setf (@ obj style display) (if enable "block" "none")) |
|
143 | (setf (@ obj style display) (if enable "block" "none")) | |
128 | (void))) |
|
144 | (void))) | |
129 |
|
145 | |||
130 | ;;; Actions |
|
146 | ;;; Actions | |
131 |
|
147 | |||
132 | (defun add-act (title img act) |
|
148 | (defun add-act (title img act) | |
133 | (setf (getprop (root acts) title) |
|
149 | (setf (getprop (root acts) title) | |
134 | (create img img act act)) |
|
150 | (create img img act act)) | |
135 | (update-acts)) |
|
151 | (update-acts)) | |
136 |
|
152 | |||
137 | (defun del-act (title) |
|
153 | (defun del-act (title) | |
138 | (delete (getprop (root acts) title)) |
|
154 | (delete (getprop (root acts) title)) | |
139 | (update-acts)) |
|
155 | (update-acts)) | |
140 |
|
156 | |||
141 | (defun clear-act () |
|
157 | (defun clear-act () | |
142 | (setf (root acts) (create)) |
|
158 | (setf (root acts) (create)) | |
143 | (clear-id "qsp-acts")) |
|
159 | (clear-id "qsp-acts")) | |
144 |
|
160 | |||
145 | (defun update-acts () |
|
161 | (defun update-acts () | |
146 | (clear-id "qsp-acts") |
|
162 | (clear-id "qsp-acts") | |
147 | (let ((elt (by-id "qsp-acts"))) |
|
163 | (let ((elt (by-id "qsp-acts"))) | |
148 | (for-in (title (root acts)) |
|
164 | (for-in (title (root acts)) | |
149 | (let ((obj (getprop (root acts) title))) |
|
165 | (let ((obj (getprop (root acts) title))) | |
150 | (incf (inner-html elt) (make-act-html title (getprop obj :img))))))) |
|
166 | (incf (inner-html elt) (make-act-html title (getprop obj :img))))))) | |
151 |
|
167 | |||
152 |
|
168 | |||
153 | ;;; "Syntax" |
|
169 | ;;; "Syntax" | |
154 |
|
170 | |||
155 | (defun qspfor (name index from to step body) |
|
171 | (defun qspfor (name index from to step body) | |
156 | (for ((i from)) |
|
172 | (for ((i from)) | |
157 | ((< i to)) |
|
173 | ((< i to)) | |
158 | ((incf i step)) |
|
174 | ((incf i step)) | |
159 | (set-var name index :num i) |
|
175 | (set-var name index :num i) | |
160 | (unless (funcall body) |
|
176 | (unless (funcall body) | |
161 | (return-from qspfor)))) |
|
177 | (return-from qspfor)))) | |
162 |
|
178 | |||
163 | ;;; Variable class |
|
179 | ;;; Variable class | |
164 |
|
180 | |||
165 | (defun *var (name) |
|
181 | (defun *var (name) | |
166 | ;; From strings to numbers |
|
182 | ;; From strings to numbers | |
167 | (setf (@ this indexes) (create)) |
|
183 | (setf (@ this indexes) (create)) | |
168 | ;; From numbers to {num: 0, str: ""} objects |
|
184 | ;; From numbers to {num: 0, str: ""} objects | |
169 | (setf (@ this values) (list)) |
|
185 | (setf (@ this values) (list)) | |
170 | (void)) |
|
186 | (void)) | |
171 |
|
187 | |||
172 | (defun new-value () |
|
188 | (defun new-value () | |
173 | (create :num 0 :str "")) |
|
189 | (create :num 0 :str "")) | |
174 |
|
190 | |||
175 | (setf (@ *var prototype index-num) |
|
191 | (setf (@ *var prototype index-num) | |
176 | (lambda (index) |
|
192 | (lambda (index) | |
177 | (let ((num-index |
|
193 | (let ((num-index | |
178 | (if (stringp index) |
|
194 | (if (stringp index) | |
179 | (if (in index (@ this indexes)) |
|
195 | (if (in index (@ this indexes)) | |
180 | (getprop (@ this indexes) index) |
|
196 | (getprop (@ this indexes) index) | |
181 | (let ((n (length (@ this values)))) |
|
197 | (let ((n (length (@ this values)))) | |
182 | (setf (getprop (@ this indexes) index) n) |
|
198 | (setf (getprop (@ this indexes) index) n) | |
183 | n)) |
|
199 | n)) | |
184 | index))) |
|
200 | index))) | |
185 | (unless (in num-index (@ this values)) |
|
201 | (unless (in num-index (@ this values)) | |
186 | (setf (elt (@ this values) num-index) (new-value))) |
|
202 | (setf (elt (@ this values) num-index) (new-value))) | |
187 | num-index))) |
|
203 | num-index))) | |
188 |
|
204 | |||
189 | (setf (@ *var prototype get) |
|
205 | (setf (@ *var prototype get) | |
190 | (lambda (index slot) |
|
206 | (lambda (index slot) | |
191 | (unless (or index (= 0 index)) |
|
207 | (unless (or index (= 0 index)) | |
192 | (setf index (1- (length (@ this values))))) |
|
208 | (setf index (1- (length (@ this values))))) | |
193 | (getprop (@ this values) (chain this (index-num index)) slot))) |
|
209 | (getprop (@ this values) (chain this (index-num index)) slot))) | |
194 |
|
210 | |||
195 | (setf (@ *var prototype set) |
|
211 | (setf (@ *var prototype set) | |
196 | (lambda (index slot value) |
|
212 | (lambda (index slot value) | |
197 | (unless (or index (= 0 index)) |
|
213 | (unless (or index (= 0 index)) | |
198 | (setf index (length (@ this values)))) |
|
214 | (setf index (length (@ this values)))) | |
199 | (case slot |
|
215 | (case slot | |
200 | (:num (setf value (chain *number (parse-int value)))) |
|
216 | (:num (setf value (chain *number (parse-int value)))) | |
201 | (:str (setf value (chain value (to-string))))) |
|
217 | (:str (setf value (chain value (to-string))))) | |
202 | (setf (getprop (@ this values) |
|
218 | (setf (getprop (@ this values) | |
203 | (chain this (index-num index)) |
|
219 | (chain this (index-num index)) | |
204 | slot) value) |
|
220 | slot) value) | |
205 | (void))) |
|
221 | (void))) | |
206 |
|
222 | |||
207 | (setf (@ *var prototype kill) |
|
223 | (setf (@ *var prototype kill) | |
208 | (lambda (index) |
|
224 | (lambda (index) | |
209 | (setf (elt (@ this values) (chain this (index-num index))) |
|
225 | (setf (elt (@ this values) (chain this (index-num index))) | |
210 | (new-value)) |
|
226 | (new-value)) | |
211 | (delete (getprop 'this 'indexes index)))) |
|
227 | (delete (getprop 'this 'indexes index)))) | |
212 |
|
228 | |||
213 | ;;; Variables |
|
229 | ;;; Variables | |
214 |
|
230 | |||
215 | (defun var-real-name (name) |
|
231 | (defun var-real-name (name) | |
216 | (if (= (@ name 0) #\$) |
|
232 | (if (= (@ name 0) #\$) | |
217 | (values (chain name (substr 1)) :str) |
|
233 | (values (chain name (substr 1)) :str) | |
218 | (values name :num))) |
|
234 | (values name :num))) | |
219 |
|
235 | |||
220 | (defun ensure-var (name) |
|
236 | (defun ensure-var (name) | |
221 | (let ((store (var-ref name))) |
|
237 | (let ((store (var-ref name))) | |
222 | (unless store |
|
238 | (unless store | |
223 | (setf store (new (*var name))) |
|
239 | (setf store (new (*var name))) | |
224 | (setf (getprop (root vars) name) store)) |
|
240 | (setf (getprop (root vars) name) store)) | |
225 | store)) |
|
241 | store)) | |
226 |
|
242 | |||
227 | (defun var-ref (name) |
|
243 | (defun var-ref (name) | |
228 | (let ((local-store (current-local-frame))) |
|
244 | (let ((local-store (current-local-frame))) | |
229 | (cond ((and local-store (in name local-store)) |
|
245 | (cond ((and local-store (in name local-store)) | |
230 | (getprop local-store name)) |
|
246 | (getprop local-store name)) | |
231 | ((in name (root vars)) |
|
247 | ((in name (root vars)) | |
232 | (getprop (root vars) name)) |
|
248 | (getprop (root vars) name)) | |
233 | (t nil)))) |
|
249 | (t nil)))) | |
234 |
|
250 | |||
235 | (defun get-var (name index slot) |
|
251 | (defun get-var (name index slot) | |
236 | (chain (ensure-var name) (get index slot))) |
|
252 | (chain (ensure-var name) (get index slot))) | |
237 |
|
253 | |||
238 | (defun set-var (name index slot value) |
|
254 | (defun set-var (name index slot value) | |
239 | (chain (ensure-var name) (set index slot value)) |
|
255 | (chain (ensure-var name) (set index slot value)) | |
240 | (void)) |
|
256 | (void)) | |
241 |
|
257 | |||
242 | (defun get-array (name) |
|
258 | (defun get-array (name) | |
243 | (var-ref name)) |
|
259 | (var-ref name)) | |
244 |
|
260 | |||
245 | (defun set-array (name value) |
|
261 | (defun set-array (name value) | |
246 | (let ((store (var-ref name))) |
|
262 | (let ((store (var-ref name))) | |
247 | (setf (@ store values) (@ value values)) |
|
263 | (setf (@ store values) (@ value values)) | |
248 | (setf (@ store indexes) (@ value indexes))) |
|
264 | (setf (@ store indexes) (@ value indexes))) | |
249 | (void)) |
|
265 | (void)) | |
250 |
|
266 | |||
251 | (defun kill-var (name &optional index) |
|
267 | (defun kill-var (name &optional index) | |
252 | (if (and index (not (= 0 index))) |
|
268 | (if (and index (not (= 0 index))) | |
253 | (chain (getprop (root vars) name) (kill index)) |
|
269 | (chain (getprop (root vars) name) (kill index)) | |
254 | (delete (getprop (root vars) name))) |
|
270 | (delete (getprop (root vars) name))) | |
255 | (void)) |
|
271 | (void)) | |
256 |
|
272 | |||
257 | (defun array-size (name) |
|
273 | (defun array-size (name) | |
258 | (getprop (var-ref name) 'length)) |
|
274 | (getprop (var-ref name) 'length)) | |
259 |
|
275 | |||
260 | ;;; Locals |
|
276 | ;;; Locals | |
261 |
|
277 | |||
262 | (defun push-local-frame () |
|
278 | (defun push-local-frame () | |
263 | (chain (root locals) (push (create))) |
|
279 | (chain (root locals) (push (create))) | |
264 | (void)) |
|
280 | (void)) | |
265 |
|
281 | |||
266 | (defun pop-local-frame () |
|
282 | (defun pop-local-frame () | |
267 | (chain (root locals) (pop)) |
|
283 | (chain (root locals) (pop)) | |
268 | (void)) |
|
284 | (void)) | |
269 |
|
285 | |||
270 | (defun current-local-frame () |
|
286 | (defun current-local-frame () | |
271 | (elt (root locals) (1- (length (root locals))))) |
|
287 | (elt (root locals) (1- (length (root locals))))) | |
272 |
|
288 | |||
273 | (defun new-local (name) |
|
289 | (defun new-local (name) | |
274 | (let ((frame (current-local-frame))) |
|
290 | (let ((frame (current-local-frame))) | |
275 | (unless (in name frame) |
|
291 | (unless (in name frame) | |
276 | (setf (getprop frame name) (create))) |
|
292 | (setf (getprop frame name) (create))) | |
277 | (void))) |
|
293 | (void))) | |
278 |
|
294 | |||
279 | ;;; Objects |
|
295 | ;;; Objects | |
280 |
|
296 | |||
281 | (defun update-objs () |
|
297 | (defun update-objs () | |
282 | (let ((elt (by-id "qsp-objs"))) |
|
298 | (let ((elt (by-id "qsp-objs"))) | |
283 | (setf (inner-html elt) "<ul>") |
|
299 | (setf (inner-html elt) "<ul>") | |
284 | (loop :for obj :in (root objs) |
|
300 | (loop :for obj :in (root objs) | |
285 | :do (incf (inner-html elt) (+ "<li>" obj))) |
|
301 | :do (incf (inner-html elt) (+ "<li>" obj))) | |
286 | (incf (inner-html elt) "</ul>"))) |
|
302 | (incf (inner-html elt) "</ul>"))) | |
287 |
|
303 | |||
288 | ;;; Menu |
|
304 | ;;; Menu | |
289 |
|
305 | |||
290 | (defun menu (menu-data) |
|
306 | (defun menu (menu-data) | |
291 | (let ((elt (by-id "qsp-dropdown")) |
|
307 | (let ((elt (by-id "qsp-dropdown")) | |
292 | (i 0)) |
|
308 | (i 0)) | |
293 | (setf (inner-html elt) "") |
|
309 | (setf (inner-html elt) "") | |
294 | (loop :for item :in menu-data |
|
310 | (loop :for item :in menu-data | |
295 | :do (incf i) |
|
311 | :do (incf i) | |
296 | :do (incf (inner-html elt) (make-menu-item-html i |
|
312 | :do (incf (inner-html elt) (make-menu-item-html i | |
297 | (@ item text) |
|
313 | (@ item text) | |
298 | (@ item icon) |
|
314 | (@ item icon) | |
299 | (@ item loc)))) |
|
315 | (@ item loc)))) | |
300 | (setf (@ elt style display) "block"))) |
|
316 | (setf (@ elt style display) "block"))) | |
301 |
|
317 | |||
302 | ;;; Content |
|
318 | ;;; Content | |
303 |
|
319 | |||
304 | (defun clean-audio () |
|
320 | (defun clean-audio () | |
305 | (loop :for k :in (chain *object (keys (root playing))) |
|
321 | (loop :for k :in (chain *object (keys (root playing))) | |
306 | :for v := (getprop (root playing) k) |
|
322 | :for v := (getprop (root playing) k) | |
307 | :do (when (@ v ended) |
|
323 | :do (when (@ v ended) | |
308 | (delete (@ (root playing) k))))) |
|
324 | (delete (@ (root playing) k))))) | |
309 |
|
325 | |||
310 | (defun show-image (path) |
|
326 | (defun show-image (path) | |
311 | (let ((img (by-id "qsp-image"))) |
|
327 | (let ((img (by-id "qsp-image"))) | |
312 | (cond (path |
|
328 | (cond (path | |
313 | (setf (@ img src) path) |
|
329 | (setf (@ img src) path) | |
314 | (setf (@ img style display) "flex")) |
|
330 | (setf (@ img style display) "flex")) | |
315 | (t |
|
331 | (t | |
316 | (setf (@ img src) "") |
|
332 | (setf (@ img src) "") | |
317 | (setf (@ img style display) "hidden"))))) |
|
333 | (setf (@ img style display) "hidden"))))) | |
318 |
|
334 | |||
319 | ;;; Saves |
|
335 | ;;; Saves | |
320 |
|
336 | |||
321 | (defun opengame () |
|
337 | (defun opengame () | |
322 | (let ((element (chain document (create-element :input)))) |
|
338 | (let ((element (chain document (create-element :input)))) | |
323 | (chain element (set-attribute :type :file)) |
|
339 | (chain element (set-attribute :type :file)) | |
324 | (chain element (set-attribute :id :qsp-opengame)) |
|
340 | (chain element (set-attribute :id :qsp-opengame)) | |
325 | (chain element (set-attribute :tabindex -1)) |
|
341 | (chain element (set-attribute :tabindex -1)) | |
326 | (chain element (set-attribute "aria-hidden" t)) |
|
342 | (chain element (set-attribute "aria-hidden" t)) | |
327 | (setf (@ element style display) :block) |
|
343 | (setf (@ element style display) :block) | |
328 | (setf (@ element style visibility) :hidden) |
|
344 | (setf (@ element style visibility) :hidden) | |
329 | (setf (@ element style position) :fixed) |
|
345 | (setf (@ element style position) :fixed) | |
330 | (setf (@ element onchange) |
|
346 | (setf (@ element onchange) | |
331 | (lambda (event) |
|
347 | (lambda (event) | |
332 | (let* ((file (@ event target files 0)) |
|
348 | (let* ((file (@ event target files 0)) | |
333 | (reader (new (*file-reader)))) |
|
349 | (reader (new (*file-reader)))) | |
334 | (setf (@ reader onload) |
|
350 | (setf (@ reader onload) | |
335 | (lambda (ev) |
|
351 | (lambda (ev) | |
336 | (block nil |
|
352 | (block nil | |
337 | (let ((target (@ ev current-target))) |
|
353 | (let ((target (@ ev current-target))) | |
338 | (unless (@ target result) |
|
354 | (unless (@ target result) | |
339 | (return)) |
|
355 | (return)) | |
340 | (base64-to-state (@ target result)) |
|
356 | (base64-to-state (@ target result)) | |
341 | (unstash-state))))) |
|
357 | (unstash-state))))) | |
342 | (chain reader (read-as-text file))))) |
|
358 | (chain reader (read-as-text file))))) | |
343 | (chain document body (append-child element)) |
|
359 | (chain document body (append-child element)) | |
344 | (chain element (click)) |
|
360 | (chain element (click)) | |
345 | (chain document body (remove-child element)))) |
|
361 | (chain document body (remove-child element)))) | |
346 |
|
362 | |||
347 | (defun savegame () |
|
363 | (defun savegame () | |
348 | (let ((element (chain document (create-element :a)))) |
|
364 | (let ((element (chain document (create-element :a)))) | |
349 | (chain element (set-attribute :href (+ "data:text/plain;charset=utf-8," (state-to-base64)))) |
|
365 | (chain element (set-attribute :href (+ "data:text/plain;charset=utf-8," (state-to-base64)))) | |
350 | (chain element (set-attribute :download "savegame.sav")) |
|
366 | (chain element (set-attribute :download "savegame.sav")) | |
351 | (setf (@ element style display) :none) |
|
367 | (setf (@ element style display) :none) | |
352 | (chain document body (append-child element)) |
|
368 | (chain document body (append-child element)) | |
353 | (chain element (click)) |
|
369 | (chain element (click)) | |
354 | (chain document body (remove-child element)))) |
|
370 | (chain document body (remove-child element)))) | |
355 |
|
371 | |||
356 | (defun stash-state (args) |
|
372 | (defun stash-state (args) | |
357 | (call-serv-loc "ONGSAVE") |
|
373 | (call-serv-loc "ONGSAVE") | |
358 | (setf (root state-stash) |
|
374 | (setf (root state-stash) | |
359 | (chain *j-s-o-n (stringify |
|
375 | (chain *j-s-o-n (stringify | |
360 | (create :vars (root vars) |
|
376 | (create :vars (root vars) | |
361 | :objs (root objs) |
|
377 | :objs (root objs) | |
362 | :loc-args args |
|
378 | :loc-args args | |
363 | :msecs (- (chain *date (now)) (root started-at)) |
|
379 | :msecs (- (chain *date (now)) (root started-at)) | |
364 | :timer-interval (root timer-interval) |
|
380 | :timer-interval (root timer-interval) | |
365 | :main-html (inner-html |
|
381 | :main-html (inner-html | |
366 | (by-id :qsp-main)) |
|
382 | (by-id :qsp-main)) | |
367 | :stat-html (inner-html |
|
383 | :stat-html (inner-html | |
368 | (by-id :qsp-stat)) |
|
384 | (by-id :qsp-stat)) | |
369 | :next-location (root current-location))))) |
|
385 | :next-location (root current-location))))) | |
370 | (void)) |
|
386 | (void)) | |
371 |
|
387 | |||
372 | (defun unstash-state () |
|
388 | (defun unstash-state () | |
373 | (let ((data (chain *j-s-o-n (parse (root state-stash))))) |
|
389 | (let ((data (chain *j-s-o-n (parse (root state-stash))))) | |
374 | (clear-act) |
|
390 | (clear-act) | |
375 | (setf (root vars) (@ data :vars)) |
|
391 | (setf (root vars) (@ data :vars)) | |
376 | (loop :for k :in (chain *object (keys (root vars))) |
|
392 | (loop :for k :in (chain *object (keys (root vars))) | |
377 | :do (chain *object (set-prototype-of (getprop (root vars) k) |
|
393 | :do (chain *object (set-prototype-of (getprop (root vars) k) | |
378 | (@ *var prototype)))) |
|
394 | (@ *var prototype)))) | |
379 | (setf (root started-at) (- (chain *date (now)) (@ data :msecs))) |
|
395 | (setf (root started-at) (- (chain *date (now)) (@ data :msecs))) | |
380 | (setf (root objs) (@ data :objs)) |
|
396 | (setf (root objs) (@ data :objs)) | |
381 | (setf (root current-location) (@ data :next-location)) |
|
397 | (setf (root current-location) (@ data :next-location)) | |
382 | (setf (inner-html (by-id :qsp-main)) |
|
398 | (setf (inner-html (by-id :qsp-main)) | |
383 | (@ data :main-html)) |
|
399 | (@ data :main-html)) | |
384 | (setf (inner-html (by-id :qsp-stat)) |
|
400 | (setf (inner-html (by-id :qsp-stat)) | |
385 | (@ data :stat-html)) |
|
401 | (@ data :stat-html)) | |
386 | (update-objs) |
|
402 | (update-objs) | |
387 | (set-timer (@ data :timer-interval)) |
|
403 | (set-timer (@ data :timer-interval)) | |
388 | (call-serv-loc "ONGLOAD") |
|
404 | (call-serv-loc "ONGLOAD") | |
389 | (call-loc (root current-location) (@ data :loc-args)) |
|
405 | (call-loc (root current-location) (@ data :loc-args)) | |
390 | (void))) |
|
406 | (void))) | |
391 |
|
407 | |||
392 | (defun state-to-base64 () |
|
408 | (defun state-to-base64 () | |
393 | (btoa (encode-u-r-i-component (root state-stash)))) |
|
409 | (btoa (encode-u-r-i-component (root state-stash)))) | |
394 |
|
410 | |||
395 | (defun base64-to-state (data) |
|
411 | (defun base64-to-state (data) | |
396 | (setf (root state-stash) (decode-u-r-i-component (atob data)))) |
|
412 | (setf (root state-stash) (decode-u-r-i-component (atob data)))) | |
397 |
|
413 | |||
398 | ;;; Timers |
|
414 | ;;; Timers | |
399 |
|
415 | |||
400 | (defun set-timer (interval) |
|
416 | (defun set-timer (interval) | |
401 | (setf (root timer-interval) interval) |
|
417 | (setf (root timer-interval) interval) | |
402 | (clear-interval (root timer-obj)) |
|
418 | (clear-interval (root timer-obj)) | |
403 | (setf (root timer-obj) |
|
419 | (setf (root timer-obj) | |
404 | (set-interval |
|
420 | (set-interval | |
405 | (lambda () |
|
421 | (lambda () | |
406 | (call-serv-loc "COUNTER")) |
|
422 | (call-serv-loc "COUNTER")) | |
407 | interval))) |
|
423 | interval))) |
@@ -1,38 +1,39 b'' | |||||
1 |
|
1 | |||
2 | (in-package sugar-qsp.js) |
|
2 | (in-package sugar-qsp.js) | |
3 |
|
3 | |||
4 | ;;; Contains symbols from standard JS library to avoid obfuscating |
|
4 | ;;; Contains symbols from standard JS library to avoid obfuscating | |
5 | ;;; and/or namespacing them |
|
5 | ;;; and/or namespacing them | |
6 |
|
6 | |||
7 | (cl:defmacro syms (cl:&rest syms) |
|
7 | (cl:defmacro syms (cl:&rest syms) | |
8 | `(cl:progn |
|
8 | `(cl:progn | |
9 | ,@(cl:loop :for sym :in syms |
|
9 | ,@(cl:loop :for sym :in syms | |
10 | :collect `(cl:export ',sym)))) |
|
10 | :collect `(cl:export ',sym)))) | |
11 |
|
11 | |||
12 | (syms |
|
12 | (syms | |
13 | ;; main |
|
13 | ;; main | |
14 | window |
|
14 | window | |
15 | *object |
|
15 | *object | |
16 | now |
|
16 | now | |
17 | onload |
|
17 | onload | |
18 | keys includes |
|
18 | keys includes | |
19 | has-own-property |
|
19 | has-own-property | |
20 | ;; api |
|
20 | ;; api | |
21 | document get-element-by-id |
|
21 | document get-element-by-id | |
22 | onclick onchange |
|
22 | onclick onchange | |
23 | atob btoa |
|
23 | atob btoa | |
24 | alert prompt |
|
24 | alert prompt | |
25 | set-timeout set-interval clear-interval |
|
25 | set-timeout set-interval clear-interval | |
26 | *promise *j-s-o-n |
|
26 | *promise *j-s-o-n | |
27 | href parse |
|
27 | href parse | |
28 | set-prototype-of |
|
28 | set-prototype-of | |
29 | body append-child remove-child |
|
29 | body append-child remove-child | |
30 | create-element set-attribute |
|
30 | add ; remove (is already in COMMON-LISP) | |
|
31 | create-element set-attribute class-list | |||
31 | *file-reader read-as-text |
|
32 | *file-reader read-as-text | |
32 | style display src |
|
33 | style display src | |
33 | ;; lib |
|
34 | ;; lib | |
34 | *number parse-int |
|
35 | *number parse-int | |
35 | to-upper-case concat |
|
36 | to-upper-case concat | |
36 | click target current-target files index-of result |
|
37 | click target current-target files index-of result | |
37 | decode-u-r-i-component splice |
|
38 | decode-u-r-i-component splice | |
38 | ) |
|
39 | ) |
@@ -1,69 +1,69 b'' | |||||
1 |
|
1 | |||
2 | (in-package parenscript) |
|
2 | (in-package parenscript) | |
3 |
|
3 | |||
4 | ;;; async/await |
|
4 | ;;; async/await | |
5 |
|
5 | |||
6 | (defprinter ps-js::await (x) |
|
6 | (defprinter ps-js::await (x) | |
7 | (psw (string-downcase "await ")) |
|
7 | (psw (string-downcase "await ")) | |
8 | (print-op-argument 'ps-js::await x)) |
|
8 | (print-op-argument 'ps-js::await x)) | |
9 |
|
9 | |||
10 | (define-trivial-special-ops await) |
|
10 | (define-trivial-special-ops await ps-js::await) | |
11 |
|
11 | |||
12 | (define-statement-operator async-defun (name lambda-list &rest body) |
|
12 | (define-statement-operator async-defun (name lambda-list &rest body) | |
13 | (multiple-value-bind (effective-args body-block docstring) |
|
13 | (multiple-value-bind (effective-args body-block docstring) | |
14 | (compile-named-function-body name lambda-list body) |
|
14 | (compile-named-function-body name lambda-list body) | |
15 | (list 'ps-js::async-defun name effective-args docstring body-block))) |
|
15 | (list 'ps-js::async-defun name effective-args docstring body-block))) | |
16 |
|
16 | |||
17 | (defprinter ps-js::async-defun (name args docstring body-block) |
|
17 | (defprinter ps-js::async-defun (name args docstring body-block) | |
18 | (when docstring (print-comment docstring)) |
|
18 | (when docstring (print-comment docstring)) | |
19 | (psw "async ") |
|
19 | (psw "async ") | |
20 | (print-fun-def name args body-block)) |
|
20 | (print-fun-def name args body-block)) | |
21 |
|
21 | |||
22 | (define-expression-operator async-lambda (lambda-list &rest body) |
|
22 | (define-expression-operator async-lambda (lambda-list &rest body) | |
23 | (multiple-value-bind (effective-args effective-body) |
|
23 | (multiple-value-bind (effective-args effective-body) | |
24 | (parse-extended-function lambda-list body) |
|
24 | (parse-extended-function lambda-list body) | |
25 | `(ps-js::async-lambda |
|
25 | `(ps-js::async-lambda | |
26 | ,effective-args |
|
26 | ,effective-args | |
27 | ,(let ((*function-block-names* ())) |
|
27 | ,(let ((*function-block-names* ())) | |
28 | (compile-function-body effective-args effective-body))))) |
|
28 | (compile-function-body effective-args effective-body))))) | |
29 |
|
29 | |||
30 | (defprinter ps-js::async-lambda (args body-block) |
|
30 | (defprinter ps-js::async-lambda (args body-block) | |
31 | (psw "async ") |
|
31 | (psw "async ") | |
32 | (print-fun-def nil args body-block)) |
|
32 | (print-fun-def nil args body-block)) | |
33 |
|
33 | |||
34 | (cl:export 'await) |
|
34 | (cl:export 'await) | |
35 | (cl:export 'async-defun) |
|
35 | (cl:export 'async-defun) | |
36 | (cl:export 'async-lambda) |
|
36 | (cl:export 'async-lambda) | |
37 |
|
37 | |||
38 | ;;; ES6 |
|
38 | ;;; ES6 | |
39 |
|
39 | |||
40 | (define-expression-operator => (lambda-list &rest body) |
|
40 | (define-expression-operator => (lambda-list &rest body) | |
41 | (unless (listp lambda-list) |
|
41 | (unless (listp lambda-list) | |
42 | (setf lambda-list (list lambda-list))) |
|
42 | (setf lambda-list (list lambda-list))) | |
43 | (multiple-value-bind (effective-args effective-body) |
|
43 | (multiple-value-bind (effective-args effective-body) | |
44 | (parse-extended-function lambda-list body) |
|
44 | (parse-extended-function lambda-list body) | |
45 | `(ps-js::=> |
|
45 | `(ps-js::=> | |
46 | ,effective-args |
|
46 | ,effective-args | |
47 | ,(let ((*function-block-names* ())) |
|
47 | ,(let ((*function-block-names* ())) | |
48 | (compile-function-body effective-args effective-body))))) |
|
48 | (compile-function-body effective-args effective-body))))) | |
49 |
|
49 | |||
50 | (defprinter ps-js::=> (args body) |
|
50 | (defprinter ps-js::=> (args body) | |
51 | (unless (= 1 (length args)) |
|
51 | (unless (= 1 (length args)) | |
52 | (psw "(")) |
|
52 | (psw "(")) | |
53 | (loop for (arg . remaining) on args do |
|
53 | (loop for (arg . remaining) on args do | |
54 | (psw (symbol-to-js-string arg)) (when remaining (psw ", "))) |
|
54 | (psw (symbol-to-js-string arg)) (when remaining (psw ", "))) | |
55 | (unless (= 1 (length args)) |
|
55 | (unless (= 1 (length args)) | |
56 | (psw ")")) |
|
56 | (psw ")")) | |
57 | (psw " => ") |
|
57 | (psw " => ") | |
58 | (ps-print body)) |
|
58 | (ps-print body)) | |
59 |
|
59 | |||
60 | (cl:export '=>) |
|
60 | (cl:export '=>) | |
61 |
|
61 | |||
62 | ;;; Actually return nothing (with no empty return) |
|
62 | ;;; Actually return nothing (with no empty return) | |
63 | (defvar *old-return-result-of* (function return-result-of)) |
|
63 | (defvar *old-return-result-of* (function return-result-of)) | |
64 |
|
64 | |||
65 | (defun return-result-of (tag form) |
|
65 | (defun return-result-of (tag form) | |
66 | (if (equal form '(void)) |
|
66 | (if (equal form '(void)) | |
67 | nil |
|
67 | nil | |
68 | (funcall *old-return-result-of* tag form))) |
|
68 | (funcall *old-return-result-of* tag form))) | |
69 | (export 'void) |
|
69 | (export 'void) |
General Comments 0
You need to be logged in to leave comments.
Login now