diff --git a/examples/txt2gam-game.txt b/examples/txt2gam-game.txt
--- a/examples/txt2gam-game.txt
+++ b/examples/txt2gam-game.txt
@@ -1,7 +1,7 @@
# start
USEHTML=1
-BCOLOR = RGB(255, 255, 255)
+BCOLOR = RGB(200, 200, 200)
'
Текстовый квест
'
' Ваша цель - зарабатывать деньги, покупать на них подарки и дарить своим близким.'
ACT 'Начать игру':GOTO 'Дом'
diff --git a/src/api-macros.lisp b/src/api-macros.lisp
--- a/src/api-macros.lisp
+++ b/src/api-macros.lisp
@@ -35,10 +35,12 @@
(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))))
diff --git a/src/api.ps b/src/api.ps
--- a/src/api.ps
+++ b/src/api.ps
@@ -238,12 +238,24 @@
(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 @@
(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")))
diff --git a/src/package.lisp b/src/package.lisp
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -30,12 +30,12 @@
(: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
diff --git a/src/ps-macros.lisp b/src/ps-macros.lisp
--- a/src/ps-macros.lisp
+++ b/src/ps-macros.lisp
@@ -47,7 +47,7 @@
;;; 1loc
-(defparameter *service-variables*
+(defparameter *special-variables*
'((usehtml 0)
(result 0)
($result 0)
@@ -63,7 +63,7 @@
(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 @@
(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 @@
;;; 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