Finishing lib

TODO

@@ -1,5 +1,6 b''
 
-* 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
 

src/api.ps

@@ -21,6 +21,9 b''
      title
      "</a>"))
 
+(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 b''
         (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 b''
     (: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 b''
     (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)))

src/intrinsic-macros.lisp

@@ -142,8 +142,14 b''
 
 ;;; 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)

src/intrinsics.ps

@@ -112,10 +112,14 b''
 ;;; 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 b''
 
 (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 b''
          (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 b''
 
 ;;; 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."))

src/main.ps

@@ -8,6 +8,11 b''
        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 b''
 (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))

src/parser.lisp

@@ -70,10 +70,12 b''
   (: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))