diff --git a/src/api.ps b/src/api.ps
--- a/src/api.ps
+++ b/src/api.ps
@@ -68,19 +68,19 @@
(defun call-serv-loc (var-name &rest args)
(let ((loc-name (get-global var-name 0)))
(when loc-name
- (let ((loc (getprop (root locs) loc-name)))
+ (let ((loc (getprop *locs loc-name)))
(when loc
(call-loc loc-name args))))))
(defun filename-game (filename)
(let ((game-name (chain filename (match "(.*/)?([^.]+)(\\.[a-zA-Z]+)?") 2))))
- (getprop (root games) game-name))
+ (getprop *games game-name))
(defun run-game (name)
(let ((game (filename-game name)))
- (setf (root main-game) name)
+ (setf *main-game name)
;; Replace locations with the new game's
- (setf (root locs) game)
+ (setf *locs game)
(funcall (getprop game
(chain *object (keys game) 0))
(list))))
@@ -139,11 +139,11 @@
(setf name (chain name (to-upper-case)))
(with-frame
(with-call-args args
- (funcall (getprop (root locs) name)))))
+ (funcall (getprop *locs name)))))
(defun call-act (title)
(with-frame
- (funcall (getprop (root acts) title :act))))
+ (funcall (getprop *acts title :act))))
;;; Text windows
@@ -179,29 +179,29 @@
;;; Actions
(defun add-act (title img act)
- (setf (getprop (root acts) title)
+ (setf (getprop *acts title)
(create :title title :img img :act act :selected nil))
(update-acts))
(defun del-act (title)
- (delete (getprop (root acts) title))
+ (delete (getprop *acts title))
(update-acts))
(defun clear-act ()
- (setf (root acts) (create))
+ (setf *acts (create))
(update-acts))
(defun update-acts ()
(clear-id "qsp-acts")
(let ((elt (by-id "qsp-acts")))
- (for-in (title (root acts))
- (let ((obj (getprop (root acts) title)))
+ (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 (root acts)
+ (loop :for (k v) :of *acts
:do (setf (getprop v :selected) nil))
- (setf (getprop (root acts) title :selected) t)
+ (setf (getprop *acts title :selected) t)
(call-serv-loc "$ONACTSEL"))
;;; "Syntax"
@@ -244,13 +244,13 @@
(elt slot (getprop slot :indexes index))))
(defun get-global (name index)
- (elt (getprop (root vars) name) index))
+ (elt (getprop *globals name) index))
(defun kill-var (store 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)))
+ (chain (getprop *vars name) (kill index))
+ (delete (getprop *vars name)))
(void))
(defun array-size (name)
@@ -259,28 +259,28 @@
;;; Locals
(defun push-local-frame ()
- (chain (root locals) (push (create)))
+ (chain *locals (push (create)))
(void))
(defun pop-local-frame ()
- (chain (root locals) (pop))
+ (chain *locals (pop))
(void))
(defun current-local-frame ()
- (elt (root locals) (1- (length (root locals)))))
+ (elt *locals (1- (length *locals))))
;;; Objects
(defun select-obj (title img)
- (loop :for (k v) :of (root objs)
+ (loop :for (k v) :of *objs
:do (setf (getprop v :selected) nil))
- (setf (getprop (root objs) title :selected) t)
+ (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) "
")
- (loop :for (name obj) :of (root objs)
+ (loop :for (name obj) :of *objs
:do (incf (inner-html elt)
(make-obj name (@ obj :img) (@ obj :selected))))
(incf (inner-html elt) "
")))
@@ -312,12 +312,12 @@
(setf (@ elt style display) "block")))
(defun finish-menu (loc)
- (when (root menu-resume)
+ (when *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))
+ (funcall *menu-resume)
+ (setf *menu-resume nil))
(when loc
(call-loc loc)))
(void))
@@ -325,16 +325,16 @@
(defun menu (menu-data)
(with-sleep (resume)
(open-menu menu-data)
- (setf (root menu-resume) resume))
+ (setf *menu-resume resume))
(void))
;;; Content
(defun clean-audio ()
- (loop :for k :in (chain *object (keys (root playing)))
- :for v := (getprop (root playing) k)
+ (loop :for k :in (chain *object (keys *playing))
+ :for v := (getprop *playing k)
:do (when (@ v ended)
- (delete (@ (root playing) k)))))
+ (delete (@ *playing k)))))
(defun show-image (path)
(let ((img (get-frame :image)))
@@ -406,30 +406,30 @@
(defun stash-state (args)
(call-serv-loc "$ONGSAVE")
- (setf (root state-stash)
+ (setf *state-stash
(chain *j-s-o-n (stringify
- (create :vars (root vars)
- :objs (root objs)
+ (create :vars *vars
+ :objs *objs
:loc-args args
- :msecs (- (chain *date (now)) (root started-at))
- :timer-interval (root timer-interval)
+ :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 (root current-location)))))
+ :next-location *current-location))))
(void))
(defun unstash-state ()
- (let ((data (chain *j-s-o-n (parse (root state-stash)))))
+ (let ((data (chain *j-s-o-n (parse *state-stash))))
(clear-act)
- (setf (root vars) (@ data :vars))
- (loop :for k :in (chain *object (keys (root vars)))
- :do (chain *object (set-prototype-of (getprop (root vars) k)
+ (setf *vars (@ data :vars))
+ (loop :for k :in (chain *object (keys *vars))
+ :do (chain *object (set-prototype-of (getprop *vars k)
(@ *var prototype))))
- (setf (root started-at) (- (chain *date (now)) (@ data :msecs)))
- (setf (root objs) (@ data :objs))
- (setf (root current-location) (@ data :next-location))
+ (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))
@@ -437,21 +437,21 @@
(update-objs)
(set-timer (@ data :timer-interval))
(call-serv-loc "$ONGLOAD")
- (call-loc (root current-location) (@ data :loc-args))
+ (call-loc *current-location (@ data :loc-args))
(void)))
(defun state-to-base64 ()
- (btoa (encode-u-r-i-component (root state-stash))))
+ (btoa (encode-u-r-i-component *state-stash)))
(defun base64-to-state (data)
- (setf (root state-stash) (decode-u-r-i-component (atob data))))
+ (setf *state-stash (decode-u-r-i-component (atob data))))
;;; Timers
(defun set-timer (interval)
- (setf (root timer-interval) interval)
- (clear-interval (root timer-obj))
- (setf (root timer-obj)
+ (setf *timer-interval interval)
+ (clear-interval *timer-obj)
+ (setf *timer-obj
(set-interval
(lambda ()
(call-serv-loc "$COUNTER"))
diff --git a/src/intrinsic-macros.lisp b/src/intrinsic-macros.lisp
--- a/src/intrinsic-macros.lisp
+++ b/src/intrinsic-macros.lisp
@@ -17,10 +17,10 @@
;;; 3expr
(defpsmacro obj (name)
- `(in ,name (root objs)))
+ `(in ,name objs))
(defpsmacro loc (name)
- `(in ,name (root locs)))
+ `(in ,name locs))
(defpsmacro no (arg)
`(- -1 ,arg))
@@ -31,7 +31,7 @@
"0.0.1")
(defpsmacro curloc ()
- `(root current-location))
+ `current-location)
(defpsmacro rnd ()
`(funcall rand 1 1000))
@@ -123,17 +123,17 @@
`(api-call enable-frame :objs ,enable))
(defpsmacro countobj ()
- `(length (root objs)))
+ `(length objs))
(defpsmacro getobj (index)
- `(or (elt (root objs) ,index) ""))
+ `(or (elt objs ,index) ""))
;;; 16menu
;;; 17sound
(defpsmacro isplay (filename)
- `(funcall (root playing includes) ,filename))
+ `(funcall (@ playing includes) ,filename))
;;; 18img
diff --git a/src/intrinsics.ps b/src/intrinsics.ps
--- a/src/intrinsics.ps
+++ b/src/intrinsics.ps
@@ -15,9 +15,9 @@
(defun xgoto (target args)
(setf args (or args (list)))
(api:clear-act)
- (setf (root current-location) (chain target (to-upper-case)))
+ (setf *current-location (chain target (to-upper-case)))
(api:stash-state args)
- (api:call-loc (root current-location) args)
+ (api:call-loc *current-location args)
(api:call-serv-loc "ONNEWLOC")
(void))
@@ -186,35 +186,35 @@
;;; 14act
(defun curacts ()
- (let ((acts (root acts)))
+ (let ((acts *acts))
(lambda ()
- (setf (root acts) acts)
+ (setf *acts acts)
(void))))
;;; 15objs
(defun addobj (name img)
(setf img (or img ""))
- (setf (getprop (root objs) name)
+ (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 (root objs) name))
+ (delete (getprop *objs name))
(api-call call-serv-loc "ONOBJDEL" name)
(void))
(defun killobj (&optional (num nil))
(if (eq nil num)
- (setf (root objs) (create))
- (delobj (elt (chain *object (keys (root objs))) num)))
+ (setf *objs (create))
+ (delobj (elt (chain *object (keys *objs)) num)))
(api:update-objs)
(void))
(defun selobj ()
- (loop :for (k v) :of (root objs)
+ (loop :for (k v) :of *objs
:do (when (@ v :selected)
(return-from selobj (@ v :name)))))
@@ -246,20 +246,20 @@
(defun play (filename &optional (volume 100))
(let ((audio (new (*audio filename))))
- (setf (getprop (root playing) filename) audio)
+ (setf (getprop *playing filename) audio)
(setf (@ audio volume) (* volume 0.01))
(chain audio (play))))
(defun close (filename)
- (funcall (root playing filename) stop)
- (delete (root playing filename))
+ (funcall (getprop *playing filename) stop)
+ (delete (getprop *playing filename))
(void))
(defun closeall ()
- (loop :for k :in (chain *object (keys (root playing)))
- :for v := (getprop (root playing) k)
+ (loop :for k :in (chain *object (keys *playing))
+ :for v := (getprop *playing k)
:do (funcall v stop))
- (setf (root playing) (create)))
+ (setf *playing (create)))
;;; 18img
@@ -284,7 +284,7 @@
;;; 20time
(defun msecscount ()
- (- (chain *date (now)) (root started-at)))
+ (- (chain *date (now)) *started-at))
;;; 21local
@@ -303,12 +303,12 @@
(defun addqst (name)
(let ((game (api-call filename-game name)))
;; Add the game's locations
- (chain *object (assign (root locs)
- (getprop (root games) name)))))
+ (chain *object (assign *locs
+ (getprop *games name)))))
(defun killqst ()
;; Delete all locations not from the current main game
- (loop :for (k v) :in (root games)
- :do (unless (string= k (root main-game))
- (delete (getprop (root locs) k)))))
+ (loop :for (k v) :in *games
+ :do (unless (string= k *main-game)
+ (delete (getprop *locs k)))))
diff --git a/src/main-macros.lisp b/src/main-macros.lisp
--- a/src/main-macros.lisp
+++ b/src/main-macros.lisp
@@ -8,8 +8,5 @@
(defmacro+ps api-call (name &rest args)
`(,(intern (string-upcase name) "API") ,@args))
-(defpsmacro root (&rest path)
- `(@ data ,@path))
-
(defpsmacro in (key obj)
`(chain ,obj (has-own-property ,key)))
diff --git a/src/main.ps b/src/main.ps
--- a/src/main.ps
+++ b/src/main.ps
@@ -1,51 +1,48 @@
(in-package sugar-qsp.main)
-(setf (root)
- (create
- ;;; Game session state (saved in savegames)
- ;; Variables
- vars (create)
- ;; Inventory (objects)
- objs (create)
- current-location nil
- ;; Game time
- started-at (chain *date (now))
- ;; Timers
- timer-interval 500
- timer-obj nil
- ;; Games
- loaded-games (list)
+;;; Game session state (saved in savegames)
+;; Variables
+(var *globals (create))
+;; Inventory (objects)
+(var *objs (create))
+(var *current-location nil)
+;; Game time
+(var *started-at (chain *date (now)))
+;; Timers
+(var *timer-interval 500)
+(var *timer-obj nil)
+;; Games
+(var *loaded-games (list))
- ;;; Transient state
- ;; ACTions
- acts (create)
- ;; Savegame data
- state-stash (create)
- ;; List of audio files being played
- playing (create)
- ;; Local variables stack (starts with an empty frame)
- locals (list)
+;;; Transient state
+;; ACTions
+(var *acts (create))
+;; Savegame data
+(var *state-stash (create))
+;; List of audio files being played
+(var *playing (create))
+;; Local variables stack (starts with an empty frame)
+(var *locals (list))
- ;;; Game data
- ;; Games (filename -> [locations])
- games (list)
- ;; The main (non library) game. Updated by openqst
- main-game nil
- ;; Active locations
- locs (create)))
+;;; Game data
+;; Games (filename -> [locations])
+(var *games (list))
+;; The main (non library) game. Updated by openqst
+(var *main-game nil)
+;; Active locations
+(var *locs (create))
;; Launch the game from the first location
(setf (@ window onload)
(lambda ()
(#.(intern "INIT-DOM" "SUGAR-QSP.API"))
;; For MSECCOUNT
- (setf (root started-at) (chain *date (now)))
+ (setf *started-at (chain *date (now)))
;; For $COUNTER and SETTIMER
(#.(intern "SET-TIMER" "SUGAR-QSP.API")
- (root timer-interval))
+ *timer-interval)
;; Start the first game
(#.(intern "RUN-GAME" "SUGAR-QSP.API")
- (chain *object (keys (root games)) 0))
+ (chain *object (keys *games) 0))
(values)))
-
diff --git a/src/package.lisp b/src/package.lisp
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -6,11 +6,15 @@
(defpackage :sugar-qsp.main
(:use :cl :ps :sugar-qsp.js)
(:export #:api-call #:by-id
- #:root #:in
- #:vars #:objs #:current-location
- #:started-at #:timer-interval #:timer-obj
- #:state-stash #:playing #:locals
- #:acts #:locs #:games))
+ #:in
+
+ #:*globals #:*objs #:*current-location
+ #:*started-at #:*timer-interval #:*timer-obj #:*loaded-games
+
+ #:*acts #:*state-stash #:*playing #:*locals
+
+ #:*games #:*main-game #:*locs
+ ))
(defpackage :code-walker
(:use :cl)
diff --git a/src/ps-macros.lisp b/src/ps-macros.lisp
--- a/src/ps-macros.lisp
+++ b/src/ps-macros.lisp
@@ -65,13 +65,13 @@
(walker:walk 'globals body)
`(progn
;; Game object
- (setf (root games ,name)
+ (setf (@ *games ,name)
(create))
;; Global variables from this game
(create-globals ,*globals*)
;; Locations
,@(loop :for location :in body
- :collect `(setf (root games ,name ,(caadr location))
+ :collect `(setf (@ *games ,name ,(caadr location))
,location))))
(defpsmacro location ((name) &body body)
@@ -104,7 +104,7 @@
:test-not #'eq))))))
(let ((names (remove-duplicates (mapcar #'first globals))))
`(chain *object
- (assign (root vars)
+ (assign *globals
(create
,@(loop :for sym :in names
:for indexes := (indexes sym)
@@ -169,7 +169,7 @@
(declare (ignore qspvar))
(let ((slot `(getprop
,(if (member name *locals* :key #'first)
- 'locals '(root vars))
+ 'locals '*globals)
,(string-upcase name))))
(cond
((null index)
@@ -192,7 +192,7 @@
(walker:deftransform apply-vars qspvar (name index)
(let ((slot `(getprop
- ,(if (member name *locals* :key #'first) 'locals '(root vars))
+ ,(if (member name *locals* :key #'first) 'locals '*globals)
,(string-upcase name))))
(cond
((null index)