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