Show More
@@ -20,6 +20,7 b'' | |||
|
20 | 20 | $objs[] = 'Топор' &! [0] = 'Напильник', |
|
21 | 21 | $objs[] = 'Доска' &! [1] = 'Топор', [2] = 'Доска' |
|
22 | 22 | |
|
23 |
|
|
|
24 |
|
|
|
23 | *pl $objs[0] &! 'Напильник' из примера выше | |
|
24 | *pl $objs[] &! 'Доска' из примера выше | |
|
25 | *pl сорт_яблока[] &! 4 из примера выше | |
|
25 | 26 | - |
@@ -216,11 +216,11 b'' | |||
|
216 | 216 | |
|
217 | 217 | ;;; Variables |
|
218 | 218 | |
|
219 |
(defun new-var ( |
|
|
219 | (defun new-var (slot &rest indexes) | |
|
220 | 220 | (let ((v (list))) |
|
221 | (when index | |
|
221 | (dolist (index indexes) | |
|
222 | 222 | (setf (elt v index) (if (eq #\$ (elt slot 0)) "" 0))) |
|
223 | (setf (@ v indexes) (create)) | |
|
223 | (setf (@ v :indexes) (create)) | |
|
224 | 224 | v)) |
|
225 | 225 | |
|
226 | 226 | (defun set-str-element (slot index value) |
@@ -31,7 +31,7 b'' | |||
|
31 | 31 | #:init-args #:get-result #:call-loc #:call-act |
|
32 | 32 | #:get-frame #:add-text #:get-text #:clear-text #:enable-frame |
|
33 | 33 | #:add-act #:del-act #:clear-act #:update-acts |
|
34 | #:qspfor | |
|
34 | #:set-str-element #:set-any-element | |
|
35 | 35 | #:*var #:new-value #:index-num #:get #:set #:kill |
|
36 | 36 | #:var-real-name #:ensure-var #:var-ref #:get-var #:set-var |
|
37 | 37 | #:get-array #:set-array #:kill-var #:array-size |
@@ -48,16 +48,16 b'' | |||
|
48 | 48 | (defparameter *service-variables* |
|
49 | 49 | '((usehtml 0) |
|
50 | 50 | (result 0) |
|
51 |
($result |
|
|
52 |
($ongload |
|
|
53 |
($ongsave |
|
|
54 |
($onobjadd |
|
|
55 |
($onobjdel |
|
|
56 |
($onobjsel |
|
|
57 |
($onnewloc |
|
|
58 |
($onactsel |
|
|
59 |
($counter |
|
|
60 |
($usercom |
|
|
51 | ($result 0) | |
|
52 | ($ongload 0) | |
|
53 | ($ongsave 0) | |
|
54 | ($onobjadd 0) | |
|
55 | ($onobjdel 0) | |
|
56 | ($onobjsel 0) | |
|
57 | ($onnewloc 0) | |
|
58 | ($onactsel 0) | |
|
59 | ($counter 0) | |
|
60 | ($usercom 0))) | |
|
61 | 61 | |
|
62 | 62 | (defpsmacro game ((name) &body body) |
|
63 | 63 | (setf body (walker:walk 'for-transform body)) |
@@ -95,11 +95,22 b'' | |||
|
95 | 95 | (defvar *locals* nil) |
|
96 | 96 | |
|
97 | 97 | (defpsmacro create-globals (globals) |
|
98 | (flet ((indexes (name) | |
|
99 | (remove nil | |
|
100 | (remove-if #'listp | |
|
101 | (mapcar #'second | |
|
102 | (remove name globals | |
|
103 | :key #'first | |
|
104 | :test-not #'eq)))))) | |
|
105 | (let ((names (remove-duplicates (mapcar #'first globals)))) | |
|
98 | 106 | `(chain *object |
|
99 | 107 | (assign (root vars) |
|
100 | (create ,@(loop :for (name index slot) | |
|
101 |
|
|
|
102 | :append `(,(string-upcase name) (api-call new-var ,index))))))) | |
|
108 | (create | |
|
109 | ,@(loop :for sym :in names | |
|
110 | :for indexes := (indexes sym) | |
|
111 | :for name := (string-upcase sym) | |
|
112 | :append `(,name | |
|
113 | (api-call new-var ,name ,@indexes))))))))) | |
|
103 | 114 | |
|
104 | 115 | (walker:deftransform globals qspvar (&rest var) |
|
105 | 116 | (pushnew var *globals* :test #'equal) |
@@ -113,8 +124,9 b'' | |||
|
113 | 124 | (when locals |
|
114 | 125 | `(progn |
|
115 | 126 | (var locals (create |
|
116 |
,@(loop :for ( |
|
|
117 |
: |
|
|
127 | ,@(loop :for (sym index) :in locals | |
|
128 | :for name := (string-upcase sym) | |
|
129 | :append `(,name (api-call new-var ,name)))))))) | |
|
118 | 130 | |
|
119 | 131 | ;; locations, blocks, and acts all have their own locals namespace |
|
120 | 132 | (walker:deftransform-stop locals qspblock) |
@@ -137,7 +149,9 b'' | |||
|
137 | 149 | |
|
138 | 150 | (defun literal-string-p (form) |
|
139 | 151 | (and (listp form) |
|
140 |
( |
|
|
152 | (= 2 (length form)) | |
|
153 | (eq 'str (first form)) | |
|
154 | (stringp (second form)))) | |
|
141 | 155 | |
|
142 | 156 | (defun variable-number-p (form) |
|
143 | 157 | (and (listp form) |
@@ -158,17 +172,19 b'' | |||
|
158 | 172 | 'locals '(root vars)) |
|
159 | 173 | ,(string-upcase name)))) |
|
160 | 174 | (cond |
|
175 | ((null index) | |
|
176 | `(chain (elt ,slot) (push ,expr))) | |
|
161 | 177 | ((or (numberp index) |
|
162 | 178 | (variable-number-p index)) |
|
163 | 179 | `(setf (elt ,slot ,index) |
|
164 | 180 | ,(walker:walk 'apply-vars expr))) |
|
165 | 181 | ((or (literal-string-p index) |
|
166 | 182 | (variable-string-p index)) |
|
167 | `(set-str-element ,slot ,(walker:walk 'apply-vars index) | |
|
168 |
(walker:walk |
|
|
183 | `(api:set-str-element ,slot ,(walker:walk 'apply-vars index) | |
|
184 | ,(walker:walk-continue expr))) | |
|
169 | 185 | (t |
|
170 | `(set-any-element ,slot ,index | |
|
171 |
(walker:walk |
|
|
186 | `(api:set-any-element ,slot ,(walker:walk 'apply-vars index) | |
|
187 | ,(walker:walk-continue expr))))))) | |
|
172 | 188 | |
|
173 | 189 | (walker:deftransform apply-vars local (var &optional expr) |
|
174 | 190 | (when expr |
@@ -179,14 +195,16 b'' | |||
|
179 | 195 | ,(if (member name *locals* :key #'first) 'locals '(root vars)) |
|
180 | 196 | ,(string-upcase name)))) |
|
181 | 197 | (cond |
|
198 | ((null index) | |
|
199 | `(elt ,slot (1- (length ,slot)))) | |
|
182 | 200 | ((or (numberp index) |
|
183 | 201 | (variable-number-p index)) |
|
184 | `(elt ,slot ,index)) | |
|
202 | `(elt ,slot ,(walker:walk-continue index))) | |
|
185 | 203 | ((or (literal-string-p index) |
|
186 | 204 | (variable-string-p index)) |
|
187 | `(elt ,slot (@ ,slot :indexes ,index))) | |
|
205 | `(elt ,slot (@ ,slot :indexes ,(walker:walk-continue index)))) | |
|
188 | 206 | (t |
|
189 | `(get-element ,slot ,index))))) | |
|
207 | `(get-element ,slot ,(walker:walk-continue index)))))) | |
|
190 | 208 | |
|
191 | 209 | (walker:deftransform apply-vars qspblock (&rest block) |
|
192 | 210 | (declare (ignore block)) |
General Comments 0
You need to be logged in to leave comments.
Login now