MENU

examples/16menu.txt

@@ -1,13 +1,22 b''
+
+# 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-х пунктов
 -

extras/body.html

@@ -18,6 +18,6 b''
 <div id="qsp-dropdown">
 </div>
 
-<div id="qsp-image-container">
+<div id="qsp-image-container" class="center-on-screen">
   <img id="qsp-image">
 </div>

extras/default.css

@@ -73,7 +73,6 b''
   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 b''
     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 {

src/api-macros.lisp

@@ -13,3 +13,22 b''
      (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))))
+

src/api.ps

@@ -9,36 +9,32 b''
 ;;; Utils
 
 (defun make-act-html (title img)
-  (+ "<a class='qsp-act' href='" (ps-inline call-act) "(\"" title "\");'>"
+  (+ "<a class='qsp-act' href='" (inline-call call-act title) "'>"
+     (if img (+ "<img src='" img "'>") "")
      title
      "</a>"))
 
 (defun make-menu-item-html (num title img loc)
-  (+ "<a href='" (ps-inline run-menu) "(" num ", \"" loc "\")();'>"
-     "<img src='" img "'>"
+  (+ "<a href='" (inline-call finish-menu loc) "'>"
+     (if img (+ "<img src='" img "'>") "")
      title
      "</a>"))
 
+(defun make-menu-delimiter ()
+  "<hr>")
+
 (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 b''
   ;; 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 b''
       (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 b''
     (:objs "qsp-objs")
     (:acts "qsp-acts")
     (:input "qsp-input")
+    (:image "qsp-image")
     (:dropdown "qsp-dropdown")
     (t (report-error "Internal error!"))))
 
@@ -234,6 +234,7 b''
       (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 b''
   (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 b''
 
 ;;; 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 b''
            (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 b''
                                  :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 b''
     (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))

src/intrinsic-macros.lisp

@@ -9,7 +9,7 b''
 ;;; 2var
 
 (defpsmacro killvar (varname &optional index)
-  `(kill-var ,varname ,index))
+  `(api-call kill-var ,varname ,index))
 
 (defpsmacro killall ()
   `(api-call kill-all))

src/intrinsics.ps

@@ -9,15 +9,14 b''
 
 (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 b''
 ;;; 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 b''
 
 (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 b''
                            (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)))
 

src/js-syms.lisp

@@ -20,7 +20,7 b''
  ;; 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 b''
  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
  )

src/main.ps

@@ -36,6 +36,7 b''
         ;; 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))

src/parser.lisp

@@ -582,12 +582,17 b''
 
 (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)