##// END OF EJS Templates
Null indexes
naryl -
r38:de154bb9 default
parent child Browse files
Show More
@@ -20,6 +20,7 b''
20 20 $objs[] = 'Топор' &! [0] = 'Напильник',
21 21 $objs[] = 'Доска' &! [1] = 'Топор', [2] = 'Доска'
22 22
23 $a = $objs[] &! 'Доска' из примера выше
24 a = сорт_яблока[] &! 4 из примера выше
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 (&optional index)
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 :in globals
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 (name index) :in locals
117 :append `(,(string-upcase name) (api-call new-var))))))))
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 (eq 'str (first form))))
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 'apply-vars ,expr)))
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 'apply-vars ,expr)))))))
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