##// END OF EJS Templates
Menu, game saving
naryl -
r11:ca6bf409 default
parent child Browse files
Show More
@@ -0,0 +1,21 b''
1
2 (in-package sugar-qsp)
3
4 (eval-when (:compile-toplevel :load-toplevel :execute)
5 (defun src-file (filename)
6 (uiop/pathname:merge-pathnames*
7 filename
8 (asdf:system-source-directory :sugar-qsp)))
9 (defun compile-ps (filename)
10 (format nil "////// Parenscript file: ~A~%~%~A"
11 (file-namestring filename) (ps:ps-compile-file filename))))
12
13 (defclass compiler ()
14 ((body :accessor body :initform #.(alexandria:read-file-into-string (src-file "extras/body.html")))
15 (css :accessor css :initform (list #.(alexandria:read-file-into-string (src-file "extras/default.css"))))
16 (js :accessor js :initform (list #.(compile-ps (src-file "src/intrinsics.ps"))
17 #.(compile-ps (src-file "src/api.ps"))
18 #.(compile-ps (src-file "src/main.ps"))))
19 (compile :accessor compile-only :initarg :compile)
20 (target :accessor target :initarg :target)
21 (beautify :accessor beautify :initarg :beautify)))
@@ -0,0 +1,137 b''
1
2 (in-package sugar-qsp)
3
4 ;;;; Macros implementing some intrinsics where it makes sense
5 ;;;; E.g. an equivalent JS function exists, or it's a direct API call
6
7 ;;; 1loc
8
9 ;;; 2var
10
11 (ps:defpsmacro killvar (varname &optional (index :whole))
12 `(api-call kill-var ,varname ,index))
13
14 (ps:defpsmacro killall ()
15 `(api-call kill-all))
16
17 ;;; 3expr
18
19 (ps:defpsmacro obj (name)
20 `(funcall (root objs includes) ,name))
21
22 (ps:defpsmacro loc (name)
23 `(funcall (root locs includes) ,name))
24
25 (ps:defpsmacro no (arg)
26 `(- -1 ,arg))
27
28 ;;; 4code
29
30 (ps:defpsmacro qspver ()
31 "0.0.1")
32
33 (ps:defpsmacro curloc ()
34 `(root current-location))
35
36 (ps:defpsmacro rnd ()
37 `(funcall (root lib rand) 1 1000))
38
39 (ps:defpsmacro qspmax (&rest args)
40 `(max ,@args))
41
42 (ps:defpsmacro qspmin (&rest args)
43 `(min ,@args))
44
45 ;;; 5arrays
46
47 (ps:defpsmacro arrsize (name)
48 `(api-call array-size ,name))
49
50 ;;; 6str
51
52 (ps:defpsmacro len (s)
53 `(length ,s))
54
55 (ps:defpsmacro mid (s from &optional count)
56 `(ps:chain ,s (substring ,from ,count)))
57
58 (ps:defpsmacro ucase (s)
59 `(ps:chain ,s (to-upper-case)))
60
61 (ps:defpsmacro lcase (s)
62 `(ps:chain ,s (to-lower-case)))
63
64 (ps:defpsmacro trim (s)
65 `(ps:chain ,s (trim)))
66
67 (ps:defpsmacro replace (s from to)
68 `(ps:chain ,s (replace ,from ,to)))
69
70 (ps:defpsmacro val (s)
71 `(parse-int ,s 10))
72
73 (ps:defpsmacro qspstr (n)
74 `(ps:chain ,n (to-string)))
75
76 ;;; 7if
77
78 ;;; 8sub
79
80 ;;; 9loops
81
82 ;; JUMP is in ps-macros.lisp (because it's a part of a huge kludge)
83
84 (ps:defpsmacro exit ()
85 `(return-from nil (values)))
86
87 ;;; 10dynamic
88
89 ;;; 11main
90
91 (ps:defpsmacro desc (s)
92 (declare (ignore s))
93 "")
94
95 ;;; 12stat
96
97 (ps:defpsmacro showstat (enable)
98 `(api-call enable-frame :stat ,enable))
99
100 ;;; 13diag
101
102 (ps:defpsmacro msg (text)
103 `(alert ,text))
104
105 ;;; 14act
106
107 (ps:defpsmacro showacts (enable)
108 `(api-call enable-frame :acts ,enable))
109
110 (ps:defpsmacro delact (name)
111 `(api-call del-act ,name))
112
113 (ps:defpsmacro cla ()
114 `(api-call clear-act))
115
116 ;;; 15objs
117
118 (ps:defpsmacro showobjs (enable)
119 `(api-call enable-frame :objs ,enable))
120
121 (ps:defpsmacro countobj ()
122 `(length (root objs)))
123
124 (ps:defpsmacro getobj (index)
125 `(or (elt (root objs) ,index) ""))
126
127 ;;; 16menu
128
129 ;;; 17sound
130
131 ;;; 18img
132
133 ;;; 19input
134
135 ;;; 20time
136
137 ;;; misc
@@ -1,9 +1,6 b''
1 1
2 * Windows GUI
3 * Save-load game
2 * Windows GUI (for the compiler)
3 * Save-load game in slots
4 4 * Resizable frames
5 5 * Build Istreblenie
6 ** modifying it to suit compiler specifics
7 ** Implementing apis and intrinsics as needed
8
9 * Use real characters in cl-uglify-js No newline at end of file
6 ** modifying it to suit compiler specifics No newline at end of file
@@ -10,3 +10,6 b''
10 10 <div id="qsp-objs" class="qsp-frame">&nbsp;</div>
11 11 </div>
12 12 </div>
13
14 <div id="qsp-dropdown">
15 </div>
@@ -57,3 +57,28 b''
57 57 .qsp-act:hover {
58 58 outline: #9E9E9E outset 3px
59 59 }
60
61 // Dropdown
62
63 #qsp-dropdown {
64 display: none;
65 position: absolute;
66 background-color: #f1f1f1;
67 min-width: 160px;
68 overflow: auto;
69 box-shadow: 0px 8px 16px 0px rgba(0,0,0,0.2);
70 z-index: 1;
71 margin: auto;
72 top: 200;
73 }
74
75 #qsp-dropdown a {
76 color: black;
77 padding: 12px 16px;
78 text-decoration: none;
79 display: block;
80 }
81
82 #qsp-dropdown a:hover {
83 background-color: #ddd;
84 }
@@ -15,14 +15,35 b''
15 15 title
16 16 "</a>"))
17 17
18 (defm (root api make-menu-item-html) (num title img loc)
19 (+ "<a href='#' onclick='SugarQSP.api.runMenu(" num ", \"" loc "\")();'>"
20 "<img src='" img "'>"
21 title
22 "</a>"))
23
18 24 ;; To be used in saving game
19 25 (defm (root api stash-state) ()
20 26 (setf (root state-stash)
21 (ps:create vars (root vars)
22 objs (root objs)
23 next-location (root current-location)))
27 (*j-s-o-n.stringify
28 (ps:create vars (root vars)
29 objs (root objs)
30 next-location (root current-location))))
24 31 (values))
25 32
33 (defm (root api state-to-base64) ()
34 (btoa (encode-u-r-i-component (root state-stash))))
35
36 (defm (root api base64-to-state) (data)
37 (setf (root state-stash) (decode-u-r-i-component (atob data)))
38 (let ((data (*j-s-o-n.parse (root state-stash))))
39 (api-call clear-act)
40 (setf (root vars) (ps:@ data vars))
41 (setf (root objs) (ps:@ data objs))
42 (setf (root current-location) (ps:@ data next-location))
43 (funcall (root locs (root current-location)))
44 (api-call update-objs)
45 (values)))
46
26 47 ;;; Misc
27 48
28 49 (defm (root api clear-id) (id)
@@ -62,8 +83,15 b''
62 83 (case key
63 84 (:main "qsp-main")
64 85 (:stat "qsp-stat")
86 (:objs "qsp-objs")
87 (:acts "qsp-acts")
88 (:input "qsp-input")
89 (:dropdown "qsp-dropdown")
65 90 (t (report-error "Internal error!"))))
66 91
92 (defm (root api get-frame) (key)
93 (document.get-element-by-id (api-call key-to-id key)))
94
67 95 (defm (root api add-text) (key text)
68 96 (api-call append-id (api-call key-to-id key) text))
69 97
@@ -74,15 +102,20 b''
74 102 (api-call clear-id (api-call key-to-id key)))
75 103
76 104 (defm (root api newline) (key)
77 (let ((div (document.get-element-by-id
78 (api-call key-to-id key))))
105 (let ((div (api-call get-frame key)))
79 106 (ps:chain div (append-child (document.create-element "br")))))
80 107
108 (defm (root api enable-frame) (key enable)
109 (let ((clss (ps:getprop (api-call get-frame key) 'class-list)))
110 (setf clss.style.display (if enable "block" "none"))
111 (values)))
112
81 113 ;;; Actions
82 114
83 115 (defm (root api add-act) (title img act)
84 116 (setf (ps:getprop (root acts) title)
85 (ps:create :img img :act act)))
117 (ps:create :img img :act act))
118 (api-call update-acts))
86 119
87 120 (defm (root api del-act) (title)
88 121 (delete (ps:getprop (root acts) title))
@@ -134,12 +167,18 b''
134 167 value)
135 168 (values)))
136 169
170 (defm (root api get-array) (name type)
171 (ps:getprop (root vars) (api-call var-real-name name)))
172
137 173 (defm (root api kill-var) (name index)
138 174 (if (eq index :whole)
139 175 (ps:delete (ps:getprop (root vars) name))
140 176 (ps:delete (ps:getprop (root vars) name index)))
141 177 (values))
142 178
179 (defm (root api array-size) (name)
180 (ps:getprop (root vars) (api-call var-real-name name) 'length))
181
143 182 ;;; Objects
144 183
145 184 (defm (root api update-objs) ()
@@ -148,3 +187,14 b''
148 187 (loop :for obj :in (root objs)
149 188 :do (incf elt.inner-h-t-m-l (+ "<li>" obj)))
150 189 (incf elt.inner-h-t-m-l "</ul>")))
190
191 ;;; Menu
192
193 (defm (root api menu) (menu-data)
194 (let ((elt (document.get-element-by-id "qsp-dropdown"))
195 (i 0))
196 (setf elt.inner-h-t-m-l "")
197 (loop :for item :in menu-data
198 :do (incf i)
199 :do (incf elt.inner-h-t-m-l (api-call make-menu-item-html i item.text item.icon item.loc)))
200 (setf elt.style.display "block")))
@@ -16,51 +16,21 b''
16 16 (defm (root lib xgoto) (target &rest args)
17 17 (api-call clear-act)
18 18 (api-call init-args args)
19 (setf (root current-location) target)
19 (setf (root current-location) (ps:chain target (to-upper-case)))
20 20 (api-call stash-state)
21 (funcall (ps:getprop (root locations) (ps:chain target (to-upper-case)))))
21 (funcall (ps:getprop (root locs) (root current-location))))
22 22
23 23 ;;; 2var
24 24
25 (defm (root lib killvar) (varname &optional (index :whole))
26 (api-call kill-var varname index))
27
28 (defm (root lib killall) ()
29 (api-call kill-all))
30
31 25 ;;; 3expr
32 26
33 (defm (root lib obj) (name)
34 (funcall (root objs includes) name))
35
36 (defm (root lib loc) ()
37 (funcall (root locations includes) name))
38
39 (defm (root lib no) (arg)
40 (- -1 arg))
41
42 27 ;;; 4code
43 28
44 (defm (root lib qspver) ()
45 "0.0.1")
46
47 (defm (root lib curloc) ()
48 (root current-location))
49
50 (defm (root lib rand) (a b)
29 (defm (root lib rand) (a &optional (b 1))
51 30 (let ((min (min a b))
52 31 (max (max a b)))
53 32 (+ min (ps:chain *math (random (- max min))))))
54 33
55 (defm (root lib rnd) ()
56 (funcall (root lib rand) 1 1000))
57
58 (defm (root lib qspmax) (&rest args)
59 (apply (ps:@ *math max) args))
60
61 (defm (root lib qspmin) (&rest args)
62 (apply (ps:@ *math min) args))
63
64 34 ;;; 5arrays
65 35
66 36 (defm (root lib copyarr) (to from start count)
@@ -71,9 +41,6 b''
71 41 (api-call set-var to (+ start i)
72 42 (api-call get-var from (+ start i)))))
73 43
74 (defm (root lib arrsize) (name)
75 (api-call array-size name))
76
77 44 (defm (root lib arrpos) (name value &optional (start 0))
78 45 (ps:for ((i start)) ((< i (api-call array-size name))) ((incf i))
79 46 (when (eq (api-call get-var name i) value)
@@ -88,24 +55,6 b''
88 55
89 56 ;;; 6str
90 57
91 (defm (root lib len) (s)
92 (length s))
93
94 (defm (root lib mid) (s from &optional count)
95 (s.substring from count))
96
97 (defm (root lib ucase) (s)
98 (s.to-upper-case))
99
100 (defm (root lib lcase) (s)
101 (s.to-lower-case))
102
103 (defm (root lib trim) (s)
104 (s.trim))
105
106 (defm (root lib replace) (s from to)
107 (s.replace from to))
108
109 58 (defm (root lib instr) (s subs &optional (start 1))
110 59 (+ start (ps:chain s (substring (- start 1)) (search subs))))
111 60
@@ -114,12 +63,6 b''
114 63 0
115 64 -1))
116 65
117 (defm (root lib val) (s)
118 (parse-int s 10))
119
120 (defm (root lib qspstr) (n)
121 (+ "" n))
122
123 66 (defm (root lib strcomp) (s pattern)
124 67 (if (s.match pattern)
125 68 -1
@@ -140,21 +83,23 b''
140 83
141 84 ;;; 7if
142 85
86 ;; Has to be a function because it always evaluates all three of its
87 ;; arguments
143 88 (defm (root lib iif) (cond-expr then-expr else-expr)
144 (if (= -1 cond-expr) then-expr else-expr))
89 (if cond-expr then-expr else-expr))
145 90
146 91 ;;; 8sub
147 92
148 93 (defm (root lib gosub) (target &rest args)
149 94 (conserving-vars (args result)
150 95 (api-call init-args args)
151 (funcall (ps:getprop (root locations) target))
96 (funcall (ps:getprop (root locs) target))
152 97 (values)))
153 98
154 99 (defm (root lib func) (target &rest args)
155 100 (conserving-vars (args result)
156 101 (api-call init-args args)
157 (funcall (ps:getprop (root locations) target))
102 (funcall (ps:getprop (root locs) target))
158 103 (api-call get-result)))
159 104
160 105 ;;; 9loops
@@ -176,79 +121,114 b''
176 121 ;;; 11main
177 122
178 123 (defm (root lib main-p) (s)
179 (api-call add-text :main s))
124 (api-call add-text :main s)
125 (values))
180 126
181 127 (defm (root lib main-pl) (s)
182 128 (api-call add-text :main s)
183 (api-call newline :main))
129 (api-call newline :main)
130 (values))
184 131
185 132 (defm (root lib main-nl) (s)
186 133 (api-call newline :main)
187 (api-call add-text :main s))
134 (api-call add-text :main s)
135 (values))
188 136
189 137 (defm (root lib maintxt) (s)
190 (api-call get-text :main))
138 (api-call get-text :main)
139 (values))
191 140
141 ;; For clarity (it leaves a lib.desc() call in JS)
192 142 (defm (root lib desc) (s)
193 143 "")
194 144
195 145 (defm (root lib main-clear) ()
196 (api-call clear-text :main))
146 (api-call clear-text :main)
147 (values))
197 148
198 149 ;;; 12stat
199 150
200 (defm (root lib showstat) ())
151 (defm (root lib stat-p) (s)
152 (api-call add-text :stat s)
153 (values))
201 154
202 (defm (root lib stat-p) ())
155 (defm (root lib stat-pl) (s)
156 (api-call add-text :stat s)
157 (api-call newline :stat)
158 (values))
203 159
204 (defm (root lib stat-pl) ())
160 (defm (root lib stat-nl) (s)
161 (api-call newline :stat)
162 (api-call add-text :stat s)
163 (values))
205 164
206 (defm (root lib stat-nl) ())
207
208 (defm (root lib stattxt) ())
165 (defm (root lib stattxt) (s)
166 (api-call get-text :stat)
167 (values))
209 168
210 (defm (root lib clear) ())
169 (defm (root lib stat-clear) ()
170 (api-call clear-text :stat)
171 (values))
211 172
212 (defm (root lib cls) ())
173 (defm (root lib cls) ()
174 (funcall (root lib stat-clear))
175 (funcall (root lib main-clear))
176 (funcall (root lib cla))
177 (funcall (root lib cmdclear))
178 (values))
213 179
214 180 ;;; 13diag
215 181
216 (defm (root lib msg) ())
217
218 182 ;;; 14act
219 183
220 (defm (root lib showacts) ())
221
222 (defm (root lib delact) (name)
223 (api-call del-act name))
224
225 (defm (root lib curacts) ())
226
227 (defm (root lib cla) ())
184 (defm (root lib curacts) ()
185 (let ((acts (root acts)))
186 (lambda ()
187 (setf (root acts) acts)
188 (values))))
228 189
229 190 ;;; 15objs
230 191
231 (defm (root lib showobjs) ())
232
233 192 (defm (root lib addobj) (name)
234 193 (ps:chain (root objs) (push name))
235 (api-call update-objs))
194 (api-call update-objs)
195 (values))
236 196
237 197 (defm (root lib delobj) (name)
238 198 (let ((index (ps:chain (root objs) (index-of name))))
239 199 (when (> index -1)
240 (ps:chain (root objs) (splice index 1))))
241 (api-call update-objs))
200 (funcall (root lib killobj) index)))
201 (values))
242 202
243 (defm (root lib killobj) ())
244
245 (defm (root lib countobj) ())
246
247 (defm (root lib getobj) ())
203 (defm (root lib killobj) (&optional num)
204 (if num
205 (ps:chain (root objs) (splice (1+ num) 1))
206 (setf (root objs) (list)))
207 (api-call update-objs)
208 (values))
248 209
249 210 ;;; 16menu
250 211
251 (defm (root lib menu) ())
212 (defm (root lib menu) (menu-name)
213 (let ((menu-data (list)))
214 (loop :for item :in (api-call get-array menu-name)
215 :do (cond ((string= item "")
216 (break))
217 ((string= item "-:-")
218 (ps:chain menu-data (push :delimiter)))
219 (t
220 (let* ((tokens (ps:chain item (split ":"))))
221 (when (= (length tokens) 2)
222 (tokens.push ""))
223 (let* ((text (ps:chain tokens (splice 0 (- tokens.length 2)) (join ":")))
224 (loc (ps:getprop tokens (- tokens.length 2)))
225 (icon (ps:getprop tokens (- tokens.length 1))))
226 (ps:chain menu-data
227 (push (ps:create text text
228 loc loc
229 icon icon))))))))
230 (api-call menu menu-data)
231 (values)))
252 232
253 233 ;;; 17sound
254 234
@@ -278,7 +258,11 b''
278 258
279 259 ;;; 20time
280 260
281 (defm (root lib wait) ())
261 ;; I wonder if there's a better solution than busy-wait
262 (defm (root lib wait) (msec)
263 (let* ((now (ps:new (*date)))
264 (exit-time (+ (funcall now.get-time) msec)))
265 (loop :while (< (funcall now.get-time) exit-time))))
282 266
283 267 (defm (root lib msecscount) ())
284 268
@@ -294,6 +278,36 b''
294 278
295 279 (defm (root lib killqst) ())
296 280
297 (defm (root lib opengame) ())
281 (defm (root lib opengame) (&optional filename)
282 (let ((element (document.create-element :input)))
283 (element.set-attribute :type :file)
284 (element.set-attribute :id :qsp-opengame)
285 (element.set-attribute :tabindex -1)
286 (element.set-attribute "aria-hidden" t)
287 (setf element.style.display :block)
288 (setf element.style.visibility :hidden)
289 (setf element.style.position :fixed)
290 (setf element.onchange
291 (lambda (event)
292 (let* ((file (elt event.target.files 0))
293 (reader (ps:new (*file-reader))))
294 (setf reader.onload
295 (lambda (ev)
296 (block nil
297 (let ((target ev.current-target))
298 (unless target.result
299 (return))
300 (api-call base64-to-state target.result)))))
301 (reader.read-as-text file))))
302 (document.body.append-child element)
303 (element.click)
304 (document.body.remove-child element)))
298 305
299 (defm (root lib savegame) ())
306 (defm (root lib savegame) (&optional filename)
307 (let ((element (document.create-element :a)))
308 (element.set-attribute :href (+ "data:text/plain;charset=utf-8," (api-call state-to-base64)))
309 (element.set-attribute :download "savegame.sav")
310 (setf element.style.display :none)
311 (document.body.append-child element)
312 (element.click)
313 (document.body.remove-child element)))
@@ -54,7 +54,7 b''
54 54 (alexandria:read-file-into-string filename)))
55 55
56 56 (defun make-javascript (locations)
57 (format nil "~{~A~^~%~%~}"
57 (format nil "////// THE GAME STARTS HERE~%~%~{~A~^~%~%~}"
58 58 (mapcar #'ps:ps* locations)))
59 59
60 60 (defun uglify-js::write-json-chars (quote s stream)
@@ -92,18 +92,9 b' Monkey-patched to output plain utf-8 ins'
92 92
93 93 ;;; JS
94 94
95 (defun src-file (filename)
96 (uiop/pathname:merge-pathnames*
97 filename
98 (asdf:system-source-directory :sugar-qsp)))
99
100 95 (defmethod js-sources ((compiler compiler))
101 96 (format nil "~{~A~^~%~%~}" (reverse (js compiler))))
102 97
103 (defun compile-ps (filename)
104 (format nil "////// Parenscript file: ~A~%~%~A"
105 (file-namestring filename) (ps:ps-compile-file filename)))
106
107 98 ;;; CSS
108 99
109 100 (defmethod css-sources ((compiler compiler))
@@ -129,16 +120,6 b' Monkey-patched to output plain utf-8 ins'
129 120 :stream out
130 121 :pretty nil))))
131 122
132 (defclass compiler ()
133 ((body :accessor body :initform #.(alexandria:read-file-into-string (src-file "extras/body.html")))
134 (css :accessor css :initform (list #.(alexandria:read-file-into-string (src-file "extras/default.css"))))
135 (js :accessor js :initform (list #.(compile-ps (src-file "src/intrinsics.ps"))
136 #.(compile-ps (src-file "src/api.ps"))
137 #.(compile-ps (src-file "src/main.ps"))))
138 (compile :accessor compile-only :initarg :compile)
139 (target :accessor target :initarg :target)
140 (beautify :accessor beautify :initarg :beautify)))
141
142 123 (defmethod initialize-instance ((compiler compiler) &key source ((:js js-files)) ((:css css-files)) ((:body body-file)) compile &allow-other-keys)
143 124 (call-next-method)
144 125 (with-slots (body css js)
@@ -6,10 +6,16 b''
6 6 objs (list)
7 7 state-stash (ps:create)
8 8 acts (ps:create)
9 locations (ps:create)))
9 locs (ps:create)))
10 10
11 ;; Launch the game from the first location
11 12 (setf window.onload
12 13 (lambda ()
13 (funcall (ps:getprop (root locations)
14 (ps:chain *object (keys (root locations)) 0)))
14 (funcall (ps:getprop (root locs)
15 (ps:chain *object (keys (root locs)) 0)))
15 16 (values)))
17
18 ;; Close the dropdown on any click
19 (setf window.onclick
20 (lambda (event)
21 (setf (ps:@ (api-call get-frame :dropdown) style display) "none")))
@@ -184,7 +184,7 b''
184 184 (declare (ignore spaces1 spaces2))
185 185 (string-upcase (string-trim " " (p:text name)))))
186 186
187 (p:defrule location-end (and #\- #\newline before-statement)
187 (p:defrule location-end (and #\- (* not-newline) #\newline before-statement)
188 188 (:constant nil))
189 189
190 190 ;;; Block body
@@ -486,8 +486,8 b''
486 486 (openqst nil 1 1)
487 487 (addqst nil 1 1 "addqst" "addlib" "inclib")
488 488 (killqst nil 1 1 "killqst" "dellib" "freelib")
489 (opengame nil 0 1)
490 (savegame nil 0 1)
489 (opengame nil 0 0)
490 (savegame nil 0 0)
491 491 ;; Real time
492 492 (wait nil 1 1)
493 493 (msecscount t 0 0)
@@ -41,7 +41,7 b''
41 41 :collect `(defpsintrinsic ,name))))
42 42
43 43 (defpsintrinsics ()
44 killvar obj loc no qspver curloc rand rnd qspmax qspmin killall copyarr arrsize arrpos arrcomp len mid ucase lcase trim replace instr isnum val qspstr strcomp strfind strpos iif gosub func dynamic dyneval main-p main-pl main-nl maintxt main-clear showstat stat-p stat-pl stat-nl stattxt stat-clear cls msg showacts delact curacts cla showobjs addobj delobj killobj countobj getobj menu play isplay close closeall refint view rgb showinput usertxt cmdclear input openqst addqst killqst opengame savegame wait msecscount settimer)
44 rand copyarr arrpos arrcomp instr isnum strcomp strfind strpos iif gosub func dynamic dyneval main-p main-pl main-nl maintxt main-clear stat-p stat-pl stat-nl stattxt stat-clear cls curacts addobj delobj killobj menu play isplay close closeall refint view rgb showinput usertxt cmdclear input openqst addqst killqst opengame savegame wait msecscount settimer)
45 45
46 46 (ps:defpsmacro api-call (func &rest args)
47 47 `(funcall (root api ,func) ,@args))
@@ -66,11 +66,10 b''
66 66 ;;; 1loc
67 67
68 68 (ps:defpsmacro location ((name) &body body)
69 `(setf (root locations ,name)
69 `(setf (root locs ,name)
70 70 (lambda ()
71 71 (label-block
72 ,@body
73 (api-call update-acts)))))
72 ,@body))))
74 73
75 74 (ps:defpsmacro goto (target &rest args)
76 75 `(progn
@@ -155,9 +154,6 b''
155 154 (ps:getprop __labels ,(third f)))))))))
156 155 (jump (str "__nil"))))))
157 156
158 (ps:defpsmacro exit ()
159 `(return-from nil (values)))
160
161 157 ;;; 10dynamic
162 158
163 159 (ps:defpsmacro qspblock (&body body)
@@ -7,5 +7,7 b''
7 7 :serial t
8 8 :components ((:file "package")
9 9 (:file "ps-macros")
10 (:file "intrinsic-macros")
11 (:file "class")
10 12 (:file "main")
11 13 (:file "parser")))
General Comments 0
You need to be logged in to leave comments. Login now