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) ""))) @@ -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)