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