Show More
@@ -0,0 +1,60 b'' | |||
|
1 | ||
|
2 | (in-package parenscript) | |
|
3 | ||
|
4 | ;;; async/await | |
|
5 | ||
|
6 | (defprinter ps-js::await (x) | |
|
7 | (psw (string-downcase "await ")) | |
|
8 | (print-op-argument 'ps-js::await x)) | |
|
9 | ||
|
10 | (define-trivial-special-ops await) | |
|
11 | ||
|
12 | (define-statement-operator async-defun (name lambda-list &rest body) | |
|
13 | (multiple-value-bind (effective-args body-block docstring) | |
|
14 | (compile-named-function-body name lambda-list body) | |
|
15 | (list 'ps-js::async-defun name effective-args docstring body-block))) | |
|
16 | ||
|
17 | (defprinter ps-js::async-defun (name args docstring body-block) | |
|
18 | (when docstring (print-comment docstring)) | |
|
19 | (psw "async ") | |
|
20 | (print-fun-def name args body-block)) | |
|
21 | ||
|
22 | (define-expression-operator async-lambda (lambda-list &rest body) | |
|
23 | (multiple-value-bind (effective-args effective-body) | |
|
24 | (parse-extended-function lambda-list body) | |
|
25 | `(ps-js::async-lambda | |
|
26 | ,effective-args | |
|
27 | ,(let ((*function-block-names* ())) | |
|
28 | (compile-function-body effective-args effective-body))))) | |
|
29 | ||
|
30 | (defprinter ps-js::async-lambda (args body-block) | |
|
31 | (psw "async ") | |
|
32 | (print-fun-def nil args body-block)) | |
|
33 | ||
|
34 | (cl:export 'await) | |
|
35 | (cl:export 'async-defun) | |
|
36 | (cl:export 'async-lambda) | |
|
37 | ||
|
38 | ;;; ES6 | |
|
39 | ||
|
40 | (define-expression-operator => (lambda-list &rest body) | |
|
41 | (unless (listp lambda-list) | |
|
42 | (setf lambda-list (list lambda-list))) | |
|
43 | (multiple-value-bind (effective-args effective-body) | |
|
44 | (parse-extended-function lambda-list body) | |
|
45 | `(ps-js::=> | |
|
46 | ,effective-args | |
|
47 | ,(let ((*function-block-names* ())) | |
|
48 | (compile-function-body effective-args effective-body))))) | |
|
49 | ||
|
50 | (defprinter ps-js::=> (args body) | |
|
51 | (unless (= 1 (length args)) | |
|
52 | (psw "(")) | |
|
53 | (loop for (arg . remaining) on args do | |
|
54 | (psw (symbol-to-js-string arg)) (when remaining (psw ", "))) | |
|
55 | (unless (= 1 (length args)) | |
|
56 | (psw ")")) | |
|
57 | (psw " => ") | |
|
58 | (ps-print body)) | |
|
59 | ||
|
60 | (cl:export '=>) |
@@ -1,6 +1,5 b'' | |||
|
1 | 1 | |
|
2 | * Remove cl-uglify-js (no support for ES6 at all and no way to monkey-patch it reliably) | |
|
3 | * Use Parenscript's async/await | |
|
2 | * Use async/await | |
|
4 | 3 | * Use Parenscript's minifier |
|
5 | 4 | * WAIT and MENU with async/await |
|
6 | 5 | * Special locations |
@@ -11,7 +11,7 b'' | |||
|
11 | 11 | ;;; Utils |
|
12 | 12 | |
|
13 | 13 | (defm (root api make-act-html) (title img) |
|
14 |
(+ "<a class='qsp-act' href='#' onclick='SugarQSP.a |
|
|
14 | (+ "<a class='qsp-act' href='#' onclick='SugarQSP.api.callAct(\"" title "\");'>" | |
|
15 | 15 | title |
|
16 | 16 | "</a>")) |
|
17 | 17 | |
@@ -53,7 +53,7 b'' | |||
|
53 | 53 | (this.append-id (this.key-to-id key) "<br>" t)) |
|
54 | 54 | |
|
55 | 55 | (defm (root api clear-id) (id) |
|
56 |
(setf (ps: |
|
|
56 | (setf (ps:inner-html (document.get-element-by-id id)) "")) | |
|
57 | 57 | |
|
58 | 58 | (setf (root api text-escaper) (document.create-element :textarea)) |
|
59 | 59 | |
@@ -62,17 +62,17 b'' | |||
|
62 | 62 | s |
|
63 | 63 | (progn |
|
64 | 64 | (setf (ps:@ (root api text-escaper) text-content) s) |
|
65 |
(ps: |
|
|
65 | (ps:inner-html (root api text-escaper))))) | |
|
66 | 66 | |
|
67 | 67 | (defm (root api get-id) (id &optional force-html) |
|
68 |
(ps: |
|
|
68 | (ps:inner-html (document.get-element-by-id id))) | |
|
69 | 69 | |
|
70 | 70 | (defm (root api set-id) (id contents &optional force-html) |
|
71 |
(setf (ps: |
|
|
71 | (setf (ps:inner-html (document.get-element-by-id id)) (this.prepare-contents contents force-html))) | |
|
72 | 72 | |
|
73 | 73 | (defm (root api append-id) (id contents &optional force-html) |
|
74 | 74 | (when contents |
|
75 |
(incf (ps: |
|
|
75 | (incf (ps:inner-html (document.get-element-by-id id)) (this.prepare-contents contents force-html)))) | |
|
76 | 76 | |
|
77 | 77 | ;;; Function calls |
|
78 | 78 | |
@@ -89,7 +89,12 b'' | |||
|
89 | 89 | (var result 0 :num))) |
|
90 | 90 | |
|
91 | 91 | (defm (root api call-loc) (name args) |
|
92 | (funcall (ps:getprop (root locs) name) args)) | |
|
92 | (with-frame | |
|
93 | (funcall (ps:getprop (root locs) name) args))) | |
|
94 | ||
|
95 | (defm (root api call-act) (title) | |
|
96 | (with-frame | |
|
97 | (funcall (ps:getprop (root acts) title)))) | |
|
93 | 98 | |
|
94 | 99 | ;;; Text windows |
|
95 | 100 | |
@@ -140,7 +145,7 b'' | |||
|
140 | 145 | (let ((elt (document.get-element-by-id "qsp-acts"))) |
|
141 | 146 | (ps:for-in (title (root acts)) |
|
142 | 147 | (let ((obj (ps:getprop (root acts) title))) |
|
143 |
(incf |
|
|
148 | (incf (ps:inner-html elt) (this.make-act-html title (ps:getprop obj :img))))))) | |
|
144 | 149 | |
|
145 | 150 | |
|
146 | 151 | ;;; "Syntax" |
@@ -266,20 +271,20 b'' | |||
|
266 | 271 | |
|
267 | 272 | (defm (root api update-objs) () |
|
268 | 273 | (let ((elt (document.get-element-by-id "qsp-objs"))) |
|
269 |
(setf |
|
|
274 | (setf (ps:inner-html elt) "<ul>") | |
|
270 | 275 | (loop :for obj :in (root objs) |
|
271 |
:do (incf |
|
|
272 |
(incf |
|
|
276 | :do (incf (ps:inner-html elt) (+ "<li>" obj))) | |
|
277 | (incf (ps:inner-html elt) "</ul>"))) | |
|
273 | 278 | |
|
274 | 279 | ;;; Menu |
|
275 | 280 | |
|
276 | 281 | (defm (root api menu) (menu-data) |
|
277 | 282 | (let ((elt (document.get-element-by-id "qsp-dropdown")) |
|
278 | 283 | (i 0)) |
|
279 |
(setf |
|
|
284 | (setf (ps:inner-html elt) "") | |
|
280 | 285 | (loop :for item :in menu-data |
|
281 | 286 | :do (incf i) |
|
282 |
:do (incf |
|
|
287 | :do (incf (ps:inner-html elt) (this.make-menu-item-html i item.text item.icon item.loc))) | |
|
283 | 288 | (setf elt.style.display "block"))) |
|
284 | 289 | |
|
285 | 290 | ;;; Content |
@@ -344,12 +349,10 b'' | |||
|
344 | 349 | objs (root objs) |
|
345 | 350 | loc-args args |
|
346 | 351 | msecs (- (*date.now) (root started-at)) |
|
347 |
main-html (ps: |
|
|
348 | (document.get-element-by-id :qsp-main) | |
|
349 |
|
|
|
350 | stat-html (ps:@ | |
|
351 | (document.get-element-by-id :qsp-stat) | |
|
352 | inner-h-t-m-l) | |
|
352 | main-html (ps:inner-html | |
|
353 | (document.get-element-by-id :qsp-main)) | |
|
354 | stat-html (ps:inner-html | |
|
355 | (document.get-element-by-id :qsp-stat)) | |
|
353 | 356 | next-location (root current-location)))) |
|
354 | 357 | (values)) |
|
355 | 358 | |
@@ -363,9 +366,9 b'' | |||
|
363 | 366 | (setf (root started-at) (- (*date.now) (ps:@ data msecs))) |
|
364 | 367 | (setf (root objs) (ps:@ data objs)) |
|
365 | 368 | (setf (root current-location) (ps:@ data next-location)) |
|
366 |
(setf (ps: |
|
|
369 | (setf (ps:inner-html (document.get-element-by-id :qsp-main)) | |
|
367 | 370 | (ps:@ data main-html)) |
|
368 |
(setf (ps: |
|
|
371 | (setf (ps:inner-html (document.get-element-by-id :qsp-stat)) | |
|
369 | 372 | (ps:@ data stat-html)) |
|
370 | 373 | (this.update-objs) |
|
371 | 374 | (api-call call-serv-loc "ONGLOAD") |
@@ -6,16 +6,23 b'' | |||
|
6 | 6 | (uiop/pathname:merge-pathnames* |
|
7 | 7 | filename |
|
8 | 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)))) | |
|
9 | (defun read-code-from-string (string) | |
|
10 | (with-input-from-string (in string) | |
|
11 | `(progn | |
|
12 | ,@(loop :for form := (read in nil :eof) | |
|
13 | :until (eq form :eof) | |
|
14 | :collect form)))) | |
|
15 | (defun load-src (filename) | |
|
16 | (alexandria:read-file-into-string (src-file filename)))) | |
|
12 | 17 | |
|
13 | 18 | (defclass compiler () |
|
14 |
((body :accessor body :initform #.( |
|
|
15 |
(css :accessor css :initform (list #.( |
|
|
16 |
(js :accessor js :initform |
|
|
17 |
|
|
|
18 |
|
|
|
19 | ((body :accessor body :initform #.(load-src "extras/body.html")) | |
|
20 | (css :accessor css :initform (list #.(load-src "extras/default.css"))) | |
|
21 | (js :accessor js :initform '#.(mapcar #'read-code-from-string | |
|
22 | (mapcar #'load-src | |
|
23 | (list "src/intrinsics.ps" | |
|
24 | "src/api.ps" | |
|
25 | "src/main.ps")))) | |
|
19 | 26 | (compile :accessor compile-only :initarg :compile) |
|
20 | 27 | (target :accessor target :initarg :target) |
|
21 | 28 | (beautify :accessor beautify :initarg :beautify))) |
@@ -53,39 +53,6 b'' | |||
|
53 | 53 | (p:parse 'sugar-qsp-grammar |
|
54 | 54 | (alexandria:read-file-into-string filename))) |
|
55 | 55 | |
|
56 | (defun make-javascript (locations) | |
|
57 | (format nil "////// THE GAME STARTS HERE~%~%~{~A~^~%~%~}" | |
|
58 | (mapcar #'ps:ps* locations))) | |
|
59 | ||
|
60 | (defun uglify-js::write-json-chars (quote s stream) | |
|
61 | "Write JSON representations (chars or escape sequences) of | |
|
62 | characters in string S to STREAM. | |
|
63 | Monkey-patched to output plain utf-8 instead of escape-sequences." | |
|
64 | (write-char quote stream) | |
|
65 | (loop :for ch :across s | |
|
66 | :for code := (char-code ch) | |
|
67 | :with special | |
|
68 | :do (cond ((eq ch quote) | |
|
69 | (write-char #\\ stream) (write-char ch stream)) | |
|
70 | ((setq special (car (rassoc ch uglify-js::+json-lisp-escaped-chars+))) | |
|
71 | (write-char #\\ stream) (write-char special stream)) | |
|
72 | (t | |
|
73 | (write-char ch stream)))) | |
|
74 | (write-char quote stream)) | |
|
75 | ||
|
76 | (defun preprocess-js (js beautify) | |
|
77 | (if beautify | |
|
78 | (cl-uglify-js:ast-gen-code | |
|
79 | (cl-uglify-js:ast-squeeze | |
|
80 | (parse-js:parse-js js) | |
|
81 | :sequences nil) | |
|
82 | :beautify t) | |
|
83 | (cl-uglify-js:ast-gen-code | |
|
84 | (cl-uglify-js:ast-mangle | |
|
85 | (cl-uglify-js:ast-squeeze | |
|
86 | (parse-js:parse-js js))) | |
|
87 | :beautify nil))) | |
|
88 | ||
|
89 | 56 | (defun report-error (fmt &rest args) |
|
90 | 57 | (apply #'format t fmt args) |
|
91 | 58 | (throw :terminate nil)) |
@@ -93,7 +60,8 b' Monkey-patched to output plain utf-8 ins' | |||
|
93 | 60 | ;;; JS |
|
94 | 61 | |
|
95 | 62 | (defmethod js-sources ((compiler compiler)) |
|
96 | (format nil "~{~A~^~%~%~}" (reverse (js compiler)))) | |
|
63 | (let ((ps:*ps-print-pretty* (beautify compiler))) | |
|
64 | (format nil "~{~A~^~%~%~}" (mapcar #'ps:ps* (reverse (js compiler)))))) | |
|
97 | 65 | |
|
98 | 66 | ;;; CSS |
|
99 | 67 | |
@@ -116,7 +84,7 b' Monkey-patched to output plain utf-8 ins' | |||
|
116 | 84 | (body |
|
117 | 85 | body-template |
|
118 | 86 | (style css) |
|
119 | (script (preprocess-js js (beautify compiler)))))) | |
|
87 | (script js)))) | |
|
120 | 88 | :stream out |
|
121 | 89 | :pretty nil)))) |
|
122 | 90 | |
@@ -125,7 +93,7 b' Monkey-patched to output plain utf-8 ins' | |||
|
125 | 93 | (with-slots (body css js) |
|
126 | 94 | compiler |
|
127 | 95 | ;; Compile the game's JS |
|
128 |
(push ( |
|
|
96 | (push (list* 'progn (parse-file source)) js) | |
|
129 | 97 | ;; Does the user need us to do anything else |
|
130 | 98 | (unless compile |
|
131 | 99 | ;; Read in body |
@@ -325,7 +325,7 b'' | |||
|
325 | 325 | (p:? (and spaces (p:~ "if")))) |
|
326 | 326 | (:constant nil)) |
|
327 | 327 | |
|
328 |
(p:defrule block-act (and block-act-head (or block- |
|
|
328 | (p:defrule block-act (and block-act-head (or block-ml block-sl)) | |
|
329 | 329 | (:lambda (list) |
|
330 | 330 | (apply #'append list))) |
|
331 | 331 | |
@@ -547,7 +547,7 b'' | |||
|
547 | 547 | |
|
548 | 548 | (p:defrule eq-expr (and sum-expr (* (and spaces? (or "<=" ">=" "=<" "=>" "<>" |
|
549 | 549 | "=" "<" ">" "!") |
|
550 |
spaces? |
|
|
550 | spaces? sum-expr))) | |
|
551 | 551 | (:function do-binop)) |
|
552 | 552 | |
|
553 | 553 | (p:defrule sum-expr (and mod-expr (* (and spaces? (or #\+ #\-) spaces? mod-expr))) |
@@ -46,9 +46,8 b'' | |||
|
46 | 46 | ,@(when has-labels |
|
47 | 47 | '((defvar __labels))) |
|
48 | 48 | ,@(if locals |
|
49 |
`(( |
|
|
50 |
|
|
|
51 | ,@body))) | |
|
49 | `((tagbody | |
|
50 | ,@body)) | |
|
52 | 51 | `((tagbody |
|
53 | 52 | ,@body)))))) |
|
54 | 53 |
@@ -1,8 +1,10 b'' | |||
|
1 | 1 | |
|
2 | 2 | (defsystem sugar-qsp |
|
3 | 3 | :description "QSP compiler to monolithic HTML page" |
|
4 |
:depends-on (:alexandria |
|
|
5 | :parenscript :parse-js :cl-uglify-js :flute) | |
|
4 | :depends-on (:alexandria ;; General | |
|
5 | :esrap ;; Parsing | |
|
6 | :parenscript :flute ;; Codegening | |
|
7 | ) | |
|
6 | 8 | :pathname "src/" |
|
7 | 9 | :serial t |
|
8 | 10 | :components ((:file "package") |
General Comments 0
You need to be logged in to leave comments.
Login now