Sounds, save/load UI buttons

extras/body.html

@@ -1,15 +1,19 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>
+  </div>
 </div>
 
 <div id="qsp-dropdown">
 </div>

extras/default.css

@@ -1,84 +1,103 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
+/* 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 {
+    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 {
+    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');
+}

src/api.ps

@@ -1,200 +1,210 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>"))
 
 ;; To be used in saving game
 (defm (root api stash-state) ()
   (setf (root state-stash)
         (*j-s-o-n.stringify
          (ps:create vars (root vars)
                     objs (root objs)
                     next-location (root current-location))))
   (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)))
   (let ((data (*j-s-o-n.parse (root state-stash))))
+    (api-call clear-id :qsp-main)
+    (api-call clear-id :qsp-stat)
     (api-call clear-act)
     (setf (root vars) (ps:@ data vars))
     (setf (root objs) (ps:@ data objs))
     (setf (root current-location) (ps:@ data next-location))
     (funcall (root locs (root current-location)))
     (api-call update-objs)
     (values)))
 
 ;;; 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)
       (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)
       (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)
       (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))
     (if (numberp (elt args i))
         (set (var args i) (elt args i))
         (set (var $args i) (elt args i)))))
 
 (defm (root api get-result) ()
   (if (not (equal "" (var $result 0)))
       (var $result 0)
       (var result 0)))
 
 ;;; 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 (api-call key-to-id key)))
 
 (defm (root api add-text) (key text)
   (api-call append-id (api-call key-to-id key) text))
 
 (defm (root api get-text) (key)
   (api-call get-id (api-call key-to-id key)))
 
 (defm (root api clear-text) (key)
   (api-call clear-id (api-call key-to-id key)))
 
 (defm (root api newline) (key)
   (let ((div (api-call get-frame key)))
     (ps:chain div (append-child (document.create-element "br")))))
 
 (defm (root api enable-frame) (key enable)
   (let ((clss (ps:getprop (api-call 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))
   (api-call update-acts))
 
 (defm (root api del-act) (title)
   (delete (ps:getprop (root acts) title))
   (api-call update-acts))
 
 (defm (root api clear-act) ()
   (setf (root acts) (ps:create))
   (api-call clear-id "qsp-acts"))
 
 (defm (root api update-acts) ()
   (api-call clear-id "qsp-acts")
   (ps:for-in (title (root acts))
     (let ((obj (ps:getprop (root acts) title)))
       (api-call append-id "qsp-acts"
                 (api-call make-act-html title (ps:getprop obj :img))))))
 
 ;;; Variables
 
 (defm (root api var-slot) (name)
   (if (= (ps:@ name 0) #\$)
       :str
       :num))
 
 (defm (root api var-real-name) (name)
   (if (= (ps:@ name 0) #\$)
       (ps:chain name (substr 1))
       name))
 
 (defm (root api ensure-var) (name index)
   (unless (in name (root vars))
     (setf (ps:getprop (root vars) name)
           (ps:create)))
   (unless (in index (ps:getprop (root vars) name))
     (setf (ps:getprop (root vars) name index)
           (ps:create :num 0 :str "")))
   (values))
 
 (defm (root api get-var) (name index)
   (let ((var-name (api-call var-real-name name)))
     (api-call ensure-var var-name index)
     (ps:getprop (root vars) var-name index
                 (api-call var-slot name))))
 
 (defm (root api set-var) (name index value)
   (let ((var-name (api-call var-real-name name)))
     (api-call ensure-var var-name index)
     (setf (ps:getprop (root vars) var-name index
                       (api-call var-slot name))
           value)
     (values)))
 
 (defm (root api get-array) (name type)
   (ps:getprop (root vars) (api-call var-real-name name)))
 
 (defm (root api kill-var) (name index)
   (if (eq index :whole)
       (ps:delete (ps:getprop (root vars) name))
       (ps:delete (ps:getprop (root vars) name index)))
   (values))
 
 (defm (root api array-size) (name)
   (ps:getprop (root vars) (api-call var-real-name name) 'length))
 
 ;;; 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 (api-call 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)))))

src/intrinsic-macros.lisp

@@ -1,137 +1,140 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 :whole))
   `(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)
   `(max ,@args))
 
 (ps:defpsmacro qspmin (&rest args)
   `(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
 
 ;;; 19input
 
 ;;; 20time
 
 ;;; misc

src/intrinsics.ps

@@ -1,313 +1,321 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 &rest args)
   (api-call clear-text :main)
   (apply (root lib xgoto) target args))
 
 (defm (root lib xgoto) (target &rest args)
   (api-call clear-act)
   (api-call init-args args)
   (setf (root current-location) (ps:chain target (to-upper-case)))
   (api-call stash-state)
   (funcall (ps:getprop (root locs) (root current-location))))
 
 ;;; 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)
   (ps:for ((i start))
           ((< i (min (api-call array-size from)
                      (+ start count))))
           ((incf i))
     (api-call set-var to (+ start i)
               (api-call get-var from (+ start i)))))
 
 (defm (root lib arrpos) (name value &optional (start 0))
   (ps:for ((i start)) ((< i (api-call array-size name))) ((incf i))
     (when (eq (api-call get-var name i) value)
       (return i)))
   -1)
 
 (defm (root lib arrcomp) (name pattern &optional (start 0))
   (ps:for ((i start)) ((< i (api-call array-size name))) ((incf i))
     (when (funcall (ps:getprop (api-call get-var name i) '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)
   (conserving-vars (args result)
     (api-call init-args args)
     (funcall (ps:getprop (root locs) target))
     (values)))
 
 (defm (root lib func) (target &rest args)
   (conserving-vars (args result)
     (api-call init-args args)
     (funcall (ps:getprop (root locs) target))
     (api-call get-result)))
 
 ;;; 9loops
 
 ;;; 10dynamic
 
 (defm (root lib dyneval) (block &rest args)
   (conserving-vars (args result)
     (api-call init-args args)
     (funcall block)
     (api-call get-result)))
 
 (defm (root lib dynamic) (&rest args)
   (conserving-vars (args result)
     (api-call init-args args)
     (funcall block)
     (values)))
 
 ;;; 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) index)))
+      (funcall (root lib killobj) (1+ index))))
   (values))
 
-(defm (root lib killobj) (&optional num)
-  (if num
-      (ps:chain (root objs) (splice (1+ num) 1))
-      (setf (root objs) (list)))
+(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 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) ())
-
-(defm (root lib isplay) ())
+(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) ())
+(defm (root lib close) (filename)
+  (funcall (root playing filename) stop)
+  (ps:delete (root playing filename)))
 
-(defm (root lib closeall) ())
+(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) ())
 
 ;;; 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) ())
 
 ;;; 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)))))
               (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,21 +1,32 b''
 
 (in-package sugar-qsp)
 
 (setf (root)
-      (ps:create vars (ps:create)
-                 objs (list)
-                 state-stash (ps:create)
-                 acts (ps:create)
-                 locs (ps:create)))
+      (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)
+       ;;; Game data
+       ;; ACTions
+       acts (ps:create)
+       ;; Locations
+       locs (ps:create)))
 
 ;; Launch the game from the first location
 (setf window.onload
       (lambda ()
         (funcall (ps:getprop (root locs)
                              (ps:chain *object (keys (root locs)) 0)))
         (values)))
 
 ;; Close the dropdown on any click
 (setf window.onclick
       (lambda (event)
         (setf (ps:@ (api-call get-frame :dropdown) style display) "none")))