Show More
@@ -1,164 +1,164 b'' | |||
|
1 | 1 | |
|
2 | 2 | (in-package txt2web) |
|
3 | 3 | |
|
4 | 4 | (defvar *app-name* "txt2web") |
|
5 | 5 | |
|
6 | 6 | (defun entry-point-no-args () |
|
7 | 7 | (setf *delivered* t) |
|
8 | 8 | (entry-point uiop:*command-line-arguments*)) |
|
9 | 9 | |
|
10 | 10 | (defun entry-point (args) |
|
11 | 11 | (let ((*package* (find-package :txt2web))) |
|
12 | 12 | (catch :terminate |
|
13 | 13 | (let ((compiler (apply #'make-instance 'compiler (parse-opts args)))) |
|
14 | 14 | (if (parse-only compiler) |
|
15 | 15 | (let ((*package* (find-package :txt2web.lib))) |
|
16 | 16 | (format t "~{~S~^~%~%~}" (reverse (ast compiler)))) |
|
17 | 17 | (write-compiled-file compiler))))) |
|
18 | 18 | (values)) |
|
19 | 19 | |
|
20 | 20 | (defun parse-opts (args) |
|
21 | 21 | (let ((mode :sources) |
|
22 | 22 | (data (list :sources nil :target nil :js nil :css nil :body nil :compile nil :parse nil :beautify nil))) |
|
23 | 23 | (loop :for arg :in args |
|
24 | 24 | :do (alexandria:switch (arg :test #'string=) |
|
25 | 25 | ("-o" (setf mode :target)) |
|
26 | 26 | ("--js" (setf mode :js)) |
|
27 | 27 | ("--css" (setf mode :css)) |
|
28 | 28 | ("--body" (setf mode :body)) |
|
29 | 29 | ("-c" (setf (getf data :compile) t)) |
|
30 | 30 | ("-p" (setf (getf data :parse) t)) |
|
31 | 31 | ("--beautify" (setf (getf data :beautify) t)) |
|
32 | 32 | (t (push arg (getf data mode))))) |
|
33 | 33 | (unless (< 0 (length (getf data :sources))) |
|
34 | 34 | (report-error "There should be at least one source")) |
|
35 |
( |
|
|
35 | (when (> 1 (length (getf data :target))) | |
|
36 | 36 | (report-error "There should be no more than one target")) |
|
37 | 37 | (unless (> 1 (length (getf data :body))) |
|
38 | 38 | (report-error "There should be no more than one body")) |
|
39 | 39 | (unless (getf data :target) |
|
40 | 40 | (setf (getf data :target) |
|
41 | 41 | (let* ((sources (first (getf data :sources))) |
|
42 | 42 | (tokens (uiop:split-string sources :separator ".")) |
|
43 | 43 | (target (format nil "~{~A~^.~}.html" |
|
44 | 44 | (butlast tokens)))) |
|
45 | 45 | (list target)))) |
|
46 | 46 | (list :sources (getf data :sources) |
|
47 | 47 | :target (first (getf data :target)) |
|
48 | 48 | :js (getf data :js) |
|
49 | 49 | :parse (getf data :parse) |
|
50 | 50 | :css (getf data :css) |
|
51 | 51 | :body (first (getf data :body)) |
|
52 | 52 | :compile (getf data :compile) |
|
53 | 53 | :beautify (getf data :beautify)))) |
|
54 | 54 | |
|
55 | 55 | (defun print-usage () |
|
56 | 56 | (lformat t :usage *app-name*)) |
|
57 | 57 | |
|
58 | 58 | (defun parse-file (filename) |
|
59 | 59 | (handler-case |
|
60 | 60 | (p:parse 'txt2web-grammar |
|
61 | 61 | (alexandria:read-file-into-string filename :external-format :utf-8)) |
|
62 | 62 | (p:esrap-parse-error (e) |
|
63 | 63 | (format t "~A~%" e) |
|
64 | 64 | (throw :terminate nil)))) |
|
65 | 65 | |
|
66 | 66 | (defun report-error (fmt &rest args) |
|
67 | 67 | (format t "ERROR: ~A~%" (apply #'format nil fmt args)) |
|
68 | 68 | (print-usage) |
|
69 | 69 | (throw :terminate nil)) |
|
70 | 70 | |
|
71 | 71 | ;;; JS |
|
72 | 72 | |
|
73 | 73 | (defun minify-package (package-designator minify prefix) |
|
74 | 74 | (setf (ps:ps-package-prefix package-designator) prefix) |
|
75 | 75 | (if minify |
|
76 | 76 | (ps:obfuscate-package package-designator) |
|
77 | 77 | (ps:unobfuscate-package package-designator))) |
|
78 | 78 | |
|
79 | 79 | (defmethod js-sources ((compiler compiler)) |
|
80 | 80 | (let ((ps:*ps-print-pretty* (beautify compiler))) |
|
81 | 81 | (cond ((beautify compiler) |
|
82 | 82 | (minify-package "TXT2WEB.MAIN" nil "qsp_") |
|
83 | 83 | (minify-package "TXT2WEB.API" nil "qsp_api_") |
|
84 | 84 | (minify-package "TXT2WEB.LIB" nil "qsp_lib_")) |
|
85 | 85 | (t |
|
86 | 86 | (minify-package "TXT2WEB.MAIN" t "_") |
|
87 | 87 | (minify-package "TXT2WEB.API" t "a_") |
|
88 | 88 | (minify-package "TXT2WEB.LIB" t "l_"))) |
|
89 | 89 | (format nil "~{~A~^~%~%~}" (mapcar #'ps:ps* (reverse (js compiler)))))) |
|
90 | 90 | |
|
91 | 91 | ;;; CSS |
|
92 | 92 | |
|
93 | 93 | (defmethod css-sources ((compiler compiler)) |
|
94 | 94 | (format nil "~{~A~^~%~%~}" (css compiler))) |
|
95 | 95 | |
|
96 | 96 | ;;; HTML |
|
97 | 97 | |
|
98 | 98 | (defmethod html-sources ((compiler compiler)) |
|
99 | 99 | (let ((flute:*escape-html* nil) |
|
100 | 100 | (body-template (body compiler)) |
|
101 | 101 | (js (js-sources compiler)) |
|
102 | 102 | (css (css-sources compiler))) |
|
103 | 103 | (with-output-to-string (out) |
|
104 | 104 | (write |
|
105 | 105 | (flute:h |
|
106 | 106 | (html |
|
107 | 107 | (head |
|
108 | 108 | (meta :charset "utf-8") |
|
109 | 109 | (title "txt2web")) |
|
110 | 110 | (body |
|
111 | 111 | body-template |
|
112 | 112 | (style css) |
|
113 | 113 | (script js)))) |
|
114 | 114 | :stream out |
|
115 | 115 | :pretty nil)))) |
|
116 | 116 | |
|
117 | 117 | (defun filename-game (filename) |
|
118 | 118 | (let ((filename (alexandria:lastcar (uiop:split-string filename :separator "/")))) |
|
119 | 119 | (format nil "~{~A~^.~}" (butlast (uiop:split-string filename :separator "."))))) |
|
120 | 120 | |
|
121 | 121 | (defmethod initialize-instance ((compiler compiler) &key sources ((:js js-files)) ((:css css-files)) ((:body body-file)) compile parse &allow-other-keys) |
|
122 | 122 | (call-next-method) |
|
123 | 123 | (with-slots (ast body css js) |
|
124 | 124 | compiler |
|
125 | 125 | ;; Compile the game's JS |
|
126 | 126 | (dolist (source sources) |
|
127 | 127 | (let ((ps (parse-file source)) |
|
128 | 128 | (game-name (filename-game source))) |
|
129 | 129 | (destructuring-bind (kw &rest locations) |
|
130 | 130 | ps |
|
131 | 131 | (unless (eq kw 'lib:game) |
|
132 | 132 | (report-error "Internal error!")) |
|
133 | 133 | (push |
|
134 | 134 | `(lib:game (,game-name) ,@locations) |
|
135 | 135 | ast)))) |
|
136 | 136 | (setf js (append ast js)) |
|
137 | 137 | ;; Does the user need us to do anything else |
|
138 | 138 | (unless (or parse compile) |
|
139 | 139 | ;; Read in body |
|
140 | 140 | (when body-file |
|
141 | 141 | (setf body |
|
142 | 142 | (alexandria:read-file-into-string body-file :external-format :utf-8))) |
|
143 | 143 | ;; Include js files |
|
144 | 144 | (dolist (js-file js-files) |
|
145 | 145 | (push (format nil "////// Included file ~A~%~A" js-file |
|
146 | 146 | (alexandria:read-file-into-string js-file :external-format :utf-8)) |
|
147 | 147 | js)) |
|
148 | 148 | ;; Include css files |
|
149 | 149 | (when css-files |
|
150 | 150 | ;; User option overrides the default css |
|
151 | 151 | (setf css nil) |
|
152 | 152 | (dolist (css-file css-files) |
|
153 | 153 | (push (format nil "////// Included file ~A~%~A" css-file |
|
154 | 154 | (alexandria:read-file-into-string css-file :external-format :utf-8)) |
|
155 | 155 | css)))))) |
|
156 | 156 | |
|
157 | 157 | (defmethod write-compiled-file ((compiler compiler)) |
|
158 | 158 | (alexandria:write-string-into-file |
|
159 | 159 | (if (compile-only compiler) |
|
160 | 160 | ;; Just the JS |
|
161 | 161 | (js-sources compiler) |
|
162 | 162 | ;; All of it |
|
163 | 163 | (html-sources compiler)) |
|
164 | 164 | (target compiler) :if-exists :supersede)) |
General Comments 0
You need to be logged in to leave comments.
Login now