Fix service variables

examples/txt2gam-game.txt

@@ -1,7 +1,7 b''
 
 # start
 USEHTML=1
-BCOLOR = RGB(255, 255, 255)
+BCOLOR = RGB(200, 200, 200)
 '<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-macros.lisp

@@ -35,10 +35,12 b''
                                  (resolve)))))
            ,@body))))
 
-(defpsmacro define-serv-var (name (slot value &optional index) &body body)
+(defvar *serv-vars* nil)
+
+(defpsmacro define-serv-var (name (value &optional index) &body body)
   (setf name (string-upcase (symbol-name name)))
+  (pushnew name *serv-vars* :test #'equal)
   `(setf (getprop serv-vars ,name)
          (create :name ,name
-                 :slot ,slot
                  :body (lambda (,value ,@(when index (list index)))
                          ,@body))))

src/api.ps

@@ -238,12 +238,24 b''
       (progn
         (chain slot (push value))
         (setf (elt slot index)
-              (length slot)))))
+              (length slot))))
+  (void))
 
 (defun set-any-element (slot index value)
-  (if (numberp index)
-      (setf (elt slot index) value)
-      (set-str-element slot index value)))
+  (cond ((null index)
+         (chain (elt slot) (push value)))
+        ((numberp index)
+         (setf (elt slot index) value))
+        ((stringp index)
+         (set-str-element slot index value))
+        (t (report-error "INTERNAL ERROR")))
+  (void))
+
+(defun set-serv-var (name index value)
+  (let ((slot (getprop *globals name)))
+    (set-any-element slot index value))
+  (funcall (getprop serv-vars name :body) value index)
+  (void))
 
 (defun get-element (slot index)
   (if (numberp index)
@@ -468,21 +480,21 b''
 
 (defvar serv-vars (create))
 
-(define-serv-var backimage (:str path)
+(define-serv-var $backimage (path)
   (setf (@ (get-frame :main) style background-image) path))
 
-(define-serv-var bcolor (:num color)
+(define-serv-var bcolor (color)
   (setf (@ (get-frame :all) style background-color) (rgb-string color)))
 
-(define-serv-var fcolor (:num color)
+(define-serv-var fcolor (color)
   (setf (@ (get-frame :all) style color) (rgb-string color)))
 
-(define-serv-var lcolor (:num color)
+(define-serv-var lcolor (color)
   (setf (@ (get-frame :style) inner-text)
         (+ "a { color: " (rgb-string color) ";}")))
 
-(define-serv-var fsize (:num size)
+(define-serv-var fsize (size)
   (setf (@ (get-frame :all) style font-size) size))
 
-(define-serv-var fname (:str font-name)
+(define-serv-var $fname (font-name)
   (setf (@ (get-frame :all) style font-family) (+ font-name ",serif")))

src/package.lisp

@@ -30,12 +30,12 b''
   (:export #:with-frame #:with-call-args
            #:stash-state
 
-           #:report-error #:sleep #:init-dom #:call-serv-loc
+           #:report-error #:sleep #:init-dom #:call-serv-loc #:*serv-vars*
            #:newline #:clear-id #:prepare-contents #:get-id #:set-id #:append-id
            #:init-args #:get-result #:call-loc #:call-act
            #:get-frame #:add-text #:get-text #:clear-text #:enable-frame
            #:add-act #:del-act #:clear-act #:update-acts
-           #:set-str-element #:set-any-element
+           #:set-str-element #:set-any-element #:set-serv-var
            #:*var #:new-value #:index-num #:get #:set #:kill
            #:var-real-name #:ensure-var #:var-ref #:get-var #:set-var
            #:get-array #:set-array #:kill-var #:array-size

src/ps-macros.lisp

@@ -47,7 +47,7 b''
 
 ;;; 1loc
 
-(defparameter *service-variables*
+(defparameter *special-variables*
   '((usehtml 0)
     (result 0)
     ($result 0)
@@ -63,7 +63,7 b''
 
 (defpsmacro game ((name) &body body)
   (setf body (walker:walk 'for-transform body))
-  (setf *globals* *service-variables*)
+  (setf *globals* *special-variables*)
   (walker:walk 'globals body)
   `(progn
      ;; Game object
@@ -169,26 +169,29 b''
   (destructuring-bind (qspvar name index)
       var
     (declare (ignore qspvar))
+    (setf name (string-upcase name))
     (let ((slot `(getprop
                   ,(if (member name *locals* :key #'first)
                        'locals '*globals)
-                  ,(string-upcase name))))
+                  ,name))
+          (index (walker:walk 'apply-vars index))
+          (value (walker:walk 'apply-vars expr)))
       (cond
+        ((member name api:*serv-vars* :test #'equalp)
+         `(api:set-serv-var ,name ,index ,value))
         ((null index)
-         `(chain (elt ,slot) (push ,expr)))
+         `(chain (elt ,slot) (push ,value)))
         ((or (numberp index)
              (variable-number-p index))
-         `(setf (elt ,slot ,index)
-                ,(walker:walk 'apply-vars expr)))
+         `(setf (elt ,slot ,index) ,value))
         ((or (literal-string-p index)
              (variable-string-p index))
-         `(api:set-str-element ,slot ,(walker:walk 'apply-vars index)
-                               ,(walker:walk-continue expr)))
+         `(api:set-str-element ,slot ,index ,value))
         (t
-         `(api:set-any-element ,slot ,(walker:walk 'apply-vars index)
-                               ,(walker:walk-continue expr)))))))
+         `(api:set-any-element ,slot ,index ,value))))))
 
 (walker:deftransform apply-vars local (var &optional expr)
+                     ;; TODO: var can't be a service variable
   (when expr
     (walker:walk 'apply-vars (list 'set var expr))))
 
@@ -365,7 +368,7 b''
 ;;; 22for
 
 ;; Transform because it creates a (set ...) hence it has to be processed
-;; before the apply-vars transform. And macros are processed *after* all
+;; before the apply-vars transform. And macros are processed after all
 ;; the transforms
 (walker:deftransform for-transform qspfor (var from to step &rest body)
   `(loop :for i :from ,from :to ,to :by ,step