##// END OF EJS Templates
Fix two regressions
naryl -
r64:44143cfd default
parent child Browse files
Show More
@@ -0,0 +1,8 b''
1 # begin
2 x = -1
3 gt 'loc', x
4 -
5 # loc
6 if args[0]: 'args[0] = -1'
7 'end'
8 -
@@ -0,0 +1,19 b''
1 # begin
2 func('getObjByKey', 'item')
3 -
4
5 # getObjByKey
6 $needle = $args[0]
7 i = 1
8 :lab
9 if i <= countobj:
10 if $getobj(i) = $needle:
11 result = i
12 exit
13 else
14 i += 1
15 jump 'lab'
16 end
17 end
18 result = -1
19 -
@@ -68,6 +68,9 b''
68 (@ event page-y)))
68 (@ event page-y)))
69 (finish-menu nil))))
69 (finish-menu nil))))
70
70
71 (defun init-globals (game-name)
72 (chain *object (assign *globals (getprop *default-globals game-name))))
73
71 (defun call-serv-loc (var-name &rest args)
74 (defun call-serv-loc (var-name &rest args)
72 (let ((loc-name (get-global var-name 0)))
75 (let ((loc-name (get-global var-name 0)))
73 (when loc-name
76 (when loc-name
@@ -128,11 +131,14 b''
128 ;;; Function calls
131 ;;; Function calls
129
132
130 (defun init-args (args)
133 (defun init-args (args)
131 (dotimes (i (length args))
134 (dotimes (i 10)
132 (let ((arg (elt args i)))
135 (set-global "ARGS" i 0)
133 (if (numberp arg)
136 (set-global "$ARGS" i "")
134 (set-var args i :num arg)
137 (when (< i (length args))
135 (set-var args i :str arg)))))
138 (let ((arg (elt args i)))
139 (if (numberp arg)
140 (set-global "ARGS" i arg)
141 (set-global "$ARGS" i arg))))))
136
142
137 (defun get-result ()
143 (defun get-result ()
138 (or (get-global "$RESULT" 0)
144 (or (get-global "$RESULT" 0)
@@ -250,14 +256,21 b''
250 (elt slot index)
256 (elt slot index)
251 (elt slot (getprop slot :indexes index))))
257 (elt slot (getprop slot :indexes index))))
252
258
259 (defun set-global (name index value)
260 (set-any-element (getprop *globals name) index value))
261
253 (defun get-global (name index)
262 (defun get-global (name index)
254 (elt (getprop *globals name) index))
263 (get-element (getprop *globals name) index))
255
264
256 (defun kill-var (store name &optional index)
265 (defun kill-var (&optional name index)
257 (setf name (chain name (to-upper-case)))
266 (cond (name
258 (if (and index (not (= 0 index)))
267 (setf name (chain name (to-upper-case)))
259 (chain (getprop *globals name) (kill index))
268 (if (and index (not (= 0 index)))
260 (delete (getprop *globals name)))
269 (chain (getprop *globals name) (kill index))
270 (delete (getprop *globals name))))
271 (t
272 (setf *globals (create))
273 (init-globals *main-game)))
261 (void))
274 (void))
262
275
263 (defun array-size (name)
276 (defun array-size (name)
@@ -8,11 +8,13 b''
8
8
9 ;;; 2var
9 ;;; 2var
10
10
11 (defpsmacro killvar (varname &optional index)
11 (defpsmacro killvar (&optional varname index)
12 `(api-call kill-var ,varname ,index))
12 `(api-call kill-var ,varname ,index))
13
13
14 (defpsmacro killall ()
14 (defpsmacro killall ()
15 `(api-call kill-all))
15 `(progn
16 (killvar)
17 (killobj)))
16
18
17 ;;; 3expr
19 ;;; 3expr
18
20
@@ -84,6 +86,21 b''
84
86
85 ;;; 10dynamic
87 ;;; 10dynamic
86
88
89 (defpsmacro dynamic (block &rest args)
90 `(progn
91 (when (stringp ,block)
92 (api:report-error "DYNAMIC can't evaluate arbitrary strings.\\nUse {braces} to create blocks for DYNAMIC."))
93 (api:with-call-args ,args
94 (funcall ,block))
95 (void)))
96
97 (defpsmacro dyneval (block &rest args)
98 `(progn
99 (when (stringp block)
100 (api:report-error "DYNEVAL can't evaluate arbitrary strings.\\nUse {braces} to create blocks for DYNEVAL."))
101 (api:with-call-args args
102 (funcall block))))
103
87 ;;; 11main
104 ;;; 11main
88
105
89 (defpsmacro desc (s)
106 (defpsmacro desc (s)
@@ -116,19 +116,6 b''
116
116
117 ;;; 10dynamic
117 ;;; 10dynamic
118
118
119 (defun dynamic (block &rest args)
120 (when (stringp block)
121 (api:report-error "DYNAMIC can't evaluate arbitrary strings.\\nUse {braces} to create blocks for DYNAMIC."))
122 (api:with-call-args args
123 (funcall block args))
124 (void))
125
126 (defun dyneval (block &rest args)
127 (when (stringp block)
128 (api:report-error "DYNEVAL can't evaluate arbitrary strings.\\nUse {braces} to create blocks for DYNEVAL."))
129 (api:with-call-args args
130 (funcall block args)))
131
132 ;;; 11main
119 ;;; 11main
133
120
134 (defun main-p (s)
121 (defun main-p (s)
@@ -219,7 +206,7 b''
219 (void))
206 (void))
220
207
221 (defun killobj (&optional (num nil))
208 (defun killobj (&optional (num nil))
222 (if (eq nil num)
209 (if (eq undefined num)
223 (setf *objs (create))
210 (setf *objs (create))
224 (delobj (elt (chain *object (keys *objs)) num)))
211 (delobj (elt (chain *object (keys *objs)) num)))
225 (api:update-objs)
212 (api:update-objs)
@@ -4,6 +4,7 b''
4 ;;; Game session state (saved in savegames)
4 ;;; Game session state (saved in savegames)
5 ;; Variables
5 ;; Variables
6 (var *globals (create))
6 (var *globals (create))
7 (var *default-globals (create))
7 ;; Inventory (objects)
8 ;; Inventory (objects)
8 (var *objs (create))
9 (var *objs (create))
9 (var *current-location nil)
10 (var *current-location nil)
@@ -46,8 +47,9 b''
46 (#.(intern "SET-TIMER" "TXT2WEB.API")
47 (#.(intern "SET-TIMER" "TXT2WEB.API")
47 *timer-interval)
48 *timer-interval)
48 ;; Start the first game
49 ;; Start the first game
49 (#.(intern "RUN-GAME" "TXT2WEB.API")
50 (let ((first-game (chain *object (keys *games) 0)))
50 (chain *object (keys *games) 0))
51 (#.(intern "INIT-GLOBALS" "TXT2WEB.API") first-game)
52 (#.(intern "RUN-GAME" "TXT2WEB.API") first-game))
51 (values))
53 (values))
52
54
53 ;;; Some very common utilities (for both api and lib)
55 ;;; Some very common utilities (for both api and lib)
@@ -8,7 +8,7 b''
8 (:export #:api-call #:by-id
8 (:export #:api-call #:by-id
9 #:has
9 #:has
10
10
11 #:*globals #:*objs #:*current-location
11 #:*globals #:*default-globals #:*objs #:*current-location
12 #:*started-at #:*timer-interval #:*timer-obj #:*loaded-games
12 #:*started-at #:*timer-interval #:*timer-obj #:*loaded-games
13
13
14 #:*acts #:*state-stash #:*playing #:*locals
14 #:*acts #:*state-stash #:*playing #:*locals
@@ -32,7 +32,7 b''
32
32
33 #:report-error #:sleep #:init-dom #:call-serv-loc #:*serv-vars*
33 #:report-error #:sleep #:init-dom #:call-serv-loc #:*serv-vars*
34 #:newline #:clear-id #:prepare-contents #:get-id #:set-id #:append-id
34 #:newline #:clear-id #:prepare-contents #:get-id #:set-id #:append-id
35 #:init-args #:get-result #:call-loc #:call-act
35 #:get-result #:call-loc #:call-act
36 #:get-frame #:add-text #:get-text #:clear-text #:enable-frame
36 #:get-frame #:add-text #:get-text #:clear-text #:enable-frame
37 #:add-act #:del-act #:clear-act #:update-acts
37 #:add-act #:del-act #:clear-act #:update-acts
38 #:set-str-element #:set-any-element #:set-serv-var
38 #:set-str-element #:set-any-element #:set-serv-var
@@ -45,6 +45,7 b''
45 #:clean-audio
45 #:clean-audio
46 #:show-image
46 #:show-image
47 #:opengame #:savegame
47 #:opengame #:savegame
48 #:init-globals
48 ))
49 ))
49
50
50 ;;; QSP library functions and macros
51 ;;; QSP library functions and macros
@@ -181,7 +181,7 b''
181 (p:parse 'expression (p:text (mapcar 'second (second list)))))
181 (p:parse 'expression (p:text (mapcar 'second (second list)))))
182
182
183 (defun parse-exec (list)
183 (defun parse-exec (list)
184 (list* 'lib:exec (p:parse 'exec-body (p:text (second list)))))
184 (list* 'lib:exec (p:parse 'exec-body (p:text (mapcar #'second (second list))))))
185
185
186 (p:defrule sstring-interpol (and "<<" (+ (and (p:! ">>")
186 (p:defrule sstring-interpol (and "<<" (+ (and (p:! ">>")
187 sstring-char))
187 sstring-char))
@@ -592,11 +592,16 b''
592 (p:defrule and-expr (and eq-expr (* (and spaces? and-op spaces? eq-expr)))
592 (p:defrule and-expr (and eq-expr (* (and spaces? and-op spaces? eq-expr)))
593 (:function do-binop))
593 (:function do-binop))
594
594
595 (p:defrule eq-expr (and sum-expr (* (and spaces? (or "<=" ">=" "=<" "=>" "<>"
595 (p:defrule eq-expr (and sum-expr (* (and spaces? comp-op
596 "=" "<" ">")
597 spaces? sum-expr)))
596 spaces? sum-expr)))
598 (:function do-binop))
597 (:function do-binop))
599
598
599 (p:defrule comp-op (or "<=" ">=" "=<" "=>" "<>" "=" "<" ">")
600 (:lambda (op)
601 (cond ((string= op "=>") ">=")
602 ((string= op "=<") "<=")
603 (t op))))
604
600 (p:defrule sum-expr (and mod-expr (* (and spaces? (or #\+ #\-) spaces? mod-expr)))
605 (p:defrule sum-expr (and mod-expr (* (and spaces? (or #\+ #\-) spaces? mod-expr)))
601 (:function do-binop))
606 (:function do-binop))
602
607
@@ -49,6 +49,8 b''
49
49
50 (defparameter *special-variables*
50 (defparameter *special-variables*
51 '((usehtml 0)
51 '((usehtml 0)
52 (args 0)
53 ($args 0)
52 (result 0)
54 (result 0)
53 ($result 0)
55 ($result 0)
54 ($ongload 0)
56 ($ongload 0)
@@ -70,7 +72,8 b''
70 (setf (@ *games ,name)
72 (setf (@ *games ,name)
71 (create))
73 (create))
72 ;; Global variables from this game
74 ;; Global variables from this game
73 (create-globals ,*globals*)
75 (setf (@ *default-globals ,name)
76 (create-globals ,*globals*))
74 ;; Locations
77 ;; Locations
75 ,@(loop :for location :in body
78 ,@(loop :for location :in body
76 :collect `(setf (@ *games ,name ,(caadr location))
79 :collect `(setf (@ *games ,name ,(caadr location))
@@ -83,12 +86,12 b''
83
86
84 (defpsmacro goto% (target &rest args)
87 (defpsmacro goto% (target &rest args)
85 `(progn
88 `(progn
86 (goto ,target ,args)
89 (goto ,target ,@args)
87 (exit)))
90 (exit)))
88
91
89 (defpsmacro xgoto% (target &rest args)
92 (defpsmacro xgoto% (target &rest args)
90 `(progn
93 `(progn
91 (xgoto ,target ,args)
94 (xgoto ,target ,@args)
92 (exit)))
95 (exit)))
93
96
94 ;;; 2var
97 ;;; 2var
@@ -105,14 +108,12 b''
105 :key #'first
108 :key #'first
106 :test-not #'eq))))))
109 :test-not #'eq))))))
107 (let ((names (remove-duplicates (mapcar #'first globals))))
110 (let ((names (remove-duplicates (mapcar #'first globals))))
108 `(chain *object
111 `(create
109 (assign *globals
112 ,@(loop :for sym :in names
110 (create
113 :for indexes := (indexes sym)
111 ,@(loop :for sym :in names
114 :for name := (string-upcase sym)
112 :for indexes := (indexes sym)
115 :append `(,name
113 :for name := (string-upcase sym)
116 (api-call new-var ,name ,@indexes)))))))
114 :append `(,name
115 (api-call new-var ,name ,@indexes)))))))))
116
117
117 (walker:deftransform globals qspvar (&rest var)
118 (walker:deftransform globals qspvar (&rest var)
118 (pushnew var *globals* :test #'equal)
119 (pushnew var *globals* :test #'equal)
@@ -220,6 +221,11 b''
220 (walker:deftransform apply-vars qspfor (var from to step body)
221 (walker:deftransform apply-vars qspfor (var from to step body)
221 (list* 'qspfor var (mapcar #'walker:walk-continue (list from to step body))))
222 (list* 'qspfor var (mapcar #'walker:walk-continue (list from to step body))))
222
223
224 (defpsmacro get-slot (name)
225 `(getprop
226 (if (chain locals (includes name)) locals *globals)
227 (string-upcase name)))
228
223 ;;; 3expr
229 ;;; 3expr
224
230
225 (defpsmacro <> (op1 op2)
231 (defpsmacro <> (op1 op2)
General Comments 0
You need to be logged in to leave comments. Login now