Show More
@@ -1,13 +1,22 b'' | |||
|
1 | ||
|
2 | # start | |
|
3 | act 'Показать меню': | |
|
4 | gs 'menu' | |
|
5 | end | |
|
6 | - | |
|
1 | 7 | |
|
2 | 8 | # menu |
|
9 | killvar 'usr_menu' | |
|
3 | 10 | ! нет иконки |
|
4 |
$usr_menu[ |
|
|
11 | $usr_menu[] = 'Взять предмет:take_item' | |
|
5 | 12 | ! иконка задана gif-файлом |
|
6 |
$usr_menu[ |
|
|
13 | $usr_menu[] = 'Положить предмет:put_item:images/put_item.gif' | |
|
7 | 14 | ! иконка задана значением $icon_file |
|
8 |
$usr_menu[ |
|
|
15 | $usr_menu[] = 'Осмотреть предмет:look_item:<<$icon_file>>' | |
|
16 | ! Разделитель | |
|
17 | $usr_menu[] = '-:-' | |
|
9 | 18 | ! пункт меню задан 3-мя переменными |
|
10 |
$usr_menu[ |
|
|
19 | $usr_menu[] = '<<$name>>:<<$locname>>:<<$file>>' | |
|
11 | 20 | |
|
12 | 21 | menu 'usr_menu' &! покажет меню из 4-х пунктов |
|
13 | 22 | - |
@@ -18,6 +18,6 b'' | |||
|
18 | 18 | <div id="qsp-dropdown"> |
|
19 | 19 | </div> |
|
20 | 20 | |
|
21 | <div id="qsp-image-container"> | |
|
21 | <div id="qsp-image-container" class="center-on-screen"> | |
|
22 | 22 | <img id="qsp-image"> |
|
23 | 23 | </div> |
@@ -73,7 +73,6 b'' | |||
|
73 | 73 | box-shadow: 0px 8px 16px 0px rgba(0,0,0,0.2); |
|
74 | 74 | z-index: 1; |
|
75 | 75 | margin: auto; |
|
76 | top: 200; | |
|
77 | 76 | } |
|
78 | 77 | |
|
79 | 78 | #qsp-dropdown a { |
@@ -102,17 +101,26 b'' | |||
|
102 | 101 | 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 | 102 | } |
|
104 | 103 | |
|
105 | #qsp-image-container { | |
|
104 | .center-on-screen { | |
|
106 | 105 | position: absolute; |
|
107 | 106 | top: 0; |
|
108 | 107 | left: 0; |
|
109 | 108 | height: 100%; |
|
110 | 109 | width: 100%; |
|
111 |
|
|
|
110 | pointer-events: none; | |
|
111 | display: flex; | |
|
112 | 112 | justify-content: center; |
|
113 | 113 | align-items: center; |
|
114 | 114 | } |
|
115 | 115 | |
|
116 | .center-on-screen > * { | |
|
117 | pointer-events: auto; | |
|
118 | } | |
|
119 | ||
|
120 | #qsp-image-container { | |
|
121 | display: none; | |
|
122 | } | |
|
123 | ||
|
116 | 124 | /* misc */ |
|
117 | 125 | |
|
118 | 126 | .disable a { |
@@ -13,3 +13,22 b'' | |||
|
13 | 13 | (unwind-protect |
|
14 | 14 | ,@body |
|
15 | 15 | (pop-local-frame)))) |
|
16 | ||
|
17 | (defpsmacro inline-call (func &rest args) | |
|
18 | `(+ (ps-inline ,func) | |
|
19 | "(\"" | |
|
20 | ,(first args) | |
|
21 | ,@(loop :for arg :in (cdr args) | |
|
22 | :collect "\", \"" | |
|
23 | :collect arg) | |
|
24 | "\");")) | |
|
25 | ||
|
26 | (defpsmacro with-sleep ((resume-func) &body body) | |
|
27 | `(new (*promise | |
|
28 | (lambda (resolve) | |
|
29 | (start-sleeping) | |
|
30 | (let ((,resume-func (lambda () | |
|
31 | (finish-sleeping) | |
|
32 | (resolve))))) | |
|
33 | ,@body)))) | |
|
34 |
@@ -9,36 +9,32 b'' | |||
|
9 | 9 | ;;; Utils |
|
10 | 10 | |
|
11 | 11 | (defun make-act-html (title img) |
|
12 |
(+ "<a class='qsp-act' href='" ( |
|
|
12 | (+ "<a class='qsp-act' href='" (inline-call call-act title) "'>" | |
|
13 | (if img (+ "<img src='" img "'>") "") | |
|
13 | 14 | title |
|
14 | 15 | "</a>")) |
|
15 | 16 | |
|
16 | 17 | (defun make-menu-item-html (num title img loc) |
|
17 |
(+ "<a href='" ( |
|
|
18 | "<img src='" img "'>" | |
|
18 | (+ "<a href='" (inline-call finish-menu loc) "'>" | |
|
19 | (if img (+ "<img src='" img "'>") "") | |
|
19 | 20 | title |
|
20 | 21 | "</a>")) |
|
21 | 22 | |
|
23 | (defun make-menu-delimiter () | |
|
24 | "<hr>") | |
|
25 | ||
|
22 | 26 | (defun report-error (text) |
|
23 | 27 | (alert text)) |
|
24 | 28 | |
|
25 | 29 | (defun start-sleeping () |
|
26 | (chain (by-id "qsp") class-list (add "disable")) | |
|
27 | (setf (root sleeping) t)) | |
|
30 | (chain (by-id "qsp") class-list (add "disable"))) | |
|
28 | 31 | |
|
29 | 32 | (defun finish-sleeping () |
|
30 | (chain (by-id "qsp") class-list (remove "disable")) | |
|
31 | (setf (root sleeping) nil)) | |
|
33 | (chain (by-id "qsp") class-list (remove "disable"))) | |
|
32 | 34 | |
|
33 | 35 | (defun sleep (msec) |
|
34 | (start-sleeping) | |
|
35 | (new (*promise | |
|
36 | (lambda (resolve) | |
|
37 | (set-timeout | |
|
38 | (lambda () | |
|
39 | (finish-sleeping) | |
|
40 | (resolve)) | |
|
41 | msec))))) | |
|
36 | (with-sleep (resume) | |
|
37 | (set-timeout resume msec))) | |
|
42 | 38 | |
|
43 | 39 | (defun init-dom () |
|
44 | 40 | ;; Save/load buttons |
@@ -54,7 +50,10 b'' | |||
|
54 | 50 | ;; Close the dropdown on any click |
|
55 | 51 | (setf (@ window onclick) |
|
56 | 52 | (lambda (event) |
|
57 | (setf (@ (get-frame :dropdown) style display) "none")))) | |
|
53 | (setf (@ window mouse) | |
|
54 | (list (@ event page-x) | |
|
55 | (@ event page-y))) | |
|
56 | (finish-menu nil)))) | |
|
58 | 57 | |
|
59 | 58 | (defun call-serv-loc (var-name &rest args) |
|
60 | 59 | (let ((loc-name (get-var var-name 0 :str))) |
@@ -105,14 +104,14 b'' | |||
|
105 | 104 | (get-var "RESULT" 0 :num))) |
|
106 | 105 | |
|
107 | 106 | (defun call-loc (name args) |
|
107 | (setf name (chain name (to-upper-case))) | |
|
108 | 108 | (with-frame |
|
109 | 109 | (with-call-args args |
|
110 | 110 | (funcall (getprop (root locs) name) args)))) |
|
111 | 111 | |
|
112 | 112 | (defun call-act (title) |
|
113 | (unless (root sleeping) | |
|
114 | (with-frame | |
|
115 | (funcall (getprop (root acts) title 'act))))) | |
|
113 | (with-frame | |
|
114 | (funcall (getprop (root acts) title 'act)))) | |
|
116 | 115 | |
|
117 | 116 | ;;; Text windows |
|
118 | 117 | |
@@ -123,6 +122,7 b'' | |||
|
123 | 122 | (:objs "qsp-objs") |
|
124 | 123 | (:acts "qsp-acts") |
|
125 | 124 | (:input "qsp-input") |
|
125 | (:image "qsp-image") | |
|
126 | 126 | (:dropdown "qsp-dropdown") |
|
127 | 127 | (t (report-error "Internal error!")))) |
|
128 | 128 | |
@@ -234,6 +234,7 b'' | |||
|
234 | 234 | (values name :num))) |
|
235 | 235 | |
|
236 | 236 | (defun ensure-var (name) |
|
237 | (setf name (chain name (to-upper-case))) | |
|
237 | 238 | (let ((store (var-ref name))) |
|
238 | 239 | (unless store |
|
239 | 240 | (setf store (new (*var name))) |
@@ -256,22 +257,25 b'' | |||
|
256 | 257 | (void)) |
|
257 | 258 | |
|
258 | 259 | (defun get-array (name) |
|
260 | (setf name (chain name (to-upper-case))) | |
|
259 | 261 | (var-ref name)) |
|
260 | 262 | |
|
261 | 263 | (defun set-array (name value) |
|
264 | (setf name (chain name (to-upper-case))) | |
|
262 | 265 | (let ((store (var-ref name))) |
|
263 | 266 | (setf (@ store values) (@ value values)) |
|
264 | 267 | (setf (@ store indexes) (@ value indexes))) |
|
265 | 268 | (void)) |
|
266 | 269 | |
|
267 | 270 | (defun kill-var (name &optional index) |
|
271 | (setf name (chain name (to-upper-case))) | |
|
268 | 272 | (if (and index (not (= 0 index))) |
|
269 | 273 | (chain (getprop (root vars) name) (kill index)) |
|
270 | 274 | (delete (getprop (root vars) name))) |
|
271 | 275 | (void)) |
|
272 | 276 | |
|
273 | 277 | (defun array-size (name) |
|
274 |
( |
|
|
278 | (@ (var-ref name) values length)) | |
|
275 | 279 | |
|
276 | 280 | ;;; Locals |
|
277 | 281 | |
@@ -303,18 +307,47 b'' | |||
|
303 | 307 | |
|
304 | 308 | ;;; Menu |
|
305 | 309 | |
|
306 | (defun menu (menu-data) | |
|
307 |
(let ((elt ( |
|
|
310 | (defun open-menu (menu-data) | |
|
311 | (let ((elt (get-frame :dropdown)) | |
|
308 | 312 | (i 0)) |
|
309 | (setf (inner-html elt) "") | |
|
310 | 313 | (loop :for item :in menu-data |
|
311 | 314 | :do (incf i) |
|
312 |
:do (incf (inner-html elt) |
|
|
313 | (@ item text) | |
|
314 | (@ item icon) | |
|
315 | (@ item loc)))) | |
|
315 | :do (incf (inner-html elt) | |
|
316 | (if (eq item :delimiter) | |
|
317 | (make-menu-delimiter i) | |
|
318 | (make-menu-item-html i | |
|
319 | (@ item :text) | |
|
320 | (@ item :icon) | |
|
321 | (@ item :loc))))) | |
|
322 | (let ((mouse (@ window mouse))) | |
|
323 | (setf (@ elt style left) (+ (elt mouse 0) "px")) | |
|
324 | (setf (@ elt style top) (+ (elt mouse 1) "px")) | |
|
325 | ;; Make sure it's inside the viewport | |
|
326 | (when (> (@ document body inner-width) | |
|
327 | (+ (elt mouse 0) (@ elt inner-width))) | |
|
328 | (incf (@ elt style left) (@ elt inner-width))) | |
|
329 | (when (> (@ document body inner-height) | |
|
330 | (+ (elt mouse 0) (@ elt inner-height))) | |
|
331 | (incf (@ elt style top) (@ elt inner-height)))) | |
|
316 | 332 | (setf (@ elt style display) "block"))) |
|
317 | 333 | |
|
334 | (defun finish-menu (loc) | |
|
335 | (when (root menu-resume) | |
|
336 | (let ((elt (get-frame :dropdown))) | |
|
337 | (setf (inner-html elt) "") | |
|
338 | (setf (@ elt style display) "none") | |
|
339 | (funcall (root menu-resume)) | |
|
340 | (setf (root menu-resume) nil)) | |
|
341 | (when loc | |
|
342 | (call-loc loc))) | |
|
343 | (void)) | |
|
344 | ||
|
345 | (defun menu (menu-data) | |
|
346 | (with-sleep (resume) | |
|
347 | (open-menu menu-data) | |
|
348 | (setf (root menu-resume) resume)) | |
|
349 | (void)) | |
|
350 | ||
|
318 | 351 | ;;; Content |
|
319 | 352 | |
|
320 | 353 | (defun clean-audio () |
@@ -324,7 +357,7 b'' | |||
|
324 | 357 | (delete (@ (root playing) k))))) |
|
325 | 358 | |
|
326 | 359 | (defun show-image (path) |
|
327 |
(let ((img ( |
|
|
360 | (let ((img (get-frame :image))) | |
|
328 | 361 | (cond (path |
|
329 | 362 | (setf (@ img src) path) |
|
330 | 363 | (setf (@ img style display) "flex")) |
@@ -379,9 +412,9 b'' | |||
|
379 | 412 | :msecs (- (chain *date (now)) (root started-at)) |
|
380 | 413 | :timer-interval (root timer-interval) |
|
381 | 414 | :main-html (inner-html |
|
382 |
( |
|
|
415 | (get-frame :main)) | |
|
383 | 416 | :stat-html (inner-html |
|
384 |
( |
|
|
417 | (get-frame :stat)) | |
|
385 | 418 | :next-location (root current-location))))) |
|
386 | 419 | (void)) |
|
387 | 420 | |
@@ -395,9 +428,9 b'' | |||
|
395 | 428 | (setf (root started-at) (- (chain *date (now)) (@ data :msecs))) |
|
396 | 429 | (setf (root objs) (@ data :objs)) |
|
397 | 430 | (setf (root current-location) (@ data :next-location)) |
|
398 |
(setf (inner-html ( |
|
|
431 | (setf (inner-html (get-frame :main)) | |
|
399 | 432 | (@ data :main-html)) |
|
400 |
(setf (inner-html ( |
|
|
433 | (setf (inner-html (get-frame :stat)) | |
|
401 | 434 | (@ data :stat-html)) |
|
402 | 435 | (update-objs) |
|
403 | 436 | (set-timer (@ data :timer-interval)) |
@@ -9,7 +9,7 b'' | |||
|
9 | 9 | ;;; 2var |
|
10 | 10 | |
|
11 | 11 | (defpsmacro killvar (varname &optional index) |
|
12 | `(kill-var ,varname ,index)) | |
|
12 | `(api-call kill-var ,varname ,index)) | |
|
13 | 13 | |
|
14 | 14 | (defpsmacro killall () |
|
15 | 15 | `(api-call kill-all)) |
@@ -9,15 +9,14 b'' | |||
|
9 | 9 | |
|
10 | 10 | (defun goto (target args) |
|
11 | 11 | (api:clear-text :main) |
|
12 |
(funcall xgoto target |
|
|
12 | (funcall xgoto target args) | |
|
13 | 13 | (void)) |
|
14 | 14 | |
|
15 | 15 | (defun xgoto (target args) |
|
16 | 16 | (api:clear-act) |
|
17 | 17 | (setf (root current-location) (chain target (to-upper-case))) |
|
18 | 18 | (api:stash-state args) |
|
19 |
( |
|
|
20 | (or args (list))) | |
|
19 | (api:call-loc (root current-location) (or args (list))) | |
|
21 | 20 | (void)) |
|
22 | 21 | |
|
23 | 22 | ;;; 2var |
@@ -99,11 +98,11 b'' | |||
|
99 | 98 | ;;; 8sub |
|
100 | 99 | |
|
101 | 100 | (defun gosub (target &rest args) |
|
102 |
( |
|
|
101 | (api:call-loc target args) | |
|
103 | 102 | (void)) |
|
104 | 103 | |
|
105 | 104 | (defun func (target &rest args) |
|
106 |
( |
|
|
105 | (api:call-loc target args)) | |
|
107 | 106 | |
|
108 | 107 | ;;; 9loops |
|
109 | 108 | |
@@ -215,7 +214,8 b'' | |||
|
215 | 214 | |
|
216 | 215 | (defun menu (menu-name) |
|
217 | 216 | (let ((menu-data (list))) |
|
218 | (loop :for item :in (api:get-array (api:var-real-name menu-name)) | |
|
217 | (loop :for item-obj :in (@ (api:get-array (api:var-real-name menu-name)) values) | |
|
218 | :for item := (@ item-obj :str) | |
|
219 | 219 | :do (cond ((string= item "") |
|
220 | 220 | (break)) |
|
221 | 221 | ((string= item "-:-") |
@@ -228,9 +228,9 b'' | |||
|
228 | 228 | (loc (getprop tokens (- (length tokens) 2))) |
|
229 | 229 | (icon (getprop tokens (- (length tokens) 1)))) |
|
230 | 230 | (chain menu-data |
|
231 | (push (create text text | |
|
232 | loc loc | |
|
233 | icon icon)))))))) | |
|
231 | (push (create :text text | |
|
232 | :loc loc | |
|
233 | :icon icon)))))))) | |
|
234 | 234 | (api:menu menu-data) |
|
235 | 235 | (void))) |
|
236 | 236 |
@@ -20,7 +20,7 b'' | |||
|
20 | 20 | ;; api |
|
21 | 21 | document get-element-by-id |
|
22 | 22 | onclick onchange |
|
23 | atob btoa | |
|
23 | atob btoa split | |
|
24 | 24 | alert prompt |
|
25 | 25 | set-timeout set-interval clear-interval |
|
26 | 26 | *promise *j-s-o-n |
@@ -31,9 +31,11 b'' | |||
|
31 | 31 | create-element set-attribute class-list |
|
32 | 32 | *file-reader read-as-text |
|
33 | 33 | style display src |
|
34 | page-x page-y | |
|
35 | top left | |
|
34 | 36 | ;; lib |
|
35 | 37 | *number parse-int |
|
36 | to-upper-case concat | |
|
38 | to-string to-upper-case concat | |
|
37 | 39 | click target current-target files index-of result |
|
38 | 40 | decode-u-r-i-component splice |
|
39 | 41 | ) |
@@ -36,6 +36,7 b'' | |||
|
36 | 36 | ;; For $COUNTER and SETTIMER |
|
37 | 37 | (#.(intern "SET-TIMER" "SUGAR-QSP.API") |
|
38 | 38 | (root timer-interval)) |
|
39 | ;; Start the first location | |
|
39 | 40 | (funcall (getprop (root locs) |
|
40 | 41 | (chain *object (keys (root locs)) 0)) |
|
41 | 42 | (list)) |
@@ -582,12 +582,17 b'' | |||
|
582 | 582 | |
|
583 | 583 | (p:defrule variable (and identifier (p:? array-index)) |
|
584 | 584 | (:destructure (id idx) |
|
585 | (if (char= #\$ (elt (string id) 0)) | |
|
586 | (list 'lib:qspvar (intern (subseq (string-upcase id) 1) :lib) (or idx 0) :str) | |
|
587 | (list 'lib:qspvar id (or idx 0) :num)))) | |
|
585 | (let ((idx (case idx | |
|
586 | (nil 0) | |
|
587 | (:last nil) | |
|
588 | (t idx)))) | |
|
589 | (if (char= #\$ (elt (string id) 0)) | |
|
590 | (list 'lib:qspvar (intern (subseq (string-upcase id) 1) :lib) idx :str) | |
|
591 | (list 'lib:qspvar id idx :num))))) | |
|
588 | 592 | |
|
589 | 593 | (p:defrule array-index (and #\[ spaces? (p:? expression) spaces? #\]) |
|
590 | (:function third)) | |
|
594 | (:lambda (list) | |
|
595 | (or (third list) :last))) | |
|
591 | 596 | |
|
592 | 597 | (p:defrule assignment (or kw-assignment plain-assignment op-assignment) |
|
593 | 598 | (:destructure (qspvar eq expr) |
General Comments 0
You need to be logged in to leave comments.
Login now