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)