Some DOM stuff, VIEW

extras/body.html

@@ -1,19 +1,23 b''
 
 <div id="qsp">
   <div class="qsp-col qsp-col1">
     <div id="qsp-main" class="qsp-frame">&nbsp;</div>
     <div id="qsp-acts" class="qsp-frame">&nbsp;</div>
     <input id="qsp-input" class="qsp-frame">
   </div>
   <div class="qsp-col qsp-col2">
     <div id="qsp-stat" class="qsp-frame">&nbsp;</div>
     <div id="qsp-objs" class="qsp-frame">&nbsp;</div>
   </div>
   <div class="qsp-col qsp-col3">
-    <a href="javascript:SugarQSP.lib.savegame()"><img id="qsp-btn-save"></a>
-    <a href="javascript:SugarQSP.lib.opengame()"><img id="qsp-btn-load"></a>
+    <a id="qsp-btn-save"><img></a>
+    <a id="qsp-btn-open"><img></a>
   </div>
 </div>
 
 <div id="qsp-dropdown">
 </div>
+
+<div id="qsp-image-container">
+  <img id="qsp-image">
+</div>

extras/default.css

@@ -1,103 +1,114 b''
 
 .qsp-frame {
     border: 1px solid black;
     overflow: auto;
     padding: 5px;
     box-sizing: border-box;
 }
 
 #qsp {
     position: absolute;
     display: flex;
     flex-flow: row;
     top: 0;
     left: 0;
     width: 100%;
     height: 100%;
 }
 
 .qsp-col {
     display: flex;
     flex-flow: column;
 }
 
 .qsp-col1 {
     flex: 7 7 70px;
 }
 
 .qsp-col2 {
     flex: 3 3 30px;
 }
 
 .qsp-col3 {
     flex: 0 0 40px;
 }
 
 #qsp-main {
     flex: 6 6 60px;
 }
 
 #qsp-acts {
     flex: 4 4 40px;
 }
 
 #qsp-input {
 }
 
 #qsp-stat {
     flex: 5 5 50px;
 }
 
 #qsp-objs {
     flex: 5 5 50px;
 }
 
 .qsp-act {
     display: block;
     padding: 2px;
     font-size: large;
 }
 
 .qsp-act:hover {
     outline: #9E9E9E outset 3px
 }
 
 /* Dropdown */
 
 #qsp-dropdown {
   display: none;
   position: absolute;
   background-color: #f1f1f1;
   min-width: 160px;
   overflow: auto;
   box-shadow: 0px 8px 16px 0px rgba(0,0,0,0.2);
   z-index: 1;
   margin: auto;
   top: 200;
 }
 
 #qsp-dropdown a {
   color: black;
   padding: 12px 16px;
   text-decoration: none;
   display: block;
 }
 
 #qsp-dropdown a:hover {
     background-color: #ddd;
 }
 
 /* Buttons */
 
 .qsp-col3 a, .qsp-col3 img {
     width: 50px;
     height: 50px;
 }
 
-#qsp-btn-save {
+#qsp-btn-save img {
     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==');
 }
 
-#qsp-btn-load {
+#qsp-btn-open img {
     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 {
+    position: absolute;
+    top: 0;
+    left: 0;
+    height: 100%;
+    width: 100%;
+    display: none;
+    justify-content: center;
+    align-items: center;
+}

src/api.ps

@@ -1,287 +1,348 b''
 
 (in-package sugar-qsp)
 
 ;;; API deals with DOM manipulation and some bookkeeping for the
 ;;; intrinsics, namely variables
 ;;; API is an implementation detail and has no QSP documentation. It
 ;;; doesn't call intrinsics
 
 (setf (root api) (ps:create))
 
 ;;; Utils
 
 (defm (root api make-act-html) (title img)
   (+ "<a class='qsp-act' href='#' onclick='SugarQSP.acts[\"" title "\"].act();'>"
      title
      "</a>"))
 
 (defm (root api make-menu-item-html) (num title img loc)
   (+ "<a href='#' onclick='SugarQSP.api.runMenu(" num ", \"" loc "\")();'>"
      "<img src='" img "'>"
      title
      "</a>"))
 
+(defm (root api init-dom) ()
+  ;; Save/load buttons
+  (let ((btn (document.get-element-by-id "qsp-btn-save")))
+    (setf (ps:@ btn onclick) this.savegame)
+    (setf (ps:@ btn href) "#"))
+  (let ((btn (document.get-element-by-id "qsp-btn-open")))
+    (setf (ps:@ btn onclick) this.opengame)
+    (setf (ps:@ btn href) "#"))
+  ;; Close image on click
+  (setf (ps:@ (document.get-element-by-id "qsp-image-container") onclick)
+        (this.show-image nil))
+  ;; Close the dropdown on any click
+  (setf window.onclick
+        (lambda (event)
+          (setf (ps:@ (api-call get-frame :dropdown) style display) "none"))))
+
 ;; To be used in saving game
 (defm (root api stash-state) (args)
   (setf (root state-stash)
         (*j-s-o-n.stringify
          (ps:create vars (root vars)
                     objs (root objs)
                     loc-args args
                     main-html (ps:@
                                (document.get-element-by-id :qsp-main)
                                inner-h-t-m-l)
                     stat-html (ps:@
                                (document.get-element-by-id :qsp-stat)
                                inner-h-t-m-l)
                     next-location (root current-location))))
   (values))
 
 (defm (root api unstash-state) ()
   (let ((data (*j-s-o-n.parse (root state-stash))))
     (this.clear-act)
     (setf (root vars) (ps:@ data vars))
     (loop :for k :in (*object.keys (root vars))
        :do (*object.set-prototype-of (ps:getprop (root vars) k)
                                      (root api *var prototype)))
     (setf (root objs) (ps:@ data objs))
     (setf (root current-location) (ps:@ data next-location))
     (setf (ps:@ (document.get-element-by-id :qsp-main) inner-h-t-m-l)
           (ps:@ data main-html))
     (setf (ps:@ (document.get-element-by-id :qsp-stat) inner-h-t-m-l)
           (ps:@ data stat-html))
     (funcall (root locs (root current-location)) (ps:@ data loc-args))
     (this.update-objs)
     (values)))
 
 (defm (root api state-to-base64) ()
   (btoa (encode-u-r-i-component (root state-stash))))
 
 (defm (root api base64-to-state) (data)
   (setf (root state-stash) (decode-u-r-i-component (atob data))))
 
 ;;; Misc
 
 (defm (root api clear-id) (id)
   (setf (ps:chain document (get-element-by-id id) inner-text) ""))
 
 (defm (root api get-id) (id)
   (if (var "USEHTML" 0 :num)
       (ps:chain (document.get-element-by-id id) inner-h-t-m-l)
       (ps:chain (document.get-element-by-id id) inner-text)))
 
 (defm (root api set-id) (id contents)
   (if (var "USEHTML" 0 :num)
       (setf (ps:chain (document.get-element-by-id id) inner-h-t-m-l) contents)
       (setf (ps:chain (document.get-element-by-id id) inner-text) contents)))
 
 (defm (root api append-id) (id contents)
   (if (var "USEHTML" 0 :num)
       (incf (ps:chain (document.get-element-by-id id) inner-h-t-m-l) contents)
       (incf (ps:chain (document.get-element-by-id id) inner-text) contents)))
 
 ;;; Function calls
 
 (defm (root api init-args) (args)
   (dotimes (i (length args))
     (let ((arg (elt args i)))
       (if (numberp arg)
           (this.set-var args i :num arg)
           (this.set-var args i :str arg)))))
 
 (defm (root api get-result) ()
   (if (not (equal "" (var result 0 :str)))
       (var result 0 :str)
       (var result 0 :num)))
 
 ;;; Text windows
 
 (defm (root api key-to-id) (key)
   (case key
     (:main "qsp-main")
     (:stat "qsp-stat")
     (:objs "qsp-objs")
     (:acts "qsp-acts")
     (:input "qsp-input")
     (:dropdown "qsp-dropdown")
     (t (report-error "Internal error!"))))
 
 (defm (root api get-frame) (key)
   (document.get-element-by-id (this.key-to-id key)))
 
 (defm (root api add-text) (key text)
   (this.append-id (this.key-to-id key) text))
 
 (defm (root api get-text) (key)
   (this.get-id (this.key-to-id key)))
 
 (defm (root api clear-text) (key)
   (this.clear-id (this.key-to-id key)))
 
 (defm (root api newline) (key)
   (let ((div (this.get-frame key)))
     (ps:chain div (append-child (document.create-element "br")))))
 
 (defm (root api enable-frame) (key enable)
   (let ((clss (ps:getprop (this.get-frame key) 'class-list)))
     (setf clss.style.display (if enable "block" "none"))
     (values)))
 
 ;;; Actions
 
 (defm (root api add-act) (title img act)
   (setf (ps:getprop (root acts) title)
         (ps:create :img img :act act))
   (this.update-acts))
 
 (defm (root api del-act) (title)
   (delete (ps:getprop (root acts) title))
   (this.update-acts))
 
 (defm (root api clear-act) ()
   (setf (root acts) (ps:create))
   (this.clear-id "qsp-acts"))
 
 (defm (root api update-acts) ()
   (this.clear-id "qsp-acts")
   (ps:for-in (title (root acts))
     (let ((obj (ps:getprop (root acts) title)))
       (this.append-id "qsp-acts"
                 (this.make-act-html title (ps:getprop obj :img))))))
 
 ;;; Variable class
 
 (defm (root api *var) (name)
   ;; From strings to numbers
   (setf this.indexes (ps:create))
   ;; From numbers to {num: 0, str: ""} objects
   (setf this.values (list))
   (values))
 
 (defm (root api *var prototype new-value) ()
   (ps:create :num 0 :str ""))
 
 (defm (root api *var prototype index-num) (index)
   (let ((num-index
          (if (stringp index)
              (if (in index this.indexes)
                  (ps:getprop this.indexes index)
                  (let ((n (length this.values)))
                    (setf (ps:getprop this.indexes index) n)
                    n))
              index)))
     (unless (in num-index this.values)
       (setf (elt this.values num-index) (this.new-value)))
     num-index))
 
 (defm (root api *var prototype get) (index slot)
   (unless (or index (= 0 index))
     (setf index (1- (length this.values))))
   (ps:getprop this.values (this.index-num index) slot))
 
 (defm (root api *var prototype set) (index slot value)
   (unless (or index (= 0 index))
     (setf index (length store)))
   (case slot
     (:num (setf value (ps:chain *number (parse-int value))))
     (:str (setf value (ps:chain value (to-string)))))
   (setf (ps:getprop this.values (this.index-num index) slot) value)
   (values))
 
 (defm (root api *var prototype kill) (index)
   (setf (elt this.values (this.index-num index)) (this.new-value)))
 
 ;;; Variables
 
 (defm (root api var-real-name) (name)
   (if (= (ps:@ name 0) #\$)
       (values (ps:chain name (substr 1)) :str)
       (values name :num)))
 
 (defm (root api ensure-var) (name)
   (let ((store (this.var-ref name)))
     (unless store
       (setf store (ps:new (this.-var name)))
       (setf (ps:getprop (root vars) name) store))
     store))
 
 (defm (root api var-ref) (name)
   (let ((local-store (this.current-local-frame)))
     (cond ((in name local-store)
            (ps:getprop local-store name))
           ((in name (root vars))
            (ps:getprop (root vars) name))
           (t nil))))
 
 (defm (root api get-var) (name index slot)
   (ps:chain (this.ensure-var name) (get index slot)))
 
 (defm (root api set-var) (name index slot value)
   (ps:chain (this.ensure-var name) (set index slot value))
   (values))
 
 (defm (root api get-array) (name)
   (this.var-ref name))
 
 (defm (root api set-array) (name value)
   (let ((store (this.var-ref name)))
     (setf (ps:@ store values) (ps:@ value values))
     (setf (ps:@ store indexes) (ps:@ value indexes)))
   (values))
 
 (defm (root api kill-var) (name &optional index)
   (if (and index (not (= 0 index))) 
       (ps:chain (ps:getprop (root vars) name) (kill index))
       (ps:delete (ps:getprop (root vars) name)))
   (values))
 
 (defm (root api array-size) (name)
   (ps:getprop (this.var-ref name) 'length))
 
 ;;; Locals
 
 (defm (root api push-local-frame) ()
   (ps:chain (root locals) (push (ps:create)))
   (values))
 
 (defm (root api pop-local-frame) ()
   (ps:chain (root locals) (pop))
   (values))
 
 (defm (root api current-local-frame) ()
   (elt (root locals) (1- (length (root locals)))))
 
 (defm (root api new-local) (name)
   (let ((frame (this.current-local-frame)))
     (unless (in name frame)
       (setf (ps:getprop frame name) (ps:create)))
     (values)))
 
 ;;; Objects
 
 (defm (root api update-objs) ()
   (let ((elt (document.get-element-by-id "qsp-objs")))
     (setf elt.inner-h-t-m-l "<ul>")
     (loop :for obj :in (root objs)
        :do (incf elt.inner-h-t-m-l (+ "<li>" obj)))
     (incf elt.inner-h-t-m-l "</ul>")))
 
 ;;; Menu
 
 (defm (root api menu) (menu-data)
   (let ((elt (document.get-element-by-id "qsp-dropdown"))
         (i 0))
     (setf elt.inner-h-t-m-l "")
     (loop :for item :in menu-data
        :do (incf i)
        :do (incf elt.inner-h-t-m-l (this.make-menu-item-html i item.text item.icon item.loc)))
     (setf elt.style.display "block")))
 
 ;;; Content
 
 (defm (root api clean-audio) ()
   (loop :for k :in (*object.keys (root playing))
      :for v := (ps:getprop (root playing) k)
      :do (when (ps:@ v ended)
            (ps:delete (ps:@ (root playing) k)))))
 
+(defm (root api show-image) (path)
+  (let ((img (document.get-element-by-id "qsp-image")))
+    (cond (path
+           (setf img.src path)
+           (setf img.style.display "flex"))
+          (t
+           (setf img.src "")
+           (setf img.style.display "hidden")))))
+
+;;; Saves
+
+(defm (root api opengame) ()
+  (let ((element (document.create-element :input)))
+    (element.set-attribute :type :file)
+    (element.set-attribute :id :qsp-opengame)
+    (element.set-attribute :tabindex -1)
+    (element.set-attribute "aria-hidden" t)
+    (setf element.style.display :block)
+    (setf element.style.visibility :hidden)
+    (setf element.style.position :fixed)
+    (setf element.onchange
+          (lambda (event)
+            (let* ((file (elt event.target.files 0))
+                   (reader (ps:new (*file-reader))))
+              (setf reader.onload
+                    (lambda (ev)
+                      (block nil
+                             (let ((target ev.current-target))
+                               (unless target.result
+                                 (return))
+                               (api-call base64-to-state target.result)
+                               (api-call unstash-state)))))
+              (reader.read-as-text file))))
+    (document.body.append-child element)
+    (element.click)
+    (document.body.remove-child element)))
+
+(defm (root api savegame) ()
+  (let ((element (document.create-element :a)))
+    (element.set-attribute :href (+ "data:text/plain;charset=utf-8," (api-call state-to-base64)))
+    (element.set-attribute :download "savegame.sav")
+    (setf element.style.display :none)
+    (document.body.append-child element)
+    (element.click)
+    (document.body.remove-child element)))

src/intrinsic-macros.lisp

@@ -1,150 +1,165 b''
 
 (in-package sugar-qsp)
 
 ;;;; Macros implementing some intrinsics where it makes sense
 ;;;; E.g. an equivalent JS function exists, or it's a direct API call
 
 ;;; 1loc
 
 ;;; 2var
 
 (ps:defpsmacro killvar (varname &optional index)
   `(api-call kill-var ,varname ,index))
 
 (ps:defpsmacro killall ()
   `(api-call kill-all))
 
 ;;; 3expr
 
 (ps:defpsmacro obj (name)
   `(funcall (root objs includes) ,name))
 
 (ps:defpsmacro loc (name)
   `(funcall (root locs includes) ,name))
 
 (ps:defpsmacro no (arg)
   `(- -1 ,arg))
 
 ;;; 4code
 
 (ps:defpsmacro qspver ()
   "0.0.1")
 
 (ps:defpsmacro curloc ()
   `(root current-location))
 
 (ps:defpsmacro rnd ()
   `(funcall (root lib rand) 1 1000))
 
 (ps:defpsmacro qspmax (&rest args)
   (if (= 1 (length args))
       `(*math.max.apply nil ,@args)
       `(*math.max ,@args)))
 
 (ps:defpsmacro qspmin (&rest args)
   (if (= 1 (length args))
       `(*math.min.apply nil ,@args)
       `(*math.min ,@args)))
 
 ;;; 5arrays
 
 (ps:defpsmacro arrsize (name)
   `(api-call array-size ,name))
 
 ;;; 6str
 
 (ps:defpsmacro len (s)
   `(length ,s))
 
 (ps:defpsmacro mid (s from &optional count)
   `(ps:chain ,s (substring ,from ,count)))
 
 (ps:defpsmacro ucase (s)
   `(ps:chain ,s (to-upper-case)))
 
 (ps:defpsmacro lcase (s)
   `(ps:chain ,s (to-lower-case)))
 
 (ps:defpsmacro trim (s)
   `(ps:chain ,s (trim)))
 
 (ps:defpsmacro replace (s from to)
   `(ps:chain ,s (replace ,from ,to)))
 
 (ps:defpsmacro val (s)
   `(parse-int ,s 10))
 
 (ps:defpsmacro qspstr (n)
   `(ps:chain ,n (to-string)))
 
 ;;; 7if
 
 ;;; 8sub
 
 ;;; 9loops
 
 ;; JUMP is in ps-macros.lisp (because it's a part of a huge kludge)
 
 (ps:defpsmacro exit ()
   `(return-from nil (values)))
 
 ;;; 10dynamic
 
 ;;; 11main
 
 (ps:defpsmacro desc (s)
   (declare (ignore s))
   "")
 
 ;;; 12stat
 
 (ps:defpsmacro showstat (enable)
   `(api-call enable-frame :stat ,enable))
 
 ;;; 13diag
 
 (ps:defpsmacro msg (text)
   `(alert ,text))
 
 ;;; 14act
 
 (ps:defpsmacro showacts (enable)
   `(api-call enable-frame :acts ,enable))
 
 (ps:defpsmacro delact (name)
   `(api-call del-act ,name))
 
 (ps:defpsmacro cla ()
   `(api-call clear-act))
 
 ;;; 15objs
 
 (ps:defpsmacro showobjs (enable)
   `(api-call enable-frame :objs ,enable))
 
 (ps:defpsmacro countobj ()
   `(length (root objs)))
 
 (ps:defpsmacro getobj (index)
   `(or (elt (root objs) ,index) ""))
 
 ;;; 16menu
 
 ;;; 17sound
 
 (ps:defpsmacro isplay (filename)
   `(funcall (root playing includes) ,filename))
 
 ;;; 18img
 
+(ps:defpsmacro view (&optional path)
+  `(api-call show-image ,path))
+
 ;;; 19input
 
 ;;; 20time
 
 ;;; 21local
 
 (ps:defpsmacro local (var &optional expr)
   `(progn
      (api-call new-local ,(string (second var)))
      ,@(when expr
          `((set ,var ,expr)))))
+
+;;; 22for
+
+;;; misc
+
+(ps:defpsmacro opengame (&optional filename)
+  (declare (ignore filename))
+  `(api-call opengame))
+
+(ps:defpsmacro savegame (&optional filename)
+  (declare (ignore filename))
+  `(api-call savegame))

src/intrinsics.ps

@@ -1,324 +1,292 b''
 
 (in-package sugar-qsp)
 
 ;;;; Functions and procedures defined by the QSP language.
 ;;;; They can call api and deal with locations and other data directly.
 ;;;; Except vars. Use VAR and SET or GET-VAR and SET-VAR api calls.
 
 (setf (root lib) (ps:create))
 
 ;;; 1loc
 
 (defm (root lib goto) (target args)
   (api-call clear-text :main)
   (funcall (root lib xgoto) target (or args (list)))
   (values))
 
 (defm (root lib xgoto) (target args)
   (api-call clear-act)
   (setf (root current-location) (ps:chain target (to-upper-case)))
   (api-call stash-state args)
   (funcall (ps:getprop (root locs) (root current-location))
            (or args (list)))
   (values))
 
 ;;; 2var
 
 ;;; 3expr
 
 ;;; 4code
 
 (defm (root lib rand) (a &optional (b 1))
   (let ((min (min a b))
         (max (max a b)))
     (+ min (ps:chain *math (random (- max min))))))
 
 ;;; 5arrays
 
 (defm (root lib copyarr) (to from start count)
   (multiple-value-bind (to-name to-slot)
       (api-call var-real-name to)
     (multiple-value-bind (from-name from-slot)
         (api-call var-real-name from)
       (ps:for ((i start))
               ((< i (min (api-call array-size from-name)
                          (+ start count))))
               ((incf i))
               (api-call set-var to-name (+ start i) to-slot
                         (api-call get-var from-name (+ start i) from-slot))))))
 
 (defm (root lib arrpos) (name value &optional (start 0))
   (multiple-value-bind (real-name slot)
       (api-call var-real-name name)
     (ps:for ((i start)) ((< i (api-call array-size name))) ((incf i))
       (when (eq (api-call get-var real-name i slot) value)
         (return i))))
   -1)
 
 (defm (root lib arrcomp) (name pattern &optional (start 0))
   (multiple-value-bind (real-name slot)
       (api-call var-real-name name)
     (ps:for ((i start)) ((< i (api-call array-size name))) ((incf i))
       (when (funcall (ps:getprop (api-call get-var real-name i slot) 'match) pattern)
         (return i))))
   -1)
 
 ;;; 6str
 
 (defm (root lib instr) (s subs &optional (start 1))
   (+ start (ps:chain s (substring (- start 1)) (search subs))))
 
 (defm (root lib isnum) (s)
   (if (is-na-n s)
       0
       -1))
 
 (defm (root lib strcomp) (s pattern)
   (if (s.match pattern)
       -1
       0))
 
 (defm (root lib strfind) (s pattern group)
   (let* ((re (ps:new (*reg-exp pattern)))
          (match (re.exec s)))
     (match.group group)))
 
 (defm (root lib strpos) (s pattern &optional (group 0))
   (let* ((re (ps:new (*reg-exp pattern)))
          (match (re.exec s))
          (found (match.group group)))
     (if found
         (s.search found)
         0)))
 
 ;;; 7if
 
 ;; Has to be a function because it always evaluates all three of its
 ;; arguments
 (defm (root lib iif) (cond-expr then-expr else-expr)
   (if cond-expr then-expr else-expr))
 
 ;;; 8sub
 
 (defm (root lib gosub) (target &rest args)
   (funcall (ps:getprop (root locs) target) args)
   (values))
 
 (defm (root lib func) (target &rest args)
   (funcall (ps:getprop (root locs) target) args))
 
 ;;; 9loops
 
 ;;; 10dynamic
 
 (defm (root lib dynamic) (block &rest args)
   (funcall block args)
   (values))
 
 (defm (root lib dyneval) (block &rest args)
   (funcall block args))
 
 ;;; 11main
 
 (defm (root lib main-p) (s)
   (api-call add-text :main s)
   (values))
 
 (defm (root lib main-pl) (s)
   (api-call add-text :main s)
   (api-call newline :main)
   (values))
 
 (defm (root lib main-nl) (s)
   (api-call newline :main)
   (api-call add-text :main s)
   (values))
 
 (defm (root lib maintxt) (s)
   (api-call get-text :main)
   (values))
 
 ;; For clarity (it leaves a lib.desc() call in JS)
 (defm (root lib desc) (s)
   "")
 
 (defm (root lib main-clear) ()
   (api-call clear-text :main)
   (values))
 
 ;;; 12stat
 
 (defm (root lib stat-p) (s)
   (api-call add-text :stat s)
   (values))
 
 (defm (root lib stat-pl) (s)
   (api-call add-text :stat s)
   (api-call newline :stat)
   (values))
 
 (defm (root lib stat-nl) (s)
   (api-call newline :stat)
   (api-call add-text :stat s)
   (values))
 
 (defm (root lib stattxt) (s)
   (api-call get-text :stat)
   (values))
 
 (defm (root lib stat-clear) ()
   (api-call clear-text :stat)
   (values))
 
 (defm (root lib cls) ()
   (funcall (root lib stat-clear))
   (funcall (root lib main-clear))
   (funcall (root lib cla))
   (funcall (root lib cmdclear))
   (values))
 
 ;;; 13diag
 
 ;;; 14act
 
 (defm (root lib curacts) ()
   (let ((acts (root acts)))
     (lambda ()
       (setf (root acts) acts)
       (values))))
 
 ;;; 15objs
 
 (defm (root lib addobj) (name)
   (ps:chain (root objs) (push name))
   (api-call update-objs)
   (values))
 
 (defm (root lib delobj) (name)
   (let ((index (ps:chain (root objs) (index-of name))))
     (when (> index -1)
       (funcall (root lib killobj) (1+ index))))
   (values))
 
 (defm (root lib killobj) (&optional (num nil))
   (if (eq nil num)
       (setf (root objs) (list))
       (ps:chain (root objs) (splice (1- num) 1)))
   (api-call update-objs)
   (values))
 
 ;;; 16menu
 
 (defm (root lib menu) (menu-name)
   (let ((menu-data (list)))
     (loop :for item :in (api-call get-array (api-call var-real-name menu-name))
        :do (cond ((string= item "")
                   (break))
                  ((string= item "-:-")
                   (ps:chain menu-data (push :delimiter)))
                  (t
                   (let* ((tokens (ps:chain item (split ":"))))
                     (when (= (length tokens) 2)
                       (tokens.push ""))
                     (let* ((text (ps:chain tokens (splice 0 (- tokens.length 2)) (join ":")))
                            (loc (ps:getprop tokens (- tokens.length 2)))
                            (icon (ps:getprop tokens (- tokens.length 1))))
                       (ps:chain menu-data
                                 (push (ps:create text text
                                                  loc loc
                                                  icon icon))))))))
     (api-call menu menu-data)
     (values)))
 
 ;;; 17sound
 
 (defm (root lib play) (filename &optional (volume 100))
   (let ((audio (ps:new (*audio filename))))
     (setf (ps:getprop (root playing) filename) audio)
     (setf (ps:@ audio volume) (* volume 0.01))
     (ps:chain audio (play))))
 
 (defm (root lib close) (filename)
   (funcall (root playing filename) stop)
   (ps:delete (root playing filename)))
 
 (defm (root lib closeall) ()
   (loop :for k :in (*object.keys (root playing))
      :for v := (ps:getprop (root playing) k)
      :do (funcall v stop))
   (setf (root playing) (ps:create)))
 
 ;;; 18img
 
-(defm (root lib refint) ())
-
-(defm (root lib view) ())
+(defm (root lib refint) ()
+  ;; "Force interface update" Uh... what exactly do we do here?
+  )
 
 ;;; 19input
 
 (defm (root lib showinput) ())
 
 (defm (root lib usertxt) ())
 
 (defm (root lib cmdclear) ())
 
 (defm (root lib input) ())
 
 ;;; 20time
 
 ;; I wonder if there's a better solution than busy-wait
 (defm (root lib wait) (msec)
   (let* ((now (ps:new (*date)))
          (exit-time (+ (funcall now.get-time) msec)))
     (loop :while (< (funcall now.get-time) exit-time))))
 
 (defm (root lib msecscount) ())
 
 (defm (root lib settimer) ())
 
 ;;; 21local
 
+;;; 22for
+
 ;;; misc
 
 (defm (root lib rgb) ())
 
 (defm (root lib openqst) ())
 
 (defm (root lib addqst) ())
 
 (defm (root lib killqst) ())
 
-(defm (root lib opengame) (&optional filename)
-  (let ((element (document.create-element :input)))
-    (element.set-attribute :type :file)
-    (element.set-attribute :id :qsp-opengame)
-    (element.set-attribute :tabindex -1)
-    (element.set-attribute "aria-hidden" t)
-    (setf element.style.display :block)
-    (setf element.style.visibility :hidden)
-    (setf element.style.position :fixed)
-    (setf element.onchange
-          (lambda (event)
-            (let* ((file (elt event.target.files 0))
-                   (reader (ps:new (*file-reader))))
-              (setf reader.onload
-                    (lambda (ev)
-                      (block nil
-                             (let ((target ev.current-target))
-                               (unless target.result
-                                 (return))
-                               (api-call base64-to-state target.result)
-                               (api-call unstash-state)))))
-              (reader.read-as-text file))))
-    (document.body.append-child element)
-    (element.click)
-    (document.body.remove-child element)))
-
-(defm (root lib savegame) (&optional filename)
-  (let ((element (document.create-element :a)))
-    (element.set-attribute :href (+ "data:text/plain;charset=utf-8," (api-call state-to-base64)))
-    (element.set-attribute :download "savegame.sav")
-    (setf element.style.display :none)
-    (document.body.append-child element)
-    (element.click)
-    (document.body.remove-child element)))

src/main.ps

@@ -1,35 +1,32 b''
 
 (in-package sugar-qsp)
 
 (setf (root)
       (ps:create
        ;;; Game session state
        ;; Variables
        vars (ps:create)
        ;; Inventory (objects)
        objs (list)
        ;;; Transient state
        ;; Savegame data
        state-stash (ps:create)
        ;; List of audio files being played
        playing (ps:create)
        ;; Local variables stack (starts with an empty frame)
        locals (list)
        ;;; Game data
        ;; ACTions
        acts (ps:create)
        ;; Locations
        locs (ps:create)))
 
 ;; Launch the game from the first location
 (setf window.onload
       (lambda ()
+        (api-call init-dom)
         (funcall (ps:getprop (root locs)
                              (ps:chain *object (keys (root locs)) 0))
                  (list))
         (values)))
 
-;; Close the dropdown on any click
-(setf window.onclick
-      (lambda (event)
-        (setf (ps:@ (api-call get-frame :dropdown) style display) "none")))