Fix a bug with kill-var and calling service locations

src/api.ps

@@ -1,522 +1,523 b''
 
 (in-package txt2web.api)
 
 ;;; 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
 
 ;;; Utils
 
 (defun make-act-html (title img)
   (+ "<a class='qsp-act' href='" (href-call call-act title) "' onmouseover='" (inline-call select-act title) "'>"
      (if img (+ "<img src='" img "'>") "")
      title
      "</a>"))
 
 (defun make-menu-item-html (num title img loc)
   (+ "<a href='" (href-call finish-menu loc) "'>"
      (if img (+ "<img src='" img "'>") "")
      title
      "</a>"))
 
 (defun make-obj (title img selected)
   (+ "<li onclick='" (inline-call select-obj title img) "'>"
      "<a class='qsp-obj" (if selected " qsp-obj-selected" "") "'>"
      (if img (+ "<img src='" img "'>") "")
      title
      "</a>"))
 
 (defun make-menu-delimiter ()
   "<hr>")
 
 (defun copy-obj (obj)
   (chain *j-s-o-n (parse (chain *j-s-o-n (stringify obj)))))
 
 (defun report-error (text)
   (alert text))
 
 (defun start-sleeping ()
   (chain (by-id "qsp") class-list (add "disable")))
 
 (defun finish-sleeping ()
   (chain (by-id "qsp") class-list (remove "disable")))
 
 (defun sleep (msec)
   (with-sleep (resume)
     (set-timeout resume msec)))
 
 (defun init-dom ()
   ;; Save/load buttons
   (let ((btn (by-id "qsp-btn-save")))
     (setf (@ btn onclick) savegame)
     (setf (@ btn href) "#"))
   (let ((btn (by-id "qsp-btn-open")))
     (setf (@ btn onclick) opengame)
     (setf (@ btn href) "#"))
   ;; Close image on click
   (setf (@ (by-id "qsp-image-container") onclick)
         show-image)
   ;; Enter in input field
   (setf (@ (get-frame :input) onkeyup)
         on-input-key)
   ;; Close the dropdown on any click
   (setf (@ window onclick)
         (lambda (event)
           (setf (@ window mouse)
                 (list (@ event page-x)
                       (@ event page-y)))
           (finish-menu nil))))
 
 (defun init-globals (game-name)
   (chain *object (assign *globals (getprop *default-globals game-name))))
 
 (defun call-serv-loc (var-name &rest args)
   (let ((loc-name (get-global var-name 0)))
     (when loc-name
-      (let ((loc (getprop *locs loc-name)))
+      (let ((loc (getprop *locs (chain loc-name (to-upper-case)))))
         (when loc
           (call-loc loc-name args))))))
 
 (defun filename-game (filename)
   (let ((game-name (chain filename (match "(.*/)?([^.]+)(\\.[a-zA-Z]+)?") 2))))
   (getprop *games game-name))
 
 (defun run-game (name)
   (let ((game (filename-game name)))
     (setf *main-game name)
     ;; Replace locations with the new game's 
     (setf *locs game)
     (funcall (getprop game
                       (chain *object (keys game) 0))
              (list))))
 
 ;;; Misc
 
 (defun newline (key)
   (append-id (key-to-id key) "<br>" t))
 
 (defun clear-id (id)
   (setf (inner-html (by-id id)) ""))
 
 (defun escape-html (text)
   (chain text
          (replace (regex "/&/g") "&amp;")
          (replace (regex "/</g") "&lt;")
          (replace (regex "/>/g") "&gt;")
          (replace (regex "/\"/g") "&quot;")
          (replace (regex "/'/g") "&apos;")))
 
 (defun prepare-contents (s &optional force-html)
   (setf s (chain s (to-string)))
   (if (or force-html (get-global "USEHTML" 0))
       s
       (escape-html s)))
 
 (defun get-id (id &optional force-html)
   (inner-html (by-id id)))
 
 (defun set-id (id contents &optional force-html)
   (setf (inner-html (by-id id)) (prepare-contents contents force-html)))
 
 (defun append-id (id contents &optional force-html)
   (when contents
     (incf (inner-html (by-id id)) (prepare-contents contents force-html))))
 
 (defun on-input-key (ev)
   (when (= 13 (@ ev key-code))
     (chain ev (prevent-default))
     (call-serv-loc "$USERCOM")))
 
 ;;; Function calls
 
 (defun init-args (args)
   (dotimes (i 10)
     (set-global "ARGS"  i 0)
     (set-global "$ARGS" i "")
     (when (and args (< i (length args)))
       (let ((arg (elt args i)))
         (if (numberp arg)
             (set-global "ARGS"  i arg)
             (set-global "$ARGS" i arg))))))
 
 (defun get-result ()
   (or (get-global "$RESULT" 0)
       (get-global "RESULT" 0)))
 
 (defun call-loc (name args)
   (setf name (chain name (to-upper-case)))
   (with-frame
       (with-call-args args t
         (funcall (getprop *locs name)))))
 
 (defun call-act (title)
   (with-frame
       (funcall (getprop *acts title :act)))
   (void))
 
 ;;; Text windows
 
 (defun key-to-id (key)
   (case key
     (:all "qsp")
     (:main "qsp-main")
     (:stat "qsp-stat")
     (:objs "qsp-objs")
     (:acts "qsp-acts")
     (:input "qsp-input")
     (:image "qsp-image")
     (:dropdown "qsp-dropdown")
     (t (report-error "Internal error!"))))
 
 (defun get-frame (key)
   (by-id (key-to-id key)))
 
 (defun add-text (key text)
   (append-id (key-to-id key) text))
 
 (defun get-text (key)
   (get-id (key-to-id key)))
 
 (defun clear-text (key)
   (clear-id (key-to-id key)))
 
 (defun enable-frame (key enable)
   (let ((obj (get-frame key)))
     (setf (@ obj style display) (if enable "block" "none"))
     (void)))
 
 ;;; Actions
 
 (defun add-act (title img act)
   (setf (getprop *acts title)
         (create :title title :img img :act act :selected nil))
   (update-acts))
 
 (defun del-act (title)
   (delete (getprop *acts title))
   (update-acts))
 
 (defun clear-act ()
   (setf *acts (create))
   (update-acts))
 
 (defun update-acts ()
   (clear-id "qsp-acts")
   (let ((elt (by-id "qsp-acts")))
     (for-in (title *acts)
             (let ((obj (getprop *acts title)))
               (incf (inner-html elt) (make-act-html title (getprop obj :img)))))))
 
 (defun select-act (title)
   (loop :for (k v) :of *acts
      :do (setf (getprop v :selected) nil))
   (setf (getprop *acts title :selected) t)
   (call-serv-loc "$ONACTSEL"))
 
 ;;; Variables
 
 (defun new-var (slot &rest indexes)
   (let ((v (list)))
     (dolist (index indexes)
       (setf (elt v index) (if (eq #\$ (elt slot 0)) "" 0)))
     (setf (@ v :indexes) (create))
     v))
 
 (defun set-str-element (slot index value)
   (if (has index (getprop slot :indexes))
-      (setf (elt (getprop slot) 
-                 (getprop slot :indexes index))
+      (setf (elt slot (getprop slot :indexes index))
             value)
       (progn
         (chain slot (push value))
-        (setf (elt slot index)
-              (length slot))))
+        (setf (getprop slot :indexes index)
+              (1- (length slot)))))
   (void))
 
 (defun set-any-element (slot index value)
   (cond ((null index)
          (chain (elt slot) (push value)))
         ((numberp index)
          (setf (elt slot index) value))
         ((stringp index)
          (set-str-element slot index value))
         (t (report-error "INTERNAL ERROR")))
   (void))
 
 (defun set-serv-var (name index value)
   (let ((slot (getprop *globals name)))
     (set-any-element slot index value))
   (funcall (getprop serv-vars name :body) value index)
   (void))
 
 (defun get-element (slot index)
   (if (numberp index)
       (elt slot index)
       (elt slot (getprop slot :indexes index))))
 
 (defun set-global (name index value)
   (set-any-element (getprop *globals name) index value))
 
 (defun get-global (name index)
   (get-element (getprop *globals name) index))
 
 (defun kill-var (&optional name index)
   (cond (name
          (setf name (chain name (to-upper-case)))
-         (if (and index (not (= 0 index))) 
-             (chain (getprop *globals name) (kill index))
-             (delete (getprop *globals name))))
+         (cond ((and index (not (= 0 index))) 
+                (chain (getprop *globals name) (kill index)))
+               (t
+                (setf (getprop *globals name) (list))
+                (setf (getprop *globals name "indexes") (create)))))
         (t
          (setf *globals (create))
          (init-globals *main-game)))
   (void))
 
 (defun array-size (name)
   (@ (var-ref name) :values length))
 
 ;;; Locals
 
 (defun push-local-frame ()
   (chain *locals (push (create)))
   (void))
 
 (defun pop-local-frame ()
   (chain *locals (pop))
   (void))
 
 (defun current-local-frame ()
   (elt *locals (1- (length *locals))))
 
 ;;; Objects
 
 (defun select-obj (title img)
   (loop :for (k v) :of *objs
      :do (setf (getprop v :selected) nil))
   (setf (getprop *objs title :selected) t)
   (call-serv-loc "$ONOBJSEL" title img))
 
 (defun update-objs ()
   (let ((elt (by-id "qsp-objs")))
     (setf (inner-html elt) "<ul>")
     (loop :for (name obj) :of *objs
        :do (incf (inner-html elt)
                  (make-obj name (@ obj :img) (@ obj :selected))))
     (incf (inner-html elt) "</ul>")))
 
 ;;; Menu
 
 (defun open-menu (menu-data)
   (let ((elt (get-frame :dropdown))
         (i 0))
     (loop :for item :in menu-data
        :do (incf i)
        :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 *menu-resume
     (let ((elt (get-frame :dropdown)))
       (setf (inner-html elt) "")
       (setf (@ elt style display) "none")
       (funcall *menu-resume)
       (setf *menu-resume nil))
     (when loc
       (call-loc loc)))
   (void))
 
 (defun menu (menu-data)
   (with-sleep (resume)
     (open-menu menu-data)
     (setf *menu-resume resume))
   (void))
 
 ;;; Content
 
 (defun clean-audio ()
   (loop :for k :in (chain *object (keys *playing))
      :for v := (getprop *playing k)
      :do (when (@ v ended)
            (delete (@ *playing k)))))
 
 (defun show-image (path)
   (let ((img (get-frame :image)))
     (cond (path
            (setf (@ img src) path)
            (setf (@ img style display) "flex"))
           (t
            (setf (@ img src) "")
            (setf (@ img style display) "hidden")))))
 
 (defun rgb-string (rgb)
   (let ((red (ps::>> rgb 16))
         (green (logand (ps::>> rgb 8) 255))
         (blue (logand rgb 255)))
     (flet ((rgb-to-hex (comp)
              (let ((hex (chain (*number comp) (to-string 16))))
                (if (< (length hex) 2)
                    (+ "0" hex)
                    hex))))
       (+ "#" (rgb-to-hex red) (rgb-to-hex green) (rgb-to-hex blue)))))
 
 (defun store-obj (key obj)
   (store-str key (btoa (encode-u-r-i-component (chain *j-s-o-n (stringify obj)))))
   (void))
 (defun store-str (key str)
   (chain local-storage (set-item (+ "qsp_" key) str))
   (void))
 
 (defun load-obj (key)
   (chain *j-s-o-n (parse (encode-u-r-i-component (atob (load-str key))))))
 (defun load-str (key)
   (chain local-storage (get-item (+ "qsp_" key))))
 
 ;;; Saves
 
 (defun slot-savegame (slot comment)
   (let ((saves (load-obj "saves")))
     (setf (@ saves slot) comment)
     (store-obj saves))
   (store-str slot (state-to-base64))
   (void))
 
 (defun slot-loadgame (slot)
   (base64-to-state (load-str slot))
   (void))
 
 (defun slot-deletegame (slot)
   (let ((saves (load-obj "saves")))
     (setf (@ saves slot) undefined)
     (store-obj saves))
   (store-str slot undefined)
   (void))
 
 (defun slot-listgames ()
   (load-obj "saves"))
 
 (defun opengame ()
   (let ((element (chain document (create-element :input))))
     (chain element (set-attribute :type :file))
     (chain element (set-attribute :id :qsp-opengame))
     (chain element (set-attribute :tabindex -1))
     (chain 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 (@ event target files 0))
                    (reader (new (*file-reader))))
               (setf (@ reader onload)
                     (lambda (ev)
                       (block nil
                         (let ((target (@ ev current-target)))
                           (unless (@ target result)
                             (return))
                           (base64-to-state (@ target result))
                           (unstash-state)))))
               (chain reader (read-as-text file)))))
     (chain document body (append-child element))
     (chain element (click))
     (chain document body (remove-child element))))
 
 (defun savegame ()
   (let ((element (chain document (create-element :a))))
     (chain element (set-attribute :href (+ "data:text/plain;charset=utf-8," (state-to-base64))))
     (chain element (set-attribute :download "savegame.sav"))
     (setf (@ element style display) :none)
     (chain document body (append-child element))
     (chain element (click))
     (chain document body (remove-child element))))
 
 (defun stash-state (args)
   (call-serv-loc "$ONGSAVE")
   (setf *state-stash
         (chain *j-s-o-n (stringify
                          (create :vars *globals
                                  :objs *objs
                                  :loc-args args
                                  :msecs (- (chain *date (now)) *started-at)
                                  :timer-interval *timer-interval
                                  :main-html (inner-html
                                              (get-frame :main))
                                  :stat-html (inner-html
                                              (get-frame :stat))
                                  :next-location *current-location))))
   (void))
 
 (defun unstash-state ()
   (let ((data (chain *j-s-o-n (parse *state-stash))))
     (clear-act)
     (setf *globals (@ data :vars))
     (loop :for k :in (chain *object (keys *globals))
        :do (chain *object (set-prototype-of (getprop *globals k)
                                             (@ *var prototype))))
     (setf *started-at (- (chain *date (now)) (@ data :msecs)))
     (setf *objs (@ data :objs))
     (setf *current-location (@ data :next-location))
     (setf (inner-html (get-frame :main))
           (@ data :main-html))
     (setf (inner-html (get-frame :stat))
           (@ data :stat-html))
     (update-objs)
     (set-timer (@ data :timer-interval))
     (call-serv-loc "$ONGLOAD")
     (call-loc *current-location (@ data :loc-args))
     (void)))
 
 (defun state-to-base64 ()
   (btoa (encode-u-r-i-component *state-stash)))
 
 (defun base64-to-state (data)
   (setf *state-stash (decode-u-r-i-component (atob data))))
 
 ;;; Timers
 
 (defun set-timer (interval)
   (setf *timer-interval interval)
   (clear-interval *timer-obj)
   (setf *timer-obj
         (set-interval
          (lambda ()
            (call-serv-loc "$COUNTER"))
          interval)))
 
 ;;; Special variables
 
 (defvar serv-vars (create))
 
 (define-serv-var $backimage (path)
   (setf (@ (get-frame :main) style background-image) path))
 
 (define-serv-var bcolor (color)
   (setf (@ (get-frame :all) style background-color) (rgb-string color)))
 
 (define-serv-var fcolor (color)
   (setf (@ (get-frame :all) style color) (rgb-string color)))
 
 (define-serv-var lcolor (color)
   (setf (@ (get-frame :style) inner-text)
         (+ "a { color: " (rgb-string color) ";}")))
 
 (define-serv-var fsize (size)
   (setf (@ (get-frame :all) style font-size) size))
 
 (define-serv-var $fname (font-name)
   (setf (@ (get-frame :all) style font-family) (+ font-name ",serif")))

src/intrinsics.ps

@@ -1,317 +1,315 b''
 
 (in-package txt2web.lib)
 
 ;;;; 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.
 
 ;;; 1loc
 
 (defun goto (target args)
   (api:clear-text :main)
   (funcall xgoto target args)
   (void))
 
 (defun xgoto (target args)
   (setf args (or args (list)))
   (api:clear-act)
   (setf *current-location (chain target (to-upper-case)))
   (api:stash-state args)
   (api:call-loc *current-location args)
   (api:call-serv-loc "$ONNEWLOC")
   (void))
 
 ;;; 2var
 
 ;;; 3expr
 
 (defun obj (name)
   (has name *objs))
 
 (defun loc (name)
   (has name *locs))
 
 ;;; 4code
 
 (defun rand (a &optional (b 1))
   (let ((min (min a b))
         (max (max a b)))
     (+ min (chain *math (random (- max min))))))
 
 ;;; 5arrays
 
 (defun copyarr (to from start count)
   (multiple-value-bind (to-name to-slot)
       (api:var-real-name to)
     (multiple-value-bind (from-name from-slot)
         (api:var-real-name from)
       (loop :for i :from start :to (min (api:array-size from-name)
                                         (+ start count))
          :do (api:set-var to-name (+ start i) to-slot
                           (api:get-var from-name (+ start i) from-slot))))))
 
 (defun arrpos (name value &optional (start 0))
   (multiple-value-bind (real-name slot)
       (api:var-real-name name)
     (loop :for i :from start :to (api:array-size name)
        :do (when (eq (api:get-var real-name i slot) value)
              (return-from arrpos i))))
   -1)
 
 (defun arrcomp (name pattern &optional (start 0))
   (multiple-value-bind (real-name slot)
       (api:var-real-name name)
     (loop :for i :from start :to (api:array-size name)
        :do (when (funcall (getprop (api:get-var real-name i slot)
                                    'match)
                           pattern)
              (return-from arrcomp i))))
   -1)
 
 ;;; 6str
 
 (defun instr (s subs &optional (start 1))
   (+ start (chain s (substring (- start 1)) (search subs))))
 
 (defun isnum (s)
   (if (is-na-n s)
       0
       -1))
 
 (defun strcomp (s pattern)
   (if (chain s (match pattern))
       -1
       0))
 
 (defun strfind (s pattern group)
   (let* ((re (new (*reg-exp pattern)))
          (match (chain re (exec s))))
     (chain match (group group))))
 
 (defun strpos (s pattern &optional (group 0))
   (let* ((re (new (*reg-exp pattern)))
          (match (chain re (exec s)))
          (found (chain match (group group))))
     (if found
         (chain s (search found))
         0)))
 
 ;;; 7if
 
 ;; Has to be a function because it always evaluates all three of its
 ;; arguments
 (defun iif (cond-expr then-expr else-expr)
   (if cond-expr then-expr else-expr))
 
 ;;; 8sub
 
 (defun gosub (target &rest args)
   (api:call-loc target args)
   (void))
 
 (defun func (target &rest args)
   (api:call-loc target args))
 
 ;;; 9loops
 
 ;;; 10dynamic
 
 ;;; 11main
 
 (defun main-p (s)
   (api:add-text :main s)
   (void))
 
 (defun main-pl (s)
   (api:add-text :main s)
   (api:newline :main)
   (void))
 
 (defun main-nl (s)
   (api:newline :main)
   (api:add-text :main s)
   (void))
 
-(defun maintxt (s)
-  (api:get-text :main)
-  (void))
+(defun maintxt ()
+  (api:get-text :main))
 
-(defun desc (s)
+(defun desc ()
   "")
 
 (defun main-clear ()
   (api:clear-text :main)
   (void))
 
 ;;; 12stat
 
 (defun stat-p (s)
   (api:add-text :stat s)
   (void))
 
 (defun stat-pl (s)
   (api:add-text :stat s)
   (api:newline :stat)
   (void))
 
 (defun stat-nl (s)
   (api:newline :stat)
   (api:add-text :stat s)
   (void))
 
-(defun stattxt (s)
-  (api:get-text :stat)
-  (void))
+(defun stattxt ()
+  (api:get-text :stat))
 
 (defun stat-clear ()
   (api:clear-text :stat)
   (void))
 
 (defun cls ()
   (stat-clear)
   (main-clear)
   (cla)
   (cmdclear)
   (void))
 
 ;;; 13diag
 
 ;;; 14act
 
 (defun selact ()
   (loop :for (k v) :of *acts
      :do (when (@ v :selected)
            (return-from selact (@ v :name)))))
 
 (defun curacts ()
   (let ((acts (api-call copy-obj *acts)))
     (lambda ()
       (setf *acts acts)
       (void))))
 
 ;;; 15objs
 
 (defun addobj (name img)
   (setf img (or img ""))
   (setf (getprop *objs name)
         (create :name name :img img :selected nil))
   (api:update-objs)
   (api-call call-serv-loc "$ONOBJADD" name img)
   (void))
 
 (defun delobj (name)
   (delete (getprop *objs name))
   (api:update-objs)
   (api-call call-serv-loc "$ONOBJDEL" name)
   (void))
 
 (defun killobj (&optional (num nil))
   (if (eq undefined num)
       (setf *objs (create))
       (delobj (elt (chain *object (keys *objs)) num)))
   (api:update-objs)
   (void))
 
 (defun selobj ()
   (loop :for (k v) :of *objs
      :do (when (@ v :selected)
            (return-from selobj (@ v :name)))))
 
 (defun unsel ()
   (loop :for (k v) :of *objs
      :do (setf (@ v :selected) nil)))
 
 ;;; 16menu
 
 (defun menu (menu-name)
   (let ((menu-data (list)))
     (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 "-:-")
                   (chain menu-data (push :delimiter)))
                  (t
                   (let* ((tokens (chain item (split ":"))))
                     (when (= (length tokens) 2)
                       (chain tokens (push "")))
                     (let* ((text (chain tokens (splice 0 (- (length tokens) 2)) (join ":")))
                            (loc (getprop tokens (- (length tokens) 2)))
                            (icon (getprop tokens (- (length tokens) 1))))
                       (chain menu-data
                              (push (create :text text
                                            :loc loc
                                            :icon icon))))))))
     (api:menu menu-data)
     (void)))
 
 ;;; 17sound
 
 (defun play (filename &optional (volume 100))
   (let ((audio (new (*audio filename))))
     (setf (getprop *playing filename) audio)
     (setf (@ audio volume) (* volume 0.01))
     (chain audio (play))))
 
 (defun close (filename)
   (funcall (getprop *playing filename) stop)
   (delete (getprop *playing filename))
   (void))
 
 (defun closeall ()
   (loop :for k :in (chain *object (keys *playing))
      :for v := (getprop *playing k)
      :do (funcall v stop))
   (setf *playing (create)))
 
 ;;; 18img
 
 (defun refint ()
   ;; "Force interface update" Uh... what exactly do we do here?
   ;(api:report-error "REFINT is not supported")
   )
 
 ;;; 19input
 
 (defun usertxt ()
   (let ((input (by-id "qsp-input")))
     (@ input value)))
 
 (defun cmdclear ()
   (let ((input (by-id "qsp-input")))
     (setf (@ input value) "")))
 
 (defun input (text)
   (chain window (prompt text)))
 
 ;;; 20time
 
 (defun msecscount ()
   (- (chain *date (now)) *started-at))
 
 ;;; 21local
 
 ;;; 22for
 
 ;;; misc
 
 (defun rgb (red green blue)
   (+ (<< red 16)
      (<< green 8)
      blue))
 
 (defun openqst (name)
   (api-call run-game name))
 
 (defun addqst (name)
   (let ((game (api-call filename-game name)))
     ;; Add the game's locations
     (chain *object (assign *locs
                            (getprop *games name)))))
 
 (defun killqst ()
   ;; Delete all locations not from the current main game
   (loop :for (k v) :in *games
      :do (unless (string= k *main-game)
            (delete (getprop *locs k)))))