Show More
@@ -1,96 +1,97 b'' | |||
|
1 | 1 | |
|
2 | 2 | # start |
|
3 | 3 | USEHTML=1 |
|
4 | BCOLOR = RGB(255, 255, 255) | |
|
4 | 5 | '<center><font size="20" color="#FF0000" face="Times New Roman"><b>Π’Π΅ΠΊΡΡΠΎΠ²ΡΠΉ ΠΊΠ²Π΅ΡΡ</b></font></center><br>' |
|
5 | 6 | ' <b>ΠΠ°ΡΠ° ΡΠ΅Π»Ρ</b> - Π·Π°ΡΠ°Π±Π°ΡΡΠ²Π°ΡΡ <i>Π΄Π΅Π½ΡΠ³ΠΈ</i>, ΠΏΠΎΠΊΡΠΏΠ°ΡΡ Π½Π° Π½ΠΈΡ <i>ΠΏΠΎΠ΄Π°ΡΠΊΠΈ</i> ΠΈ Π΄Π°ΡΠΈΡΡ ΡΠ²ΠΎΠΈΠΌ <i>Π±Π»ΠΈΠ·ΠΊΠΈΠΌ</i>.' |
|
6 | 7 | ACT '<b>ΠΠ°ΡΠ°ΡΡ ΠΈΠ³ΡΡ</b>':GOTO 'ΠΠΎΠΌ' |
|
7 | 8 | - |
|
8 | 9 | #Π Π°Π±ΠΎΡΠ° |
|
9 | 10 | '<center><b>ΠΠΎΡΡ</b></center><br>' |
|
10 | 11 | ' ΠΠΎΡΡ Π½Π°Ρ ΠΎΠ΄ΠΈΡΡΡ Π½Π° ΡΠ°ΠΌΠΎΠΉ ΡΠΆΠ½ΠΎΠΉ ΠΎΠΊΡΠ°ΠΈΠ½Π΅ Π³ΠΎΡΠΎΠ΄Π°. ΠΠ΄Π΅ΡΡ ΠΏΠΎΡΡΠΎΡΠ½Π½ΠΎ Π·Π°Π³ΡΡΠΆΠ°ΡΡΡΡ ΠΈ ΡΠ°Π·Π³ΡΡΠΆΠ°ΡΡΡΡ ΡΠ°Π·Π»ΠΈΡΠ½ΡΠ΅ ΡΡΠ΄Π°. Π Π°Π±ΠΎΡΠΈΡ ΡΡΠΊ Π½Π΅ Ρ Π²Π°ΡΠ°Π΅Ρ ΠΈ ΡΠΊΠ»Π°Π΄ΡΠΊΠΎΠΉ Π±ΡΠΈΠ³Π°Π΄ΠΈΡ Π²ΡΠ΅Π³Π΄Π° ΡΠ°Π΄ Π·Π°ΠΏΠ»Π°ΡΠΈΡΡ <i>Π΄Π΅Π½ΡΠ³ΠΈ</i> Π·Π° ΠΏΠΎΠΌΠΎΡΡ.' |
|
11 | 12 | ' Π£ Π²Π°Ρ <font size="16"><b><<ΠΠ΅Π½ΡΠ³ΠΈ>></b></font> ΠΌΠΎΠ½Π΅Ρ.' |
|
12 | 13 | ' ΠΠ°ΠΌ Π½ΡΠΆΠ½ΠΎ ΠΏΠ΅ΡΠ΅Π½Π΅ΡΡΠΈ <font size="16" color="#00AA00"><b><<3-Π―ΡΠΈΠΊ>></b></font> ΡΡΠΈΠΊΠ°.' |
|
13 | 14 | ACT 'ΠΠ΄ΡΠΈ Π΄ΠΎΠΌΠΎΠΉ':GOTO 'ΠΠΎΠΌ' |
|
14 | 15 | ACT 'ΠΠ΄ΡΠΈ Π² ΠΌΠ°Π³Π°Π·ΠΈΠ½':GOTO 'ΠΠ°Π³Π°Π·ΠΈΠ½' |
|
15 | 16 | ACT 'ΠΠ΅ΡΠ΅Π½Π΅ΡΡΠΈ ΡΡΠΈΠΊ': |
|
16 | 17 | Π―ΡΠΈΠΊ = Π―ΡΠΈΠΊ + 1 |
|
17 | 18 | WAIT 500 |
|
18 | 19 | IF Π―ΡΠΈΠΊ = 3: |
|
19 | 20 | ΠΠ΅Π½ΡΠ³ΠΈ = ΠΠ΅Π½ΡΠ³ΠΈ + 5 |
|
20 | 21 | Π―ΡΠΈΠΊ = 0 |
|
21 | 22 | END |
|
22 | 23 | GOTO 'Π Π°Π±ΠΎΡΠ°' |
|
23 | 24 | END |
|
24 | 25 | - |
|
25 | 26 | #ΠΠ°Π³Π°Π·ΠΈΠ½ |
|
26 | 27 | '<center><b>ΠΠ°Π³Π°Π·ΠΈΠ½</b></center><br>' |
|
27 | 28 | ' ΠΠ°Π³Π°Π·ΠΈΠ½ Π½Π΅Π±ΠΎΠ»ΡΡΠΎΠΉ, Π½ΠΎ ΡΡΡ ΠΎΠ±ΡΡΠ½ΠΎ Π΅ΡΡΡ Π²ΡΡ, ΡΡΠΎ Π½ΡΠΆΠ½ΠΎ ΠΏΡΠΎΡΡΠΎΠΌΡ Π³ΠΎΡΠΎΠΆΠ°Π½ΠΈΠ½Ρ. ΠΠΈΡΡΠΈΠ½Ρ Π·Π°ΡΡΠ°Π²Π»Π΅Π½Ρ ΡΠ°Π·Π»ΠΈΡΠ½ΡΠΌΠΈ ΡΠΎΠ²Π°ΡΠ°ΠΌΠΈ. Π£ ΠΊΠ°ΡΡΡ ΡΡΠΎΠΈΡ ΠΏΠΎΠ»Π½Π°Ρ ΠΆΠ΅Π½ΡΠΈΠ½Π° ΠΈ Ρ ΠΌΡΡΠΎ ΡΠΌΠΎΡΡΠΈΡ Π½Π° Π²Π°Ρ.' |
|
28 | 29 | ' Π£ Π²Π°Ρ <font size="16"><b><<ΠΠ΅Π½ΡΠ³ΠΈ>></b></font> ΠΌΠΎΠ½Π΅Ρ.' |
|
29 | 30 | IF ΠΠ΅Π½ΡΠ³ΠΈ >= 3: |
|
30 | 31 | ACT 'ΠΡΠΏΠΈΡΡ ΠΊΠΎΠ½ΡΡΡΡΠΊΡΠΎΡ': |
|
31 | 32 | ΠΠ΅Π½ΡΠ³ΠΈ = ΠΠ΅Π½ΡΠ³ΠΈ - 3 |
|
32 | 33 | ADDOBJ 'ΠΠΎΠ½ΡΡΡΡΠΊΡΠΎΡ' |
|
33 | 34 | GOTO 'ΠΠ°Π³Π°Π·ΠΈΠ½' |
|
34 | 35 | END |
|
35 | 36 | END |
|
36 | 37 | IF ΠΠ΅Π½ΡΠ³ΠΈ >= 5: |
|
37 | 38 | ACT 'ΠΡΠΏΠΈΡΡ ΠΏΠ»ΡΡΠ΅Π²ΠΎΠ³ΠΎ ΠΌΠ΅Π΄Π²Π΅Π΄Ρ': |
|
38 | 39 | ΠΠ΅Π½ΡΠ³ΠΈ = ΠΠ΅Π½ΡΠ³ΠΈ - 5 |
|
39 | 40 | ADDOBJ 'ΠΠ»ΡΡΠ΅Π²ΡΠΉ ΠΌΠ΅Π΄Π²Π΅Π΄Ρ' |
|
40 | 41 | GOTO 'ΠΠ°Π³Π°Π·ΠΈΠ½' |
|
41 | 42 | END |
|
42 | 43 | ACT 'ΠΡΠΏΠΈΡΡ Π²ΡΠ·Π°Π»ΡΠ½ΡΠΉ Π½Π°Π±ΠΎΡ': |
|
43 | 44 | ΠΠ΅Π½ΡΠ³ΠΈ = ΠΠ΅Π½ΡΠ³ΠΈ - 5 |
|
44 | 45 | ADDOBJ 'ΠΡΠ·Π°Π»ΡΠ½ΡΠΉ Π½Π°Π±ΠΎΡ' |
|
45 | 46 | GOTO 'ΠΠ°Π³Π°Π·ΠΈΠ½' |
|
46 | 47 | END |
|
47 | 48 | END |
|
48 | 49 | IF ΠΠ΅Π½ΡΠ³ΠΈ >= 7: |
|
49 | 50 | ACT 'ΠΡΠΏΠΈΡΡ ΠΈΠ½ΡΡΡΡΠΌΠ΅Π½ΡΡ': |
|
50 | 51 | ΠΠ΅Π½ΡΠ³ΠΈ = ΠΠ΅Π½ΡΠ³ΠΈ - 7 |
|
51 | 52 | ADDOBJ 'ΠΠ½ΡΡΡΡΠΌΠ΅Π½ΡΡ' |
|
52 | 53 | GOTO 'ΠΠ°Π³Π°Π·ΠΈΠ½' |
|
53 | 54 | END |
|
54 | 55 | END |
|
55 | 56 | ACT 'ΠΠ΄ΡΠΈ Π΄ΠΎΠΌΠΎΠΉ':GOTO 'ΠΠΎΠΌ' |
|
56 | 57 | ACT 'ΠΠ΄ΡΠΈ Π² ΠΏΠΎΡΡ':GOTO 'Π Π°Π±ΠΎΡΠ°' |
|
57 | 58 | - |
|
58 | 59 | #ΠΠΎΠΌ |
|
59 | 60 | '<center><b>ΠΠΎΠΌ</b></center><br>' |
|
60 | 61 | ' ΠΠΎΠΌΠ° Π²ΡΠ΅Π³Π΄Π° ΠΎΡΠ΅Π½Ρ ΡΡΡΠ½ΠΎ. Π Π²ΠΊΡΡΠ½ΠΎ ΠΏΠ°Ρ Π½Π΅Ρ Π΅Π΄ΠΎΠΉ. ΠΠ°ΠΌΠ°, ΡΠΈΠ΄Ρ Π² ΠΊΡΠ΅ΡΠ»Π΅, Π²ΡΠΆΠ΅Ρ Π½ΠΎΡΠΊΠΈ. ΠΡΠ΅Ρ Ρ Π²Π°ΡΠΈΠΌ Π±ΡΠ°ΡΠΎΠΌ ΡΠΈΠ½ΠΈΡ ΡΠΊΠ²ΠΎΡΠ΅ΡΠ½ΠΈΠΊ. Π‘Π΅ΡΡΡΠ° Ρ Π»ΠΎΠΏΠΎΡΠ΅Ρ Π½Π° ΠΊΡΡ Π½Π΅. ΠΠΎΠΌΠ° Π²ΡΠ΅Π³Π΄Π° Ρ ΠΎΡΠΎΡΠΎ.' |
|
61 | 62 | ' Π£ Π²Π°Ρ <font size="16"><b><<ΠΠ΅Π½ΡΠ³ΠΈ>></b></font> ΠΌΠΎΠ½Π΅Ρ.' |
|
62 | 63 | IF OBJ 'ΠΠΎΠ½ΡΡΡΡΠΊΡΠΎΡ': |
|
63 | 64 | ACT 'ΠΠΎΠ΄Π°ΡΠΈΡΡ ΠΊΠΎΠ½ΡΡΡΡΠΊΡΠΎΡ Π±ΡΠ°ΡΡ': |
|
64 | 65 | DELOBJ 'ΠΠΎΠ½ΡΡΡΡΠΊΡΠΎΡ' |
|
65 | 66 | ' - ΠΠΎΡ ΡΠ΅Π±Π΅ ΠΊΠΎΠ½ΡΡΡΡΠΊΡΠΎΡ.' |
|
66 | 67 | ' - Π‘ΠΏΠ°ΡΠΈΠ±ΠΎ, Π±ΡΠ°Ρ.' |
|
67 | 68 | DELACT 'ΠΠΎΠ΄Π°ΡΠΈΡΡ ΠΊΠΎΠ½ΡΡΡΡΠΊΡΠΎΡ Π±ΡΠ°ΡΡ' |
|
68 | 69 | END |
|
69 | 70 | END |
|
70 | 71 | IF OBJ 'ΠΠ»ΡΡΠ΅Π²ΡΠΉ ΠΌΠ΅Π΄Π²Π΅Π΄Ρ': |
|
71 | 72 | ACT 'ΠΠΎΠ΄Π°ΡΠΈΡΡ ΠΌΠ΅Π΄Π²Π΅Π΄Ρ ΡΠ΅ΡΡΡΠ΅': |
|
72 | 73 | DELOBJ 'ΠΠ»ΡΡΠ΅Π²ΡΠΉ ΠΌΠ΅Π΄Π²Π΅Π΄Ρ' |
|
73 | 74 | ' - ΠΠΎΡ ΡΠ΅Π±Π΅ ΠΏΠ»ΡΡΠ΅Π²ΡΠΉ ΠΌΠ΅Π΄Π²Π΅Π΄Ρ.' |
|
74 | 75 | ' - Π‘ΠΏΠ°ΡΠΈΠ±ΠΎ, Π±ΡΠ°Ρ.' |
|
75 | 76 | DELACT 'ΠΠΎΠ΄Π°ΡΠΈΡΡ ΠΌΠ΅Π΄Π²Π΅Π΄Ρ ΡΠ΅ΡΡΡΠ΅' |
|
76 | 77 | END |
|
77 | 78 | END |
|
78 | 79 | IF OBJ 'ΠΡΠ·Π°Π»ΡΠ½ΡΠΉ Π½Π°Π±ΠΎΡ': |
|
79 | 80 | ACT 'ΠΠΎΠ΄Π°ΡΠΈΡΡ Π½Π°Π±ΠΎΡ ΠΌΠ°ΠΌΠ΅': |
|
80 | 81 | DELOBJ 'ΠΡΠ·Π°Π»ΡΠ½ΡΠΉ Π½Π°Π±ΠΎΡ' |
|
81 | 82 | ' - ΠΠΎΡ ΡΠ΅Π±Π΅ Π²ΡΠ·Π°Π»ΡΠ½ΡΠΉ Π½Π°Π±ΠΎΡ.' |
|
82 | 83 | ' - Π‘ΠΏΠ°ΡΠΈΠ±ΠΎ, ΡΡΠ½ΠΎΠΊ.' |
|
83 | 84 | DELACT 'ΠΠΎΠ΄Π°ΡΠΈΡΡ Π½Π°Π±ΠΎΡ ΠΌΠ°ΠΌΠ΅' |
|
84 | 85 | END |
|
85 | 86 | END |
|
86 | 87 | IF OBJ 'ΠΠ½ΡΡΡΡΠΌΠ΅Π½ΡΡ': |
|
87 | 88 | ACT 'ΠΠΎΠ΄Π°ΡΠΈΡΡ ΠΈΠ½ΡΡΡΡΠΌΠ΅Π½ΡΡ ΠΎΡΡΡ': |
|
88 | 89 | DELOBJ 'ΠΠ½ΡΡΡΡΠΌΠ΅Π½ΡΡ' |
|
89 | 90 | ' - ΠΠΎΡ ΡΠ΅Π±Π΅ ΠΈΠ½ΡΡΡΡΠΌΠ΅Π½ΡΡ.' |
|
90 | 91 | ' - Π‘ΠΏΠ°ΡΠΈΠ±ΠΎ, ΡΡΠ½.' |
|
91 | 92 | DELACT 'ΠΠΎΠ΄Π°ΡΠΈΡΡ ΠΈΠ½ΡΡΡΡΠΌΠ΅Π½ΡΡ ΠΎΡΡΡ' |
|
92 | 93 | END |
|
93 | 94 | END |
|
94 | 95 | ACT 'ΠΠ΄ΡΠΈ Π² ΠΏΠΎΡΡ':GOTO 'Π Π°Π±ΠΎΡΠ°' |
|
95 | 96 | ACT 'ΠΠ΄ΡΠΈ Π² ΠΌΠ°Π³Π°Π·ΠΈΠ½':GOTO 'ΠΠ°Π³Π°Π·ΠΈΠ½' |
|
96 | 97 | - |
@@ -1,132 +1,136 b'' | |||
|
1 | 1 | |
|
2 | 2 | .qsp-frame { |
|
3 | 3 | border: 1px solid black; |
|
4 | 4 | overflow: auto; |
|
5 | 5 | padding: 5px; |
|
6 | 6 | box-sizing: border-box; |
|
7 | 7 | } |
|
8 | 8 | |
|
9 | 9 | #qsp { |
|
10 | 10 | position: absolute; |
|
11 | 11 | display: flex; |
|
12 | 12 | flex-flow: row; |
|
13 | 13 | top: 0; |
|
14 | 14 | left: 0; |
|
15 | 15 | width: 100%; |
|
16 | 16 | height: 100%; |
|
17 | 17 | } |
|
18 | 18 | |
|
19 | 19 | .qsp-col { |
|
20 | 20 | display: flex; |
|
21 | 21 | flex-flow: column; |
|
22 | 22 | } |
|
23 | 23 | |
|
24 | 24 | .qsp-col1 { |
|
25 | 25 | flex: 7 7 70px; |
|
26 | 26 | } |
|
27 | 27 | |
|
28 | 28 | .qsp-col2 { |
|
29 | 29 | flex: 3 3 30px; |
|
30 | 30 | } |
|
31 | 31 | |
|
32 | 32 | .qsp-col3 { |
|
33 | 33 | flex: 0 0 40px; |
|
34 | 34 | } |
|
35 | 35 | |
|
36 | 36 | #qsp-main { |
|
37 | 37 | flex: 6 6 60px; |
|
38 | 38 | background-repeat: no-repeat; |
|
39 | 39 | background-position: right top; |
|
40 | 40 | background-attachment: fixed; |
|
41 | 41 | } |
|
42 | 42 | |
|
43 | 43 | #qsp-acts { |
|
44 | 44 | flex: 4 4 40px; |
|
45 | 45 | } |
|
46 | 46 | |
|
47 | 47 | #qsp-input { |
|
48 | 48 | } |
|
49 | 49 | |
|
50 | 50 | #qsp-stat { |
|
51 | 51 | flex: 5 5 50px; |
|
52 | 52 | } |
|
53 | 53 | |
|
54 | 54 | #qsp-objs { |
|
55 | 55 | flex: 5 5 50px; |
|
56 | 56 | } |
|
57 | 57 | |
|
58 | 58 | .qsp-act { |
|
59 | 59 | display: block; |
|
60 | 60 | padding: 2px; |
|
61 | 61 | font-size: large; |
|
62 | 62 | } |
|
63 | 63 | |
|
64 | 64 | .qsp-act:hover { |
|
65 | 65 | outline: #9E9E9E outset 3px |
|
66 | 66 | } |
|
67 | 67 | |
|
68 | 68 | /* Dropdown */ |
|
69 | 69 | |
|
70 | 70 | #qsp-dropdown { |
|
71 | 71 | display: none; |
|
72 | 72 | position: absolute; |
|
73 | 73 | background-color: #f1f1f1; |
|
74 | 74 | min-width: 160px; |
|
75 | 75 | overflow: auto; |
|
76 | 76 | box-shadow: 0px 8px 16px 0px rgba(0,0,0,0.2); |
|
77 | 77 | z-index: 1; |
|
78 | 78 | margin: auto; |
|
79 | 79 | } |
|
80 | 80 | |
|
81 | 81 | #qsp-dropdown a { |
|
82 | 82 | color: black; |
|
83 | 83 | padding: 12px 16px; |
|
84 | 84 | text-decoration: none; |
|
85 | 85 | display: block; |
|
86 | 86 | } |
|
87 | 87 | |
|
88 | 88 | #qsp-dropdown a:hover { |
|
89 | 89 | background-color: #ddd; |
|
90 | 90 | } |
|
91 | 91 | |
|
92 | 92 | /* Buttons */ |
|
93 | 93 | |
|
94 | 94 | .qsp-col3 a, .qsp-col3 img { |
|
95 | 95 | width: 50px; |
|
96 | 96 | height: 50px; |
|
97 | 97 | } |
|
98 | 98 | |
|
99 | 99 | #qsp-btn-save img { |
|
100 | 100 | 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=='); |
|
101 | 101 | } |
|
102 | 102 | |
|
103 | 103 | #qsp-btn-open img { |
|
104 | 104 | 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'); |
|
105 | 105 | } |
|
106 | 106 | |
|
107 | 107 | .center-on-screen { |
|
108 | 108 | position: absolute; |
|
109 | 109 | top: 0; |
|
110 | 110 | left: 0; |
|
111 | 111 | height: 100%; |
|
112 | 112 | width: 100%; |
|
113 | 113 | pointer-events: none; |
|
114 | 114 | display: flex; |
|
115 | 115 | justify-content: center; |
|
116 | 116 | align-items: center; |
|
117 | 117 | } |
|
118 | 118 | |
|
119 | 119 | .center-on-screen > * { |
|
120 | 120 | pointer-events: auto; |
|
121 | 121 | } |
|
122 | 122 | |
|
123 | 123 | #qsp-image-container { |
|
124 | 124 | display: none; |
|
125 | 125 | } |
|
126 | 126 | |
|
127 | 127 | /* misc */ |
|
128 | 128 | |
|
129 | 129 | .disable a { |
|
130 | 130 | pointer-events: none; |
|
131 | 131 | cursor: default; |
|
132 | 132 | } |
|
133 | ||
|
134 | .qsp-objs li.qsp-obj-selected { | |
|
135 | background-color: blue; | |
|
136 | } |
@@ -1,46 +1,44 b'' | |||
|
1 | 1 | |
|
2 | 2 | (in-package sugar-qsp.api) |
|
3 | 3 | |
|
4 | 4 | (defpsmacro with-call-args (args &body body) |
|
5 | 5 | `(progn |
|
6 | 6 | (init-args ,args) |
|
7 | 7 | ,@body |
|
8 | 8 | (get-result))) |
|
9 | 9 | |
|
10 | 10 | (defpsmacro with-frame (&body body) |
|
11 | 11 | `(progn |
|
12 | 12 | (push-local-frame) |
|
13 | 13 | (unwind-protect |
|
14 | 14 | ,@body |
|
15 | 15 | (pop-local-frame)))) |
|
16 | 16 | |
|
17 | 17 | (defpsmacro href-call (func &rest args) |
|
18 | 18 | `(+ "javascript:" (inline-call ,func ,@args))) |
|
19 | 19 | |
|
20 | 20 | (defpsmacro inline-call (func &rest args) |
|
21 | `(+ ,func | |
|
21 | `(+ ',func | |
|
22 | 22 | "(\"" |
|
23 | 23 | ,(first args) |
|
24 | 24 | ,@(loop :for arg :in (cdr args) |
|
25 | 25 | :collect "\", \"" |
|
26 | 26 | :collect arg) |
|
27 | 27 | "\");")) |
|
28 | 28 | |
|
29 | 29 | (defpsmacro with-sleep ((resume-func) &body body) |
|
30 | 30 | `(new (*promise |
|
31 | 31 | (lambda (resolve) |
|
32 | 32 | (start-sleeping) |
|
33 | 33 | (let ((,resume-func (lambda () |
|
34 | 34 | (finish-sleeping) |
|
35 | 35 | (resolve))))) |
|
36 | 36 | ,@body)))) |
|
37 | 37 | |
|
38 | (defvar serv-vars (create)) | |
|
39 | ||
|
40 | 38 | (defpsmacro define-serv-var (name (slot value &optional index) &body body) |
|
41 | 39 | (setf name (string-upcase (symbol-name name))) |
|
42 | `(setf (getprop serv-vars name) | |
|
40 | `(setf (getprop serv-vars ,name) | |
|
43 | 41 | (create :name ,name |
|
44 | 42 | :slot ,slot |
|
45 | 43 | :body (lambda (,value ,@(when index (list index))) |
|
46 | 44 | ,@body)))) |
@@ -1,528 +1,536 b'' | |||
|
1 | 1 | |
|
2 | 2 | (in-package sugar-qsp.api) |
|
3 | 3 | |
|
4 | 4 | ;;; API deals with DOM manipulation and some bookkeeping for the |
|
5 | 5 | ;;; intrinsics, namely variables |
|
6 | 6 | ;;; API is an implementation detail and has no QSP documentation. It |
|
7 | 7 | ;;; doesn't call intrinsics |
|
8 | 8 | |
|
9 | 9 | ;;; Utils |
|
10 | 10 | |
|
11 | 11 | (defun make-act-html (title img) |
|
12 | 12 | (+ "<a class='qsp-act' href='" (href-call call-act title) "' onmouseover='" (inline-call select-act title) "'>" |
|
13 | 13 | (if img (+ "<img src='" img "'>") "") |
|
14 | 14 | title |
|
15 | 15 | "</a>")) |
|
16 | 16 | |
|
17 | 17 | (defun make-menu-item-html (num title img loc) |
|
18 | 18 | (+ "<a href='" (href-call finish-menu loc) "'>" |
|
19 | 19 | (if img (+ "<img src='" img "'>") "") |
|
20 | 20 | title |
|
21 | 21 | "</a>")) |
|
22 | 22 | |
|
23 | 23 | (defun make-obj (title img selected) |
|
24 | (+ "<li>" | |
|
25 | "<a href='" (href-call select-obj title img) "'" | |
|
26 | "class='qsp-obj" (if selected " qsp-obj-selected" "") "'>" | |
|
24 | (+ "<li onclick='" (inline-call select-obj title img) "'>" | |
|
25 | "<a class='qsp-obj" (if selected " qsp-obj-selected" "") "'>" | |
|
27 | 26 | (if img (+ "<img src='" img "'>") "") |
|
28 | obj | |
|
27 | title | |
|
29 | 28 | "</a>")) |
|
30 | 29 | |
|
31 | 30 | (defun make-menu-delimiter () |
|
32 | 31 | "<hr>") |
|
33 | 32 | |
|
34 | 33 | (defun report-error (text) |
|
35 | 34 | (alert text)) |
|
36 | 35 | |
|
37 | 36 | (defun start-sleeping () |
|
38 | 37 | (chain (by-id "qsp") class-list (add "disable"))) |
|
39 | 38 | |
|
40 | 39 | (defun finish-sleeping () |
|
41 | 40 | (chain (by-id "qsp") class-list (remove "disable"))) |
|
42 | 41 | |
|
43 | 42 | (defun sleep (msec) |
|
44 | 43 | (with-sleep (resume) |
|
45 | 44 | (set-timeout resume msec))) |
|
46 | 45 | |
|
47 | 46 | (defun init-dom () |
|
48 | 47 | ;; Save/load buttons |
|
49 | 48 | (let ((btn (by-id "qsp-btn-save"))) |
|
50 | 49 | (setf (@ btn onclick) savegame) |
|
51 | 50 | (setf (@ btn href) "#")) |
|
52 | 51 | (let ((btn (by-id "qsp-btn-open"))) |
|
53 | 52 | (setf (@ btn onclick) opengame) |
|
54 | 53 | (setf (@ btn href) "#")) |
|
55 | 54 | ;; Close image on click |
|
56 | 55 | (setf (@ (by-id "qsp-image-container") onclick) |
|
57 | 56 | show-image) |
|
57 | ;; Enter in input field | |
|
58 | 58 | (setf (@ (get-frame :input) onkeyup) |
|
59 | 59 | on-input-key) |
|
60 | 60 | ;; Close the dropdown on any click |
|
61 | 61 | (setf (@ window onclick) |
|
62 | 62 | (lambda (event) |
|
63 | 63 | (setf (@ window mouse) |
|
64 | 64 | (list (@ event page-x) |
|
65 | 65 | (@ event page-y))) |
|
66 | 66 | (finish-menu nil)))) |
|
67 | 67 | |
|
68 | 68 | (defun call-serv-loc (var-name &rest args) |
|
69 | 69 | (let ((loc-name (get-var var-name 0 :str))) |
|
70 | 70 | (when loc-name |
|
71 | 71 | (let ((loc (getprop (root locs) loc-name))) |
|
72 | 72 | (when loc |
|
73 | 73 | (call-loc loc-name args)))))) |
|
74 | 74 | |
|
75 | 75 | (defun filename-game (filename) |
|
76 | 76 | (let ((game-name (chain filename (match "(.*/)?([^.]+)(\\.[a-zA-Z]+)?") 2)))) |
|
77 | 77 | (getprop (root games) game-name)) |
|
78 | 78 | |
|
79 | 79 | (defun run-game (name) |
|
80 | 80 | (let ((game (filename-game name))) |
|
81 | 81 | (setf (root main-game) name) |
|
82 | 82 | ;; Replace locations with the new game's |
|
83 | 83 | (setf (root locs) game) |
|
84 | 84 | (funcall (getprop game |
|
85 | 85 | (chain *object (keys game) 0)) |
|
86 | 86 | (list)))) |
|
87 | 87 | |
|
88 | 88 | ;;; Misc |
|
89 | 89 | |
|
90 | 90 | (defun newline (key) |
|
91 | 91 | (append-id (key-to-id key) "<br>" t)) |
|
92 | 92 | |
|
93 | 93 | (defun clear-id (id) |
|
94 | 94 | (setf (inner-html (by-id id)) "")) |
|
95 | 95 | |
|
96 | 96 | (defvar text-escaper (chain document (create-element :textarea))) |
|
97 | 97 | |
|
98 | 98 | (defun prepare-contents (s &optional force-html) |
|
99 | 99 | (if (or force-html (get-var "USEHTML" 0 :num)) |
|
100 | 100 | s |
|
101 | 101 | (progn |
|
102 | 102 | (setf (@ text-escaper text-content) s) |
|
103 | 103 | (inner-html text-escaper)))) |
|
104 | 104 | |
|
105 | 105 | (defun get-id (id &optional force-html) |
|
106 | 106 | (inner-html (by-id id))) |
|
107 | 107 | |
|
108 | 108 | (defun set-id (id contents &optional force-html) |
|
109 | 109 | (setf (inner-html (by-id id)) (prepare-contents contents force-html))) |
|
110 | 110 | |
|
111 | 111 | (defun append-id (id contents &optional force-html) |
|
112 | 112 | (when contents |
|
113 | 113 | (incf (inner-html (by-id id)) (prepare-contents contents force-html)))) |
|
114 | 114 | |
|
115 | 115 | (defun on-input-key (ev) |
|
116 | 116 | (when (= 13 (@ ev key-code)) |
|
117 | 117 | (chain ev (prevent-default)) |
|
118 | 118 | (call-serv-loc "USERCOM"))) |
|
119 | 119 | |
|
120 | 120 | ;;; Function calls |
|
121 | 121 | |
|
122 | 122 | (defun init-args (args) |
|
123 | 123 | (dotimes (i (length args)) |
|
124 | 124 | (let ((arg (elt args i))) |
|
125 | 125 | (if (numberp arg) |
|
126 | 126 | (set-var args i :num arg) |
|
127 | 127 | (set-var args i :str arg))))) |
|
128 | 128 | |
|
129 | 129 | (defun get-result () |
|
130 | 130 | (if (not (equal "" (get-var "RESULT" 0 :str))) |
|
131 | 131 | (get-var "RESULT" 0 :str) |
|
132 | 132 | (get-var "RESULT" 0 :num))) |
|
133 | 133 | |
|
134 | 134 | (defun call-loc (name args) |
|
135 | 135 | (setf name (chain name (to-upper-case))) |
|
136 | 136 | (with-frame |
|
137 | 137 | (with-call-args args |
|
138 | 138 | (funcall (getprop (root locs) name))))) |
|
139 | 139 | |
|
140 | 140 | (defun call-act (title) |
|
141 | 141 | (with-frame |
|
142 | 142 | (funcall (getprop (root acts) title :act)))) |
|
143 | 143 | |
|
144 | 144 | ;;; Text windows |
|
145 | 145 | |
|
146 | 146 | (defun key-to-id (key) |
|
147 | 147 | (case key |
|
148 | 148 | (:all "qsp") |
|
149 | 149 | (:main "qsp-main") |
|
150 | 150 | (:stat "qsp-stat") |
|
151 | 151 | (:objs "qsp-objs") |
|
152 | 152 | (:acts "qsp-acts") |
|
153 | 153 | (:input "qsp-input") |
|
154 | 154 | (:image "qsp-image") |
|
155 | 155 | (:dropdown "qsp-dropdown") |
|
156 | 156 | (t (report-error "Internal error!")))) |
|
157 | 157 | |
|
158 | 158 | (defun get-frame (key) |
|
159 | 159 | (by-id (key-to-id key))) |
|
160 | 160 | |
|
161 | 161 | (defun add-text (key text) |
|
162 | 162 | (append-id (key-to-id key) text)) |
|
163 | 163 | |
|
164 | 164 | (defun get-text (key) |
|
165 | 165 | (get-id (key-to-id key))) |
|
166 | 166 | |
|
167 | 167 | (defun clear-text (key) |
|
168 | 168 | (clear-id (key-to-id key))) |
|
169 | 169 | |
|
170 | 170 | (defun enable-frame (key enable) |
|
171 | 171 | (let ((obj (get-frame key))) |
|
172 | 172 | (setf (@ obj style display) (if enable "block" "none")) |
|
173 | 173 | (void))) |
|
174 | 174 | |
|
175 | 175 | ;;; Actions |
|
176 | 176 | |
|
177 | 177 | (defun add-act (title img act) |
|
178 | 178 | (setf (getprop (root acts) title) |
|
179 | 179 | (create :title title :img img :act act :selected nil)) |
|
180 | 180 | (update-acts)) |
|
181 | 181 | |
|
182 | 182 | (defun del-act (title) |
|
183 | 183 | (delete (getprop (root acts) title)) |
|
184 | 184 | (update-acts)) |
|
185 | 185 | |
|
186 | 186 | (defun clear-act () |
|
187 | 187 | (setf (root acts) (create)) |
|
188 | 188 | (update-acts)) |
|
189 | 189 | |
|
190 | 190 | (defun update-acts () |
|
191 | 191 | (clear-id "qsp-acts") |
|
192 | 192 | (let ((elt (by-id "qsp-acts"))) |
|
193 | 193 | (for-in (title (root acts)) |
|
194 | 194 | (let ((obj (getprop (root acts) title))) |
|
195 | 195 | (incf (inner-html elt) (make-act-html title (getprop obj :img))))))) |
|
196 | 196 | |
|
197 | 197 | (defun select-act (title) |
|
198 | 198 | (loop :for (k v) :of (root acts) |
|
199 |
|
|
|
199 | :do (setf (getprop v :selected) nil)) | |
|
200 | 200 | (setf (getprop (root acts) title :selected) t) |
|
201 | 201 | (call-serv-loc "ONACTSEL")) |
|
202 | 202 | |
|
203 | 203 | ;;; "Syntax" |
|
204 | 204 | |
|
205 | 205 | (defun qspfor (name index from to step body) |
|
206 | 206 | (for ((i from)) |
|
207 | 207 | ((< i to)) |
|
208 | 208 | ((incf i step)) |
|
209 | 209 | (set-var name index :num i) |
|
210 | 210 | (unless (funcall body) |
|
211 | 211 | (return-from qspfor)))) |
|
212 | 212 | |
|
213 | 213 | ;;; Variable class |
|
214 | 214 | |
|
215 | 215 | (defun *var (name) |
|
216 | 216 | ;; From strings to numbers |
|
217 | 217 | (setf (@ this :indexes) (create)) |
|
218 | 218 | ;; From numbers to {num: 0, str: ""} objects |
|
219 | 219 | (setf (@ this :values) (list)) |
|
220 | 220 | (void)) |
|
221 | 221 | |
|
222 | 222 | (defun new-value () |
|
223 | 223 | (create :num 0 :str "")) |
|
224 | 224 | |
|
225 | 225 | (setf (@ *var prototype index-num) |
|
226 | 226 | (lambda (index) |
|
227 | 227 | (let ((num-index |
|
228 | 228 | (if (stringp index) |
|
229 | 229 | (if (in index (@ this :indexes)) |
|
230 | 230 | (getprop (@ this :indexes) index) |
|
231 | 231 | (let ((n (length (@ this :values)))) |
|
232 | 232 | (setf (getprop (@ this :indexes) index) n) |
|
233 | 233 | n)) |
|
234 | 234 | index))) |
|
235 | 235 | (unless (in num-index (@ this :values)) |
|
236 | 236 | (setf (elt (@ this :values) num-index) (new-value))) |
|
237 | 237 | num-index))) |
|
238 | 238 | |
|
239 | 239 | (setf (@ *var prototype get) |
|
240 | 240 | (lambda (index slot) |
|
241 | 241 | (unless (or index (= 0 index)) |
|
242 | 242 | (setf index (1- (length (@ this :values))))) |
|
243 | 243 | (getprop (@ this :values) (chain this (index-num index)) slot))) |
|
244 | 244 | |
|
245 | 245 | (setf (@ *var prototype set) |
|
246 | 246 | (lambda (index slot value) |
|
247 | 247 | (unless (or index (= 0 index)) |
|
248 | 248 | (setf index (length (@ this :values)))) |
|
249 | 249 | (case slot |
|
250 | 250 | (:num (setf value (chain *number (parse-int value)))) |
|
251 | 251 | (:str (setf value (chain value (to-string))))) |
|
252 | 252 | (setf (getprop (@ this :values) |
|
253 | 253 | (chain this (index-num index)) |
|
254 | 254 | slot) value) |
|
255 | 255 | (void))) |
|
256 | 256 | |
|
257 | 257 | (setf (@ *var prototype kill) |
|
258 | 258 | (lambda (index) |
|
259 | 259 | (setf (elt (@ this :values) (chain this (index-num index))) |
|
260 | 260 | (new-value)) |
|
261 | 261 | (delete (getprop 'this :indexes index)))) |
|
262 | 262 | |
|
263 | 263 | ;;; Variables |
|
264 | 264 | |
|
265 | 265 | (defun var-real-name (name) |
|
266 | 266 | (if (= (@ name 0) #\$) |
|
267 | 267 | (values (chain name (substr 1)) :str) |
|
268 | 268 | (values name :num))) |
|
269 | 269 | |
|
270 | 270 | (defun ensure-var (name) |
|
271 | 271 | (setf name (chain name (to-upper-case))) |
|
272 | 272 | (let ((store (var-ref name))) |
|
273 | 273 | (unless store |
|
274 | 274 | (setf store (new (*var name))) |
|
275 | 275 | (setf (getprop (root vars) name) store)) |
|
276 | 276 | store)) |
|
277 | 277 | |
|
278 | 278 | (defun var-ref (name) |
|
279 | 279 | (let ((local-store (current-local-frame))) |
|
280 | 280 | (cond ((and local-store (in name local-store)) |
|
281 | 281 | (getprop local-store name)) |
|
282 | 282 | ((in name (root vars)) |
|
283 | 283 | (getprop (root vars) name)) |
|
284 | 284 | (t nil)))) |
|
285 | 285 | |
|
286 | 286 | (defun get-var (name index slot) |
|
287 | 287 | (chain (ensure-var name) (get index slot))) |
|
288 | 288 | |
|
289 | 289 | (defun set-var (name index slot value) |
|
290 | 290 | (chain (ensure-var name) (set index slot value)) |
|
291 | 291 | (let ((serv-var (getprop serv-vars name))) |
|
292 | 292 | (when serv-var |
|
293 |
(funcall (@ serv-var : |
|
|
293 | (funcall (@ serv-var :body) | |
|
294 | 294 | (get-var name index (@ serv-var :slot)) |
|
295 | 295 | index))) |
|
296 | 296 | (void)) |
|
297 | 297 | |
|
298 | 298 | (defun get-array (name) |
|
299 | 299 | (setf name (chain name (to-upper-case))) |
|
300 | 300 | (ensure-var name)) |
|
301 | 301 | |
|
302 | 302 | (defun set-array (name value) |
|
303 | 303 | (setf name (chain name (to-upper-case))) |
|
304 | 304 | (let ((store (ensure-var name))) |
|
305 | 305 | (setf (@ store :values) (@ value :values)) |
|
306 | 306 | (setf (@ store :indexes) (@ value :indexes))) |
|
307 | 307 | (void)) |
|
308 | 308 | |
|
309 | 309 | (defun kill-var (name &optional index) |
|
310 | 310 | (setf name (chain name (to-upper-case))) |
|
311 | 311 | (if (and index (not (= 0 index))) |
|
312 | 312 | (chain (getprop (root vars) name) (kill index)) |
|
313 | 313 | (delete (getprop (root vars) name))) |
|
314 | 314 | (void)) |
|
315 | 315 | |
|
316 | 316 | (defun array-size (name) |
|
317 | 317 | (@ (var-ref name) :values length)) |
|
318 | 318 | |
|
319 | 319 | ;;; Locals |
|
320 | 320 | |
|
321 | 321 | (defun push-local-frame () |
|
322 | 322 | (chain (root locals) (push (create))) |
|
323 | 323 | (void)) |
|
324 | 324 | |
|
325 | 325 | (defun pop-local-frame () |
|
326 | 326 | (chain (root locals) (pop)) |
|
327 | 327 | (void)) |
|
328 | 328 | |
|
329 | 329 | (defun current-local-frame () |
|
330 | 330 | (elt (root locals) (1- (length (root locals))))) |
|
331 | 331 | |
|
332 | 332 | (defun new-local (name) |
|
333 | 333 | (let ((frame (current-local-frame))) |
|
334 | 334 | (unless (in name frame) |
|
335 | 335 | (setf (getprop frame name) (create))) |
|
336 | 336 | (void))) |
|
337 | 337 | |
|
338 | 338 | ;;; Objects |
|
339 | 339 | |
|
340 | 340 | (defun select-obj (title img) |
|
341 | 341 | (loop :for (k v) :of (root objs) |
|
342 |
|
|
|
342 | :do (setf (getprop v :selected) nil)) | |
|
343 | 343 | (setf (getprop (root objs) title :selected) t) |
|
344 | 344 | (call-serv-loc "ONOBJSEL" title img)) |
|
345 | 345 | |
|
346 | 346 | (defun update-objs () |
|
347 | 347 | (let ((elt (by-id "qsp-objs"))) |
|
348 | 348 | (setf (inner-html elt) "<ul>") |
|
349 |
(loop :for |
|
|
349 | (loop :for (name obj) :of (root objs) | |
|
350 | 350 | :do (incf (inner-html elt) |
|
351 | (make-obj obj))) | |
|
351 | (make-obj name (@ obj :img) (@ obj :selected)))) | |
|
352 | 352 | (incf (inner-html elt) "</ul>"))) |
|
353 | 353 | |
|
354 | 354 | ;;; Menu |
|
355 | 355 | |
|
356 | 356 | (defun open-menu (menu-data) |
|
357 | 357 | (let ((elt (get-frame :dropdown)) |
|
358 | 358 | (i 0)) |
|
359 | 359 | (loop :for item :in menu-data |
|
360 | 360 | :do (incf i) |
|
361 | 361 | :do (incf (inner-html elt) |
|
362 | 362 | (if (eq item :delimiter) |
|
363 | 363 | (make-menu-delimiter i) |
|
364 | 364 | (make-menu-item-html i |
|
365 | 365 | (@ item :text) |
|
366 | 366 | (@ item :icon) |
|
367 | 367 | (@ item :loc))))) |
|
368 | 368 | (let ((mouse (@ window mouse))) |
|
369 | 369 | (setf (@ elt style left) (+ (elt mouse 0) "px")) |
|
370 | 370 | (setf (@ elt style top) (+ (elt mouse 1) "px")) |
|
371 | 371 | ;; Make sure it's inside the viewport |
|
372 | 372 | (when (> (@ document body inner-width) |
|
373 | 373 | (+ (elt mouse 0) (@ elt inner-width))) |
|
374 | 374 | (incf (@ elt style left) (@ elt inner-width))) |
|
375 | 375 | (when (> (@ document body inner-height) |
|
376 | 376 | (+ (elt mouse 0) (@ elt inner-height))) |
|
377 | 377 | (incf (@ elt style top) (@ elt inner-height)))) |
|
378 | 378 | (setf (@ elt style display) "block"))) |
|
379 | 379 | |
|
380 | 380 | (defun finish-menu (loc) |
|
381 | 381 | (when (root menu-resume) |
|
382 | 382 | (let ((elt (get-frame :dropdown))) |
|
383 | 383 | (setf (inner-html elt) "") |
|
384 | 384 | (setf (@ elt style display) "none") |
|
385 | 385 | (funcall (root menu-resume)) |
|
386 | 386 | (setf (root menu-resume) nil)) |
|
387 | 387 | (when loc |
|
388 | 388 | (call-loc loc))) |
|
389 | 389 | (void)) |
|
390 | 390 | |
|
391 | 391 | (defun menu (menu-data) |
|
392 | 392 | (with-sleep (resume) |
|
393 | 393 | (open-menu menu-data) |
|
394 | 394 | (setf (root menu-resume) resume)) |
|
395 | 395 | (void)) |
|
396 | 396 | |
|
397 | 397 | ;;; Content |
|
398 | 398 | |
|
399 | 399 | (defun clean-audio () |
|
400 | 400 | (loop :for k :in (chain *object (keys (root playing))) |
|
401 | 401 | :for v := (getprop (root playing) k) |
|
402 | 402 | :do (when (@ v ended) |
|
403 | 403 | (delete (@ (root playing) k))))) |
|
404 | 404 | |
|
405 | 405 | (defun show-image (path) |
|
406 | 406 | (let ((img (get-frame :image))) |
|
407 | 407 | (cond (path |
|
408 | 408 | (setf (@ img src) path) |
|
409 | 409 | (setf (@ img style display) "flex")) |
|
410 | 410 | (t |
|
411 | 411 | (setf (@ img src) "") |
|
412 | 412 | (setf (@ img style display) "hidden"))))) |
|
413 | 413 | |
|
414 | 414 | (defun rgb-string (rgb) |
|
415 |
(let ((red (rgb |
|
|
416 |
(green ( |
|
|
417 |
(blue ( |
|
|
415 | (let ((red (ps::>> rgb 16)) | |
|
416 | (green (logand (ps::>> rgb 8) 255)) | |
|
417 | (blue (logand rgb 255))) | |
|
418 | 418 | (flet ((rgb-to-hex (comp) |
|
419 | 419 | (let ((hex (chain (*number comp) (to-string 16)))) |
|
420 | 420 | (if (< (length hex) 2) |
|
421 | 421 | (+ "0" hex) |
|
422 | 422 | hex)))) |
|
423 | 423 | (+ "#" (rgb-to-hex red) (rgb-to-hex green) (rgb-to-hex red))))) |
|
424 | 424 | |
|
425 | 425 | ;;; Saves |
|
426 | 426 | |
|
427 | 427 | (defun opengame () |
|
428 | 428 | (let ((element (chain document (create-element :input)))) |
|
429 | 429 | (chain element (set-attribute :type :file)) |
|
430 | 430 | (chain element (set-attribute :id :qsp-opengame)) |
|
431 | 431 | (chain element (set-attribute :tabindex -1)) |
|
432 | 432 | (chain element (set-attribute "aria-hidden" t)) |
|
433 | 433 | (setf (@ element style display) :block) |
|
434 | 434 | (setf (@ element style visibility) :hidden) |
|
435 | 435 | (setf (@ element style position) :fixed) |
|
436 | 436 | (setf (@ element onchange) |
|
437 | 437 | (lambda (event) |
|
438 | 438 | (let* ((file (@ event target files 0)) |
|
439 | 439 | (reader (new (*file-reader)))) |
|
440 | 440 | (setf (@ reader onload) |
|
441 | 441 | (lambda (ev) |
|
442 | 442 | (block nil |
|
443 | 443 | (let ((target (@ ev current-target))) |
|
444 | 444 | (unless (@ target result) |
|
445 | 445 | (return)) |
|
446 | 446 | (base64-to-state (@ target result)) |
|
447 | 447 | (unstash-state))))) |
|
448 | 448 | (chain reader (read-as-text file))))) |
|
449 | 449 | (chain document body (append-child element)) |
|
450 | 450 | (chain element (click)) |
|
451 | 451 | (chain document body (remove-child element)))) |
|
452 | 452 | |
|
453 | 453 | (defun savegame () |
|
454 | 454 | (let ((element (chain document (create-element :a)))) |
|
455 | 455 | (chain element (set-attribute :href (+ "data:text/plain;charset=utf-8," (state-to-base64)))) |
|
456 | 456 | (chain element (set-attribute :download "savegame.sav")) |
|
457 | 457 | (setf (@ element style display) :none) |
|
458 | 458 | (chain document body (append-child element)) |
|
459 | 459 | (chain element (click)) |
|
460 | 460 | (chain document body (remove-child element)))) |
|
461 | 461 | |
|
462 | 462 | (defun stash-state (args) |
|
463 | 463 | (call-serv-loc "ONGSAVE") |
|
464 | 464 | (setf (root state-stash) |
|
465 | 465 | (chain *j-s-o-n (stringify |
|
466 | 466 | (create :vars (root vars) |
|
467 | 467 | :objs (root objs) |
|
468 | 468 | :loc-args args |
|
469 | 469 | :msecs (- (chain *date (now)) (root started-at)) |
|
470 | 470 | :timer-interval (root timer-interval) |
|
471 | 471 | :main-html (inner-html |
|
472 | 472 | (get-frame :main)) |
|
473 | 473 | :stat-html (inner-html |
|
474 | 474 | (get-frame :stat)) |
|
475 | 475 | :next-location (root current-location))))) |
|
476 | 476 | (void)) |
|
477 | 477 | |
|
478 | 478 | (defun unstash-state () |
|
479 | 479 | (let ((data (chain *j-s-o-n (parse (root state-stash))))) |
|
480 | 480 | (clear-act) |
|
481 | 481 | (setf (root vars) (@ data :vars)) |
|
482 | 482 | (loop :for k :in (chain *object (keys (root vars))) |
|
483 | 483 | :do (chain *object (set-prototype-of (getprop (root vars) k) |
|
484 | 484 | (@ *var prototype)))) |
|
485 | 485 | (setf (root started-at) (- (chain *date (now)) (@ data :msecs))) |
|
486 | 486 | (setf (root objs) (@ data :objs)) |
|
487 | 487 | (setf (root current-location) (@ data :next-location)) |
|
488 | 488 | (setf (inner-html (get-frame :main)) |
|
489 | 489 | (@ data :main-html)) |
|
490 | 490 | (setf (inner-html (get-frame :stat)) |
|
491 | 491 | (@ data :stat-html)) |
|
492 | 492 | (update-objs) |
|
493 | 493 | (set-timer (@ data :timer-interval)) |
|
494 | 494 | (call-serv-loc "ONGLOAD") |
|
495 | 495 | (call-loc (root current-location) (@ data :loc-args)) |
|
496 | 496 | (void))) |
|
497 | 497 | |
|
498 | 498 | (defun state-to-base64 () |
|
499 | 499 | (btoa (encode-u-r-i-component (root state-stash)))) |
|
500 | 500 | |
|
501 | 501 | (defun base64-to-state (data) |
|
502 | 502 | (setf (root state-stash) (decode-u-r-i-component (atob data)))) |
|
503 | 503 | |
|
504 | 504 | ;;; Timers |
|
505 | 505 | |
|
506 | 506 | (defun set-timer (interval) |
|
507 | 507 | (setf (root timer-interval) interval) |
|
508 | 508 | (clear-interval (root timer-obj)) |
|
509 | 509 | (setf (root timer-obj) |
|
510 | 510 | (set-interval |
|
511 | 511 | (lambda () |
|
512 | 512 | (call-serv-loc "COUNTER")) |
|
513 | 513 | interval))) |
|
514 | 514 | |
|
515 | 515 | ;;; Special variables |
|
516 | 516 | |
|
517 | (defvar serv-vars (create)) | |
|
518 | ||
|
517 | 519 | (define-serv-var backimage (:str path) |
|
518 | 520 | (setf (@ (get-frame :main) style background-image) path)) |
|
519 | 521 | |
|
520 | 522 | (define-serv-var bcolor (:num color) |
|
521 | 523 | (setf (@ (get-frame :all) style background-color) (rgb-string color))) |
|
522 | 524 | |
|
523 | 525 | (define-serv-var fcolor (:num color) |
|
524 | 526 | (setf (@ (get-frame :all) style color) (rgb-string color))) |
|
525 | 527 | |
|
526 | 528 | (define-serv-var lcolor (:num color) |
|
527 | 529 | (setf (@ (get-frame :style) inner-text) |
|
528 | 530 | (+ "a { color: " (rgb-string color) ";}"))) |
|
531 | ||
|
532 | (define-serv-var fsize (:num size) | |
|
533 | (setf (@ (get-frame :all) style font-size) size)) | |
|
534 | ||
|
535 | (define-serv-var fname (:str font-name) | |
|
536 | (setf (@ (get-frame :all) style font-family) (+ font-name ",serif"))) |
@@ -1,168 +1,168 b'' | |||
|
1 | 1 | |
|
2 | 2 | (in-package sugar-qsp.lib) |
|
3 | 3 | |
|
4 | 4 | ;;;; Macros implementing some intrinsics where it makes sense |
|
5 | 5 | ;;;; E.g. an equivalent JS function exists, or it's a direct API call |
|
6 | 6 | |
|
7 | 7 | ;;; 1loc |
|
8 | 8 | |
|
9 | 9 | ;;; 2var |
|
10 | 10 | |
|
11 | 11 | (defpsmacro killvar (varname &optional index) |
|
12 | 12 | `(api-call kill-var ,varname ,index)) |
|
13 | 13 | |
|
14 | 14 | (defpsmacro killall () |
|
15 | 15 | `(api-call kill-all)) |
|
16 | 16 | |
|
17 | 17 | ;;; 3expr |
|
18 | 18 | |
|
19 | 19 | (defpsmacro obj (name) |
|
20 | `(funcall (root objs includes) ,name)) | |
|
20 | `(in ,name (root objs))) | |
|
21 | 21 | |
|
22 | 22 | (defpsmacro loc (name) |
|
23 | `(funcall (root locs includes) ,name)) | |
|
23 | `(in ,name (root locs))) | |
|
24 | 24 | |
|
25 | 25 | (defpsmacro no (arg) |
|
26 | 26 | `(- -1 ,arg)) |
|
27 | 27 | |
|
28 | 28 | ;;; 4code |
|
29 | 29 | |
|
30 | 30 | (defpsmacro qspver () |
|
31 | 31 | "0.0.1") |
|
32 | 32 | |
|
33 | 33 | (defpsmacro curloc () |
|
34 | 34 | `(root current-location)) |
|
35 | 35 | |
|
36 | 36 | (defpsmacro rnd () |
|
37 | 37 | `(funcall rand 1 1000)) |
|
38 | 38 | |
|
39 | 39 | (defpsmacro qspmax (&rest args) |
|
40 | 40 | (if (= 1 (length args)) |
|
41 | 41 | `(*math.max.apply nil ,@args) |
|
42 | 42 | `(*math.max ,@args))) |
|
43 | 43 | |
|
44 | 44 | (defpsmacro qspmin (&rest args) |
|
45 | 45 | (if (= 1 (length args)) |
|
46 | 46 | `(*math.min.apply nil ,@args) |
|
47 | 47 | `(*math.min ,@args))) |
|
48 | 48 | |
|
49 | 49 | ;;; 5arrays |
|
50 | 50 | |
|
51 | 51 | (defpsmacro arrsize (name) |
|
52 | 52 | `(api-call array-size ,name)) |
|
53 | 53 | |
|
54 | 54 | ;;; 6str |
|
55 | 55 | |
|
56 | 56 | (defpsmacro len (s) |
|
57 | 57 | `(length ,s)) |
|
58 | 58 | |
|
59 | 59 | (defpsmacro mid (s from &optional count) |
|
60 | 60 | `(chain ,s (substring ,from ,count))) |
|
61 | 61 | |
|
62 | 62 | (defpsmacro ucase (s) |
|
63 | 63 | `(chain ,s (to-upper-case))) |
|
64 | 64 | |
|
65 | 65 | (defpsmacro lcase (s) |
|
66 | 66 | `(chain ,s (to-lower-case))) |
|
67 | 67 | |
|
68 | 68 | (defpsmacro trim (s) |
|
69 | 69 | `(chain ,s (trim))) |
|
70 | 70 | |
|
71 | 71 | (defpsmacro replace (s from to) |
|
72 | 72 | `(chain ,s (replace ,from ,to))) |
|
73 | 73 | |
|
74 | 74 | (defpsmacro val (s) |
|
75 | 75 | `(parse-int ,s 10)) |
|
76 | 76 | |
|
77 | 77 | (defpsmacro qspstr (n) |
|
78 | 78 | `(chain ,n (to-string))) |
|
79 | 79 | |
|
80 | 80 | ;;; 7if |
|
81 | 81 | |
|
82 | 82 | ;;; 8sub |
|
83 | 83 | |
|
84 | 84 | ;;; 9loops |
|
85 | 85 | |
|
86 | 86 | ;; JUMP is in ps-macros.lisp (because it's a part of a huge kludge) |
|
87 | 87 | |
|
88 | 88 | (defpsmacro exit () |
|
89 | 89 | `(return-from nil (values))) |
|
90 | 90 | |
|
91 | 91 | ;;; 10dynamic |
|
92 | 92 | |
|
93 | 93 | ;;; 11main |
|
94 | 94 | |
|
95 | 95 | (defpsmacro desc (s) |
|
96 | 96 | (declare (ignore s)) |
|
97 | 97 | "") |
|
98 | 98 | |
|
99 | 99 | ;;; 12stat |
|
100 | 100 | |
|
101 | 101 | (defpsmacro showstat (enable) |
|
102 | 102 | `(api-call enable-frame :stat ,enable)) |
|
103 | 103 | |
|
104 | 104 | ;;; 13diag |
|
105 | 105 | |
|
106 | 106 | (defpsmacro msg (text) |
|
107 | 107 | `(alert ,text)) |
|
108 | 108 | |
|
109 | 109 | ;;; 14act |
|
110 | 110 | |
|
111 | 111 | (defpsmacro showacts (enable) |
|
112 | 112 | `(api-call enable-frame :acts ,enable)) |
|
113 | 113 | |
|
114 | 114 | (defpsmacro delact (name) |
|
115 | 115 | `(api-call del-act ,name)) |
|
116 | 116 | |
|
117 | 117 | (defpsmacro cla () |
|
118 | 118 | `(api-call clear-act)) |
|
119 | 119 | |
|
120 | 120 | ;;; 15objs |
|
121 | 121 | |
|
122 | 122 | (defpsmacro showobjs (enable) |
|
123 | 123 | `(api-call enable-frame :objs ,enable)) |
|
124 | 124 | |
|
125 | 125 | (defpsmacro countobj () |
|
126 | 126 | `(length (root objs))) |
|
127 | 127 | |
|
128 | 128 | (defpsmacro getobj (index) |
|
129 | 129 | `(or (elt (root objs) ,index) "")) |
|
130 | 130 | |
|
131 | 131 | ;;; 16menu |
|
132 | 132 | |
|
133 | 133 | ;;; 17sound |
|
134 | 134 | |
|
135 | 135 | (defpsmacro isplay (filename) |
|
136 | 136 | `(funcall (root playing includes) ,filename)) |
|
137 | 137 | |
|
138 | 138 | ;;; 18img |
|
139 | 139 | |
|
140 | 140 | (defpsmacro view (&optional path) |
|
141 | 141 | `(api-call show-image ,path)) |
|
142 | 142 | |
|
143 | 143 | ;;; 19input |
|
144 | 144 | |
|
145 | 145 | (defpsmacro showinput (enable) |
|
146 | 146 | `(api-call enable-frame :input ,enable)) |
|
147 | 147 | |
|
148 | 148 | ;;; 20time |
|
149 | 149 | |
|
150 | 150 | (defpsmacro wait (msec) |
|
151 | 151 | `(await (api-call sleep ,msec))) |
|
152 | 152 | |
|
153 | 153 | (defpsmacro settimer (interval) |
|
154 | 154 | `(api-call set-timer ,interval)) |
|
155 | 155 | |
|
156 | 156 | ;;; 21local |
|
157 | 157 | |
|
158 | 158 | ;;; 22for |
|
159 | 159 | |
|
160 | 160 | ;;; misc |
|
161 | 161 | |
|
162 | 162 | (defpsmacro opengame (&optional filename) |
|
163 | 163 | (declare (ignore filename)) |
|
164 | 164 | `(api-call opengame)) |
|
165 | 165 | |
|
166 | 166 | (defpsmacro savegame (&optional filename) |
|
167 | 167 | (declare (ignore filename)) |
|
168 | 168 | `(api-call savegame)) |
@@ -1,41 +1,41 b'' | |||
|
1 | 1 | |
|
2 | 2 | (in-package sugar-qsp.js) |
|
3 | 3 | |
|
4 | 4 | ;;; Contains symbols from standard JS library to avoid obfuscating |
|
5 | 5 | ;;; and/or namespacing them |
|
6 | 6 | |
|
7 | 7 | (cl:defmacro syms (cl:&rest syms) |
|
8 | 8 | `(cl:progn |
|
9 | 9 | ,@(cl:loop :for sym :in syms |
|
10 | 10 | :collect `(cl:export ',sym)))) |
|
11 | 11 | |
|
12 | 12 | (syms |
|
13 | 13 | ;; main |
|
14 | 14 | window |
|
15 | 15 | *object assign |
|
16 | 16 | now |
|
17 | 17 | onload |
|
18 | 18 | keys includes |
|
19 | 19 | has-own-property |
|
20 | 20 | ;; api |
|
21 | document get-element-by-id | |
|
21 | document get-element-by-id get-elements-by-tag-name | |
|
22 | 22 | onclick onchange |
|
23 | 23 | atob btoa split |
|
24 | 24 | alert prompt |
|
25 | 25 | set-timeout set-interval clear-interval |
|
26 | 26 | *promise *j-s-o-n |
|
27 | 27 | href parse match |
|
28 | 28 | set-prototype-of |
|
29 | 29 | body append-child remove-child |
|
30 | 30 | add ; remove (is already in COMMON-LISP) |
|
31 | 31 | create-element set-attribute class-list |
|
32 | 32 | *file-reader read-as-text |
|
33 | 33 | style display src |
|
34 | 34 | page-x page-y |
|
35 | 35 | top left |
|
36 | 36 | ;; lib |
|
37 | 37 | *number parse-int |
|
38 | 38 | to-string to-upper-case concat |
|
39 | 39 | click target current-target files index-of result |
|
40 | 40 | decode-u-r-i-component splice |
|
41 | 41 | ) |
@@ -1,69 +1,74 b'' | |||
|
1 | 1 | |
|
2 | 2 | (in-package parenscript) |
|
3 | 3 | |
|
4 | 4 | ;;; async/await |
|
5 | 5 | |
|
6 | 6 | (defprinter ps-js::await (x) |
|
7 | 7 | (psw (string-downcase "await ")) |
|
8 | 8 | (print-op-argument 'ps-js::await x)) |
|
9 | 9 | |
|
10 | 10 | (define-trivial-special-ops await ps-js::await) |
|
11 | 11 | |
|
12 | 12 | (define-statement-operator async-defun (name lambda-list &rest body) |
|
13 | 13 | (multiple-value-bind (effective-args body-block docstring) |
|
14 | 14 | (compile-named-function-body name lambda-list body) |
|
15 | 15 | (list 'ps-js::async-defun name effective-args docstring body-block))) |
|
16 | 16 | |
|
17 | 17 | (defprinter ps-js::async-defun (name args docstring body-block) |
|
18 | 18 | (when docstring (print-comment docstring)) |
|
19 | 19 | (psw "async ") |
|
20 | 20 | (print-fun-def name args body-block)) |
|
21 | 21 | |
|
22 | 22 | (define-expression-operator async-lambda (lambda-list &rest body) |
|
23 | 23 | (multiple-value-bind (effective-args effective-body) |
|
24 | 24 | (parse-extended-function lambda-list body) |
|
25 | 25 | `(ps-js::async-lambda |
|
26 | 26 | ,effective-args |
|
27 | 27 | ,(let ((*function-block-names* ())) |
|
28 | 28 | (compile-function-body effective-args effective-body))))) |
|
29 | 29 | |
|
30 | 30 | (defprinter ps-js::async-lambda (args body-block) |
|
31 | 31 | (psw "async ") |
|
32 | 32 | (print-fun-def nil args body-block)) |
|
33 | 33 | |
|
34 | 34 | (cl:export 'await) |
|
35 | 35 | (cl:export 'async-defun) |
|
36 | 36 | (cl:export 'async-lambda) |
|
37 | 37 | |
|
38 | 38 | ;;; ES6 |
|
39 | 39 | |
|
40 | 40 | (define-expression-operator => (lambda-list &rest body) |
|
41 | 41 | (unless (listp lambda-list) |
|
42 | 42 | (setf lambda-list (list lambda-list))) |
|
43 | 43 | (multiple-value-bind (effective-args effective-body) |
|
44 | 44 | (parse-extended-function lambda-list body) |
|
45 | 45 | `(ps-js::=> |
|
46 | 46 | ,effective-args |
|
47 | 47 | ,(let ((*function-block-names* ())) |
|
48 | 48 | (compile-function-body effective-args effective-body))))) |
|
49 | 49 | |
|
50 | 50 | (defprinter ps-js::=> (args body) |
|
51 | 51 | (unless (= 1 (length args)) |
|
52 | 52 | (psw "(")) |
|
53 | 53 | (loop for (arg . remaining) on args do |
|
54 | 54 | (psw (symbol-to-js-string arg)) (when remaining (psw ", "))) |
|
55 | 55 | (unless (= 1 (length args)) |
|
56 | 56 | (psw ")")) |
|
57 | 57 | (psw " => ") |
|
58 | 58 | (ps-print body)) |
|
59 | 59 | |
|
60 | 60 | (cl:export '=>) |
|
61 | 61 | |
|
62 | 62 | ;;; Actually return nothing (with no empty return) |
|
63 | 63 | (defvar *old-return-result-of* (function return-result-of)) |
|
64 | 64 | |
|
65 | 65 | (defun return-result-of (tag form) |
|
66 | 66 | (if (equal form '(void)) |
|
67 | 67 | nil |
|
68 | 68 | (funcall *old-return-result-of* tag form))) |
|
69 | 69 | (export 'void) |
|
70 | ||
|
71 | ;;; Bitwise stuff | |
|
72 | ;; No idea why these are not exported | |
|
73 | (export '<<) | |
|
74 | (export '>>) |
General Comments 0
You need to be logged in to leave comments.
Login now