The Box bugfixes

.hgignore

@@ -1,3 +1,4 b''
 .*~
 .qlot
 .html
+tests

TODO

@@ -1,6 +1,6 b''
 
-* Make acts stored separately
-* Update saving system to use separate acts and save at any point
+* Special locations
+* Special variables
 * CLI build for Linux
 * CLI build for Windows
 

examples/txt2gam-game.txt

@@ -1,7 +1,6 b''
 
 # start
 USEHTML=1
-BCOLOR = RGB(255, 255, 255)
 '<center><font size="20" color="#FF0000" face="Times New Roman"><b>Текстовый квест</b></font></center><br>'
 '   <b>Ваша цель</b> - зарабатывать <i>деньги</i>, покупать на них <i>подарки</i> и дарить своим <i>близким</i>.'
 ACT '<b>Начать игру</b>':GOTO 'Дом'

src/api.ps

@@ -52,18 +52,18 b''
 (defm (root api clear-id) (id)
   (setf (ps:chain document (get-element-by-id id) inner-text) ""))
 
-(defm (root api get-id) (id)
-  (if (var "USEHTML" 0 :num)
+(defm (root api get-id) (id &optional force-html)
+  (if (or force-html (var "USEHTML" 0 :num))
       (ps:chain (document.get-element-by-id id) inner-h-t-m-l)
       (ps:chain (document.get-element-by-id id) inner-text)))
 
-(defm (root api set-id) (id contents)
-  (if (var "USEHTML" 0 :num)
+(defm (root api set-id) (id contents &optional force-html)
+  (if (or force-html (var "USEHTML" 0 :num))
       (setf (ps:chain (document.get-element-by-id id) inner-h-t-m-l) contents)
       (setf (ps:chain (document.get-element-by-id id) inner-text) contents)))
 
-(defm (root api append-id) (id contents)
-  (if (var "USEHTML" 0 :num)
+(defm (root api append-id) (id contents &optional force-html)
+  (if (or force-html (var "USEHTML" 0 :num))
       (incf (ps:chain (document.get-element-by-id id) inner-h-t-m-l) contents)
       (incf (ps:chain (document.get-element-by-id id) inner-text) contents)))
 
@@ -81,6 +81,9 b''
       (var result 0 :str)
       (var result 0 :num)))
 
+(defm (root api call-loc) (name args)
+  (funcall (ps:getprop (root locs) name) args))
+
 ;;; Text windows
 
 (defm (root api key-to-id) (key)
@@ -110,8 +113,8 b''
     (ps:chain div (append-child (document.create-element "br")))))
 
 (defm (root api enable-frame) (key enable)
-  (let ((clss (ps:getprop (this.get-frame key) 'class-list)))
-    (setf clss.style.display (if enable "block" "none"))
+  (let ((obj (this.get-frame key)))
+    (setf obj.style.display (if enable "block" "none"))
     (values)))
 
 ;;; Actions
@@ -131,10 +134,11 b''
 
 (defm (root api update-acts) ()
   (this.clear-id "qsp-acts")
-  (ps:for-in (title (root acts))
-    (let ((obj (ps:getprop (root acts) title)))
-      (this.append-id "qsp-acts"
-                (this.make-act-html title (ps:getprop obj :img))))))
+  (let ((elt (document.get-element-by-id "qsp-acts")))
+    (ps:for-in (title (root acts))
+      (let ((obj (ps:getprop (root acts) title)))
+        (incf elt.inner-h-t-m-l (this.make-act-html title (ps:getprop obj :img)))))))
+      
 
 ;;; "Syntax"
 
@@ -205,7 +209,7 b''
 
 (defm (root api var-ref) (name)
   (let ((local-store (this.current-local-frame)))
-    (cond ((in name local-store)
+    (cond ((and local-store (in name local-store))
            (ps:getprop local-store name))
           ((in name (root vars))
            (ps:getprop (root vars) name))
@@ -330,6 +334,7 b''
     (document.body.remove-child element)))
 
 (defm (root api stash-state) (args)
+  (api-call call-serv-loc "ONGSAVE")
   (setf (root state-stash)
         (*j-s-o-n.stringify
          (ps:create vars (root vars)
@@ -359,8 +364,9 b''
           (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)
+    (api-call call-serv-loc "ONGLOAD")
+    (api-call call-loc (root current-location) (ps:@ data loc-args))
     (values)))
 
 (defm (root api state-to-base64) ()

src/intrinsics.ps

@@ -290,7 +290,7 b''
 ;;; misc
 
 (defm (root lib rgb) ()
-  (api-call report-error "RGB is not supported. Use HTML."))
+  (api-call report-error "RGB is not implemented."))
 
 (defm (root lib openqst) ()
   (api-call report-error "OPENQST is not supported."))

src/parser.lisp

@@ -107,7 +107,7 b''
 
 ;;; Identifiers
 
-(defparameter *keywords* '(act addlib addobj addqst and arrcomp arrpos arrsize cla clear *clear close clr *clr cls cmdclear cmdclr copyarr counter countobj curacts curloc debug delact dellib delobj desc disablescroll disablesubex dynamic dyneval else elseif end exit fcolor fname for freelib fsize func getobj gosub goto gs gt if iif inclib input instr isnum isplay jump killall killobj killqst killvar lcase lcolor len let loc local maintxt max menu mid min mod msecscount msg nl *nl no nosave obj onactsel ongload ongsave onnewloc onobjadd onobjdel onobjsel opengame openqst or p *p pl *pl play qspver rand refint replace rgb rnd savegame selact selobj set settimer showacts showinput showobjs showstat stattxt step str strcomp strfind strpos to trim ucase unsel unselect usercom user_text usrtxt val view wait xgoto xgt))
+(defparameter *keywords* '(act addlib addobj addqst and arrcomp arrpos arrsize cla clear *clear close clr *clr cls cmdclear cmdclr copyarr counter countobj curacts curloc debug delact dellib delobj desc disablescroll disablesubex dynamic dyneval else elseif end exit for freelib func getobj gosub goto gs gt if iif inclib input instr isnum isplay jump killall killobj killqst killvar lcase lcolor len let loc local maintxt max menu mid min mod msecscount msg nl *nl no nosave obj opengame openqst or p *p pl *pl play qspver rand refint replace rgb rnd savegame selact selobj set settimer showacts showinput showobjs showstat stattxt step str strcomp strfind strpos to trim ucase unsel unselect usercom user_text usrtxt val view wait xgoto xgt))
 
 (defun trim-$ (str)
   (if (char= #\$ (elt str 0))
@@ -329,7 +329,7 b''
   (:lambda (list)
     (apply #'append list)))
 
-(p:defrule block-act-head (and (p:~ "act") spaces qsp-string spaces?
+(p:defrule block-act-head (and (p:~ "act") spaces? qsp-string spaces?
                                (p:? block-act-head-img)
                                colon spaces?)
   (:lambda (list)
@@ -382,7 +382,7 b''
 (p:defrule arguments (or parenthesized-arguments plain-arguments no-arguments))
 (p:defrule parenthesized-arguments (and spaces? #\( base-arguments #\))
   (:function third))
-(p:defrule plain-arguments (and spaces base-arguments)
+(p:defrule plain-arguments (and spaces? base-arguments)
   (:function second))
 (p:defrule no-arguments (or (and spaces? (p:& #\newline))
                             (and spaces? (p:& #\&))
@@ -478,6 +478,11 b''
   ;; Dynamic
   (dynamic  nil 1 10)
   (dyneval  t   1 10)
+  ;; Sound
+  (play     nil 1 2)
+  (isplay   t   1 1)
+  (close    nil 1 1)
+  (closeall nil 0 0 "close all")
   ;; Main window
   (main-pl  nil 1 1 "*pl")
   (main-nl  nil 0 1 "*nl")
@@ -509,11 +514,6 b''
   (getobj   t 1 1)
   ;; Menu
   (menu     nil 1 1)
-  ;; Sound
-  (play     nil 1 2)
-  (isplay   t   1 1)
-  (close    nil 1 1)
-  (closeall nil 0 0 "close all")
   ;; Images
   (refint   nil 0 0)
   (view     nil 0 1)