##// END OF EJS Templates
Working WAIT without busy-wait
naryl -
r29:f8046447 default
parent child Browse files
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 IF Π―Ρ‰ΠΈΠΊ = 3:
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