main.lisp
164 lines
| 5.7 KiB
| text/x-common-lisp
|
CommonLispLexer
/ src / main.lisp
r1 | ||||
r46 | (in-package txt2web) | |||
r1 | ||||
r55 | (defvar *app-name* "txt2web") | |||
r44 | ||||
r9 | (defun entry-point-no-args () | |||
r54 | (setf *delivered* t) | |||
r9 | (entry-point uiop:*command-line-arguments*)) | |||
(defun entry-point (args) | ||||
r46 | (let ((*package* (find-package :txt2web))) | |||
r44 | (catch :terminate | |||
r50 | (let ((compiler (apply #'make-instance 'compiler (parse-opts args)))) | |||
r61 | (if (parse-only compiler) | |||
(let ((*package* (find-package :txt2web.lib))) | ||||
(format t "~{~S~^~%~%~}" (reverse (ast compiler)))) | ||||
(write-compiled-file compiler))))) | ||||
r9 | (values)) | |||
r6 | ||||
(defun parse-opts (args) | ||||
r31 | (let ((mode :sources) | |||
r61 | (data (list :sources nil :target nil :js nil :css nil :body nil :compile nil :parse nil :beautify nil))) | |||
r6 | (loop :for arg :in args | |||
:do (alexandria:switch (arg :test #'string=) | ||||
("-o" (setf mode :target)) | ||||
("--js" (setf mode :js)) | ||||
("--css" (setf mode :css)) | ||||
("--body" (setf mode :body)) | ||||
("-c" (setf (getf data :compile) t)) | ||||
r61 | ("-p" (setf (getf data :parse) t)) | |||
r8 | ("--beautify" (setf (getf data :beautify) t)) | |||
r6 | (t (push arg (getf data mode))))) | |||
r31 | (unless (< 0 (length (getf data :sources))) | |||
(report-error "There should be at least one source")) | ||||
r6 | (unless (> 1 (length (getf data :target))) | |||
(report-error "There should be no more than one target")) | ||||
(unless (> 1 (length (getf data :body))) | ||||
(report-error "There should be no more than one body")) | ||||
(unless (getf data :target) | ||||
(setf (getf data :target) | ||||
r31 | (let* ((sources (first (getf data :sources))) | |||
(tokens (uiop:split-string sources :separator ".")) | ||||
r6 | (target (format nil "~{~A~^.~}.html" | |||
(butlast tokens)))) | ||||
(list target)))) | ||||
r31 | (list :sources (getf data :sources) | |||
r6 | :target (first (getf data :target)) | |||
:js (getf data :js) | ||||
r61 | :parse (getf data :parse) | |||
r6 | :css (getf data :css) | |||
:body (first (getf data :body)) | ||||
:compile (getf data :compile) | ||||
r8 | :beautify (getf data :beautify)))) | |||
r6 | ||||
(defun print-usage () | ||||
r46 | (lformat t :usage *app-name*)) | |||
r1 | ||||
(defun parse-file (filename) | ||||
r54 | (handler-case | |||
(p:parse 'txt2web-grammar | ||||
r58 | (alexandria:read-file-into-string filename :external-format :utf-8)) | |||
r54 | (p:esrap-parse-error (e) | |||
(format t "~A~%" e) | ||||
r56 | (throw :terminate nil)))) | |||
r1 | ||||
(defun report-error (fmt &rest args) | ||||
r44 | (format t "ERROR: ~A~%" (apply #'format nil fmt args)) | |||
(print-usage) | ||||
r1 | (throw :terminate nil)) | |||
r6 | ||||
;;; JS | ||||
r25 | (defun minify-package (package-designator minify prefix) | |||
(setf (ps:ps-package-prefix package-designator) prefix) | ||||
(if minify | ||||
(ps:obfuscate-package package-designator) | ||||
(ps:unobfuscate-package package-designator))) | ||||
r9 | (defmethod js-sources ((compiler compiler)) | |||
r23 | (let ((ps:*ps-print-pretty* (beautify compiler))) | |||
r25 | (cond ((beautify compiler) | |||
r46 | (minify-package "TXT2WEB.MAIN" nil "qsp_") | |||
(minify-package "TXT2WEB.API" nil "qsp_api_") | ||||
(minify-package "TXT2WEB.LIB" nil "qsp_lib_")) | ||||
r25 | (t | |||
r46 | (minify-package "TXT2WEB.MAIN" t "_") | |||
(minify-package "TXT2WEB.API" t "a_") | ||||
(minify-package "TXT2WEB.LIB" t "l_"))) | ||||
r23 | (format nil "~{~A~^~%~%~}" (mapcar #'ps:ps* (reverse (js compiler)))))) | |||
r6 | ||||
;;; CSS | ||||
r9 | (defmethod css-sources ((compiler compiler)) | |||
(format nil "~{~A~^~%~%~}" (css compiler))) | ||||
r6 | ||||
;;; HTML | ||||
r9 | (defmethod html-sources ((compiler compiler)) | |||
(let ((flute:*escape-html* nil) | ||||
(body-template (body compiler)) | ||||
(js (js-sources compiler)) | ||||
(css (css-sources compiler))) | ||||
(with-output-to-string (out) | ||||
(write | ||||
r6 | (flute:h | |||
(html | ||||
(head | ||||
r60 | (meta :charset "utf-8") | |||
r52 | (title "txt2web")) | |||
r6 | (body | |||
r9 | body-template | |||
r6 | (style css) | |||
r23 | (script js)))) | |||
r9 | :stream out | |||
:pretty nil)))) | ||||
r31 | (defun filename-game (filename) | |||
(let ((filename (alexandria:lastcar (uiop:split-string filename :separator "/")))) | ||||
(format nil "~{~A~^.~}" (butlast (uiop:split-string filename :separator "."))))) | ||||
r61 | (defmethod initialize-instance ((compiler compiler) &key sources ((:js js-files)) ((:css css-files)) ((:body body-file)) compile parse &allow-other-keys) | |||
r9 | (call-next-method) | |||
r61 | (with-slots (ast body css js) | |||
r9 | compiler | |||
;; Compile the game's JS | ||||
r31 | (dolist (source sources) | |||
(let ((ps (parse-file source)) | ||||
(game-name (filename-game source))) | ||||
(destructuring-bind (kw &rest locations) | ||||
ps | ||||
(unless (eq kw 'lib:game) | ||||
(report-error "Internal error!")) | ||||
(push | ||||
`(lib:game (,game-name) ,@locations) | ||||
r61 | ast)))) | |||
(setf js (append ast js)) | ||||
r9 | ;; Does the user need us to do anything else | |||
r61 | (unless (or parse compile) | |||
r9 | ;; Read in body | |||
(when body-file | ||||
(setf body | ||||
r58 | (alexandria:read-file-into-string body-file :external-format :utf-8))) | |||
r9 | ;; Include js files | |||
(dolist (js-file js-files) | ||||
(push (format nil "////// Included file ~A~%~A" js-file | ||||
r58 | (alexandria:read-file-into-string js-file :external-format :utf-8)) | |||
r9 | js)) | |||
;; Include css files | ||||
r44 | (when css-files | |||
;; User option overrides the default css | ||||
(setf css nil) | ||||
(dolist (css-file css-files) | ||||
(push (format nil "////// Included file ~A~%~A" css-file | ||||
r58 | (alexandria:read-file-into-string css-file :external-format :utf-8)) | |||
r44 | css)))))) | |||
r9 | ||||
(defmethod write-compiled-file ((compiler compiler)) | ||||
(alexandria:write-string-into-file | ||||
(if (compile-only compiler) | ||||
;; Just the JS | ||||
r31 | (js-sources compiler) | |||
r9 | ;; All of it | |||
(html-sources compiler)) | ||||
(target compiler) :if-exists :supersede)) | ||||