diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -1,5 +1,6 @@ -* Finish lib +* Make acts stored separately +* Update saving system to use separate acts and save at any point * CLI build for Linux * CLI build for Windows diff --git a/src/api.ps b/src/api.ps --- a/src/api.ps +++ b/src/api.ps @@ -21,6 +21,9 @@ title "")) +(defm (root api report-error) (text) + (alert text)) + (defm (root api init-dom) () ;; Save/load buttons (let ((btn (document.get-element-by-id "qsp-btn-save"))) @@ -37,44 +40,12 @@ (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)))) +(defm (root api call-serv-loc) (var-name &rest args) + (let ((loc-name (api-call get-var name 0 :str))) + (when loc-name + (let ((loc (ps:getprop (root locs) loc-name))) + (when loc + (funcall loc args)))))) ;;; Misc @@ -120,7 +91,7 @@ (:acts "qsp-acts") (:input "qsp-input") (:dropdown "qsp-dropdown") - (t (report-error "Internal error!")))) + (t (this.report-error "Internal error!")))) (defm (root api get-frame) (key) (document.get-element-by-id (this.key-to-id key))) @@ -357,3 +328,54 @@ (document.body.append-child element) (element.click) (document.body.remove-child element))) + +(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 + msecs (- (*date.now) (root started-at)) + 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 started-at) (- (*date.now) (ps:@ data msecs))) + (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)))) + +;;; Timers + +(defm (root api set-timer) (interval) + (setf (root timer-interval) interval) + (clear-interval (root timer-obj)) + (setf (root timer-obj) + (set-interval + (lambda () + (api-call call-serv-loc "COUNTER")) + interval))) diff --git a/src/intrinsic-macros.lisp b/src/intrinsic-macros.lisp --- a/src/intrinsic-macros.lisp +++ b/src/intrinsic-macros.lisp @@ -142,8 +142,14 @@ ;;; 19input +(ps:defpsmacro showinput (enable) + `(api-call enable-frame :input ,enable)) + ;;; 20time +(ps:defpsmacro settimer (interval) + `(api-call set-timer ,interval)) + ;;; 21local (ps:defpsmacro local (var &optional expr) diff --git a/src/intrinsics.ps b/src/intrinsics.ps --- a/src/intrinsics.ps +++ b/src/intrinsics.ps @@ -112,10 +112,14 @@ ;;; 10dynamic (defm (root lib dynamic) (block &rest args) + (when (stringp block) + (api-call report-error "DYNAMIC can't evaluate arbitrary strings.\nUse {braces} to create blocks for DYNAMIC.")) (funcall block args) (values)) (defm (root lib dyneval) (block &rest args) + (when (stringp block) + (api-call report-error "DYNEVAL can't evaluate arbitrary strings.\nUse {braces} to create blocks for DYNEVAL.")) (funcall block args)) ;;; 11main @@ -252,17 +256,21 @@ (defm (root lib refint) () ;; "Force interface update" Uh... what exactly do we do here? + (api-call report-error "REFINT is not supported") ) ;;; 19input -(defm (root lib showinput) ()) - -(defm (root lib usertxt) ()) +(defm (root lib usertxt) () + (let ((input (document.get-element-by-id "qsp-input"))) + (ps:@ input value))) -(defm (root lib cmdclear) ()) +(defm (root lib cmdclear) () + (let ((input (document.get-element-by-id "qsp-input"))) + (setf (ps:@ input value) ""))) -(defm (root lib input) ()) +(defm (root lib input) (text) + (window.prompt text)) ;;; 20time @@ -272,9 +280,8 @@ (exit-time (+ (funcall now.get-time) msec))) (loop :while (< (funcall now.get-time) exit-time)))) -(defm (root lib msecscount) ()) - -(defm (root lib settimer) ()) +(defm (root lib msecscount) () + (- (*date.now) (root started-at))) ;;; 21local @@ -282,11 +289,14 @@ ;;; misc -(defm (root lib rgb) ()) +(defm (root lib rgb) () + (api-call report-error "RGB is not supported. Use HTML.")) -(defm (root lib openqst) ()) +(defm (root lib openqst) () + (api-call report-error "OPENQST is not supported.")) -(defm (root lib addqst) ()) +(defm (root lib addqst) () + (api-call report-error "ADDQST is not supported. Bundle the library with the main game.")) -(defm (root lib killqst) ()) - +(defm (root lib killqst) () + (api-call report-error "KILLQST is not supported.")) diff --git a/src/main.ps b/src/main.ps --- a/src/main.ps +++ b/src/main.ps @@ -8,6 +8,11 @@ vars (ps:create) ;; Inventory (objects) objs (list) + ;; Game time + started-at (*date.now) + ;; Timers + timer-interval 500 + timer-obj nil ;;; Transient state ;; Savegame data state-stash (ps:create) @@ -25,6 +30,10 @@ (setf window.onload (lambda () (api-call init-dom) + ;; For MSECCOUNT + (setf (root started-at) (*date.now)) + ;; For $COUNTER and SETTIMER + (api-call set-timer (root timer-interval)) (funcall (ps:getprop (root locs) (ps:chain *object (keys (root locs)) 0)) (list)) diff --git a/src/parser.lisp b/src/parser.lisp --- a/src/parser.lisp +++ b/src/parser.lisp @@ -70,10 +70,12 @@ (:text t)) (p:defrule spaces (+ (or #\space #\tab line-continuation)) - (:constant nil)) + (:constant nil) + (:error-report nil)) (p:defrule spaces? (* (or #\space #\tab line-continuation)) - (:constant nil)) + (:constant nil) + (:error-report nil)) (p:defrule colon #\: (:constant nil))