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