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 |
|
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 |
|
|
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 ( |
|
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 |
( |
|
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 |
|
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 |
|
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 |
|
|
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? |
|
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 |
( |
|
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 |
`(c |
|
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