diff --git a/examples/16menu.txt b/examples/16menu.txt --- a/examples/16menu.txt +++ b/examples/16menu.txt @@ -1,13 +1,22 @@ + +# start +act 'Показать меню': + gs 'menu' +end +- # menu +killvar 'usr_menu' ! нет иконки -$usr_menu[0] = 'Взять предмет:take_item' +$usr_menu[] = 'Взять предмет:take_item' ! иконка задана gif-файлом -$usr_menu[1] = 'Положить предмет:put_item:images/put_item.gif' +$usr_menu[] = 'Положить предмет:put_item:images/put_item.gif' ! иконка задана значением $icon_file -$usr_menu[2] = 'Осмотреть предмет:look_item:<<$icon_file>>' +$usr_menu[] = 'Осмотреть предмет:look_item:<<$icon_file>>' +! Разделитель +$usr_menu[] = '-:-' ! пункт меню задан 3-мя переменными -$usr_menu[3] = '<<$name>>:<<$loc>>:<<$file>>' +$usr_menu[] = '<<$name>>:<<$locname>>:<<$file>>' menu 'usr_menu' &! покажет меню из 4-х пунктов - diff --git a/extras/body.html b/extras/body.html --- a/extras/body.html +++ b/extras/body.html @@ -18,6 +18,6 @@
-
+
diff --git a/extras/default.css b/extras/default.css --- a/extras/default.css +++ b/extras/default.css @@ -73,7 +73,6 @@ box-shadow: 0px 8px 16px 0px rgba(0,0,0,0.2); z-index: 1; margin: auto; - top: 200; } #qsp-dropdown a { @@ -102,17 +101,26 @@ 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'); } -#qsp-image-container { +.center-on-screen { position: absolute; top: 0; left: 0; height: 100%; width: 100%; - display: none; + pointer-events: none; + display: flex; justify-content: center; align-items: center; } +.center-on-screen > * { + pointer-events: auto; +} + +#qsp-image-container { + display: none; +} + /* misc */ .disable a { diff --git a/src/api-macros.lisp b/src/api-macros.lisp --- a/src/api-macros.lisp +++ b/src/api-macros.lisp @@ -13,3 +13,22 @@ (unwind-protect ,@body (pop-local-frame)))) + +(defpsmacro inline-call (func &rest args) + `(+ (ps-inline ,func) + "(\"" + ,(first args) + ,@(loop :for arg :in (cdr args) + :collect "\", \"" + :collect arg) + "\");")) + +(defpsmacro with-sleep ((resume-func) &body body) + `(new (*promise + (lambda (resolve) + (start-sleeping) + (let ((,resume-func (lambda () + (finish-sleeping) + (resolve))))) + ,@body)))) + diff --git a/src/api.ps b/src/api.ps --- a/src/api.ps +++ b/src/api.ps @@ -9,36 +9,32 @@ ;;; Utils (defun make-act-html (title img) - (+ "" + (+ "" + (if img (+ "") "") title "")) (defun make-menu-item-html (num title img loc) - (+ "" - "" + (+ "" + (if img (+ "") "") title "")) +(defun make-menu-delimiter () + "
") + (defun report-error (text) (alert text)) (defun start-sleeping () - (chain (by-id "qsp") class-list (add "disable")) - (setf (root sleeping) t)) + (chain (by-id "qsp") class-list (add "disable"))) (defun finish-sleeping () - (chain (by-id "qsp") class-list (remove "disable")) - (setf (root sleeping) nil)) + (chain (by-id "qsp") class-list (remove "disable"))) (defun sleep (msec) - (start-sleeping) - (new (*promise - (lambda (resolve) - (set-timeout - (lambda () - (finish-sleeping) - (resolve)) - msec))))) + (with-sleep (resume) + (set-timeout resume msec))) (defun init-dom () ;; Save/load buttons @@ -54,7 +50,10 @@ ;; Close the dropdown on any click (setf (@ window onclick) (lambda (event) - (setf (@ (get-frame :dropdown) style display) "none")))) + (setf (@ window mouse) + (list (@ event page-x) + (@ event page-y))) + (finish-menu nil)))) (defun call-serv-loc (var-name &rest args) (let ((loc-name (get-var var-name 0 :str))) @@ -105,14 +104,14 @@ (get-var "RESULT" 0 :num))) (defun call-loc (name args) + (setf name (chain name (to-upper-case))) (with-frame (with-call-args args (funcall (getprop (root locs) name) args)))) (defun call-act (title) - (unless (root sleeping) - (with-frame - (funcall (getprop (root acts) title 'act))))) + (with-frame + (funcall (getprop (root acts) title 'act)))) ;;; Text windows @@ -123,6 +122,7 @@ (:objs "qsp-objs") (:acts "qsp-acts") (:input "qsp-input") + (:image "qsp-image") (:dropdown "qsp-dropdown") (t (report-error "Internal error!")))) @@ -234,6 +234,7 @@ (values name :num))) (defun ensure-var (name) + (setf name (chain name (to-upper-case))) (let ((store (var-ref name))) (unless store (setf store (new (*var name))) @@ -256,22 +257,25 @@ (void)) (defun get-array (name) + (setf name (chain name (to-upper-case))) (var-ref name)) (defun set-array (name value) + (setf name (chain name (to-upper-case))) (let ((store (var-ref name))) (setf (@ store values) (@ value values)) (setf (@ store indexes) (@ value indexes))) (void)) (defun kill-var (name &optional index) + (setf name (chain name (to-upper-case))) (if (and index (not (= 0 index))) (chain (getprop (root vars) name) (kill index)) (delete (getprop (root vars) name))) (void)) (defun array-size (name) - (getprop (var-ref name) 'length)) + (@ (var-ref name) values length)) ;;; Locals @@ -303,18 +307,47 @@ ;;; Menu -(defun menu (menu-data) - (let ((elt (by-id "qsp-dropdown")) +(defun open-menu (menu-data) + (let ((elt (get-frame :dropdown)) (i 0)) - (setf (inner-html elt) "") (loop :for item :in menu-data :do (incf i) - :do (incf (inner-html elt) (make-menu-item-html i - (@ item text) - (@ item icon) - (@ item loc)))) + :do (incf (inner-html elt) + (if (eq item :delimiter) + (make-menu-delimiter i) + (make-menu-item-html i + (@ item :text) + (@ item :icon) + (@ item :loc))))) + (let ((mouse (@ window mouse))) + (setf (@ elt style left) (+ (elt mouse 0) "px")) + (setf (@ elt style top) (+ (elt mouse 1) "px")) + ;; Make sure it's inside the viewport + (when (> (@ document body inner-width) + (+ (elt mouse 0) (@ elt inner-width))) + (incf (@ elt style left) (@ elt inner-width))) + (when (> (@ document body inner-height) + (+ (elt mouse 0) (@ elt inner-height))) + (incf (@ elt style top) (@ elt inner-height)))) (setf (@ elt style display) "block"))) +(defun finish-menu (loc) + (when (root menu-resume) + (let ((elt (get-frame :dropdown))) + (setf (inner-html elt) "") + (setf (@ elt style display) "none") + (funcall (root menu-resume)) + (setf (root menu-resume) nil)) + (when loc + (call-loc loc))) + (void)) + +(defun menu (menu-data) + (with-sleep (resume) + (open-menu menu-data) + (setf (root menu-resume) resume)) + (void)) + ;;; Content (defun clean-audio () @@ -324,7 +357,7 @@ (delete (@ (root playing) k))))) (defun show-image (path) - (let ((img (by-id "qsp-image"))) + (let ((img (get-frame :image))) (cond (path (setf (@ img src) path) (setf (@ img style display) "flex")) @@ -379,9 +412,9 @@ :msecs (- (chain *date (now)) (root started-at)) :timer-interval (root timer-interval) :main-html (inner-html - (by-id :qsp-main)) + (get-frame :main)) :stat-html (inner-html - (by-id :qsp-stat)) + (get-frame :stat)) :next-location (root current-location))))) (void)) @@ -395,9 +428,9 @@ (setf (root started-at) (- (chain *date (now)) (@ data :msecs))) (setf (root objs) (@ data :objs)) (setf (root current-location) (@ data :next-location)) - (setf (inner-html (by-id :qsp-main)) + (setf (inner-html (get-frame :main)) (@ data :main-html)) - (setf (inner-html (by-id :qsp-stat)) + (setf (inner-html (get-frame :stat)) (@ data :stat-html)) (update-objs) (set-timer (@ data :timer-interval)) diff --git a/src/intrinsic-macros.lisp b/src/intrinsic-macros.lisp --- a/src/intrinsic-macros.lisp +++ b/src/intrinsic-macros.lisp @@ -9,7 +9,7 @@ ;;; 2var (defpsmacro killvar (varname &optional index) - `(kill-var ,varname ,index)) + `(api-call kill-var ,varname ,index)) (defpsmacro killall () `(api-call kill-all)) diff --git a/src/intrinsics.ps b/src/intrinsics.ps --- a/src/intrinsics.ps +++ b/src/intrinsics.ps @@ -9,15 +9,14 @@ (defun goto (target args) (api:clear-text :main) - (funcall xgoto target (or args (list))) + (funcall xgoto target args) (void)) (defun xgoto (target args) (api:clear-act) (setf (root current-location) (chain target (to-upper-case))) (api:stash-state args) - (funcall (getprop (root locs) (root current-location)) - (or args (list))) + (api:call-loc (root current-location) (or args (list))) (void)) ;;; 2var @@ -99,11 +98,11 @@ ;;; 8sub (defun gosub (target &rest args) - (funcall (getprop (root locs) target) args) + (api:call-loc target args) (void)) (defun func (target &rest args) - (funcall (getprop (root locs) target) args)) + (api:call-loc target args)) ;;; 9loops @@ -215,7 +214,8 @@ (defun menu (menu-name) (let ((menu-data (list))) - (loop :for item :in (api:get-array (api:var-real-name menu-name)) + (loop :for item-obj :in (@ (api:get-array (api:var-real-name menu-name)) values) + :for item := (@ item-obj :str) :do (cond ((string= item "") (break)) ((string= item "-:-") @@ -228,9 +228,9 @@ (loc (getprop tokens (- (length tokens) 2))) (icon (getprop tokens (- (length tokens) 1)))) (chain menu-data - (push (create text text - loc loc - icon icon)))))))) + (push (create :text text + :loc loc + :icon icon)))))))) (api:menu menu-data) (void))) diff --git a/src/js-syms.lisp b/src/js-syms.lisp --- a/src/js-syms.lisp +++ b/src/js-syms.lisp @@ -20,7 +20,7 @@ ;; api document get-element-by-id onclick onchange - atob btoa + atob btoa split alert prompt set-timeout set-interval clear-interval *promise *j-s-o-n @@ -31,9 +31,11 @@ create-element set-attribute class-list *file-reader read-as-text style display src + page-x page-y + top left ;; lib *number parse-int - to-upper-case concat + to-string to-upper-case concat click target current-target files index-of result decode-u-r-i-component splice ) diff --git a/src/main.ps b/src/main.ps --- a/src/main.ps +++ b/src/main.ps @@ -36,6 +36,7 @@ ;; For $COUNTER and SETTIMER (#.(intern "SET-TIMER" "SUGAR-QSP.API") (root timer-interval)) + ;; Start the first location (funcall (getprop (root locs) (chain *object (keys (root locs)) 0)) (list)) diff --git a/src/parser.lisp b/src/parser.lisp --- a/src/parser.lisp +++ b/src/parser.lisp @@ -582,12 +582,17 @@ (p:defrule variable (and identifier (p:? array-index)) (:destructure (id idx) - (if (char= #\$ (elt (string id) 0)) - (list 'lib:qspvar (intern (subseq (string-upcase id) 1) :lib) (or idx 0) :str) - (list 'lib:qspvar id (or idx 0) :num)))) + (let ((idx (case idx + (nil 0) + (:last nil) + (t idx)))) + (if (char= #\$ (elt (string id) 0)) + (list 'lib:qspvar (intern (subseq (string-upcase id) 1) :lib) idx :str) + (list 'lib:qspvar id idx :num))))) (p:defrule array-index (and #\[ spaces? (p:? expression) spaces? #\]) - (:function third)) + (:lambda (list) + (or (third list) :last))) (p:defrule assignment (or kw-assignment plain-assignment op-assignment) (:destructure (qspvar eq expr)