|
|
|
|
|
(in-package txt2web)
|
|
|
|
|
|
(defvar *app-name* "txt2web")
|
|
|
|
|
|
(defun entry-point-no-args ()
|
|
|
(setf *delivered* t)
|
|
|
(entry-point uiop:*command-line-arguments*))
|
|
|
|
|
|
(defun entry-point (args)
|
|
|
(let ((*package* (find-package :txt2web)))
|
|
|
(catch :terminate
|
|
|
(let ((compiler (apply #'make-instance 'compiler (parse-opts args))))
|
|
|
(if (parse-only compiler)
|
|
|
(let ((*package* (find-package :txt2web.lib)))
|
|
|
(format t "~{~S~^~%~%~}" (reverse (ast compiler))))
|
|
|
(write-compiled-file compiler)))))
|
|
|
(values))
|
|
|
|
|
|
(defun parse-opts (args)
|
|
|
(let ((mode :sources)
|
|
|
(data (list :sources nil :target nil :js nil :css nil :body nil :compile nil :parse nil :beautify nil)))
|
|
|
(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))
|
|
|
("-p" (setf (getf data :parse) t))
|
|
|
("--beautify" (setf (getf data :beautify) t))
|
|
|
(t (push arg (getf data mode)))))
|
|
|
(unless (< 0 (length (getf data :sources)))
|
|
|
(report-error "There should be at least one source"))
|
|
|
(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)
|
|
|
(let* ((sources (first (getf data :sources)))
|
|
|
(tokens (uiop:split-string sources :separator "."))
|
|
|
(target (format nil "~{~A~^.~}.html"
|
|
|
(butlast tokens))))
|
|
|
(list target))))
|
|
|
(list :sources (getf data :sources)
|
|
|
:target (first (getf data :target))
|
|
|
:js (getf data :js)
|
|
|
:parse (getf data :parse)
|
|
|
:css (getf data :css)
|
|
|
:body (first (getf data :body))
|
|
|
:compile (getf data :compile)
|
|
|
:beautify (getf data :beautify))))
|
|
|
|
|
|
(defun print-usage ()
|
|
|
(lformat t :usage *app-name*))
|
|
|
|
|
|
(defun parse-file (filename)
|
|
|
(handler-case
|
|
|
(p:parse 'txt2web-grammar
|
|
|
(alexandria:read-file-into-string filename :external-format :utf-8))
|
|
|
(p:esrap-parse-error (e)
|
|
|
(format t "~A~%" e)
|
|
|
(throw :terminate nil))))
|
|
|
|
|
|
(defun report-error (fmt &rest args)
|
|
|
(format t "ERROR: ~A~%" (apply #'format nil fmt args))
|
|
|
(print-usage)
|
|
|
(throw :terminate nil))
|
|
|
|
|
|
;;; JS
|
|
|
|
|
|
(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)))
|
|
|
|
|
|
(defmethod js-sources ((compiler compiler))
|
|
|
(let ((ps:*ps-print-pretty* (beautify compiler)))
|
|
|
(cond ((beautify compiler)
|
|
|
(minify-package "TXT2WEB.MAIN" nil "qsp_")
|
|
|
(minify-package "TXT2WEB.API" nil "qsp_api_")
|
|
|
(minify-package "TXT2WEB.LIB" nil "qsp_lib_"))
|
|
|
(t
|
|
|
(minify-package "TXT2WEB.MAIN" t "_")
|
|
|
(minify-package "TXT2WEB.API" t "a_")
|
|
|
(minify-package "TXT2WEB.LIB" t "l_")))
|
|
|
(format nil "~{~A~^~%~%~}" (mapcar #'ps:ps* (reverse (js compiler))))))
|
|
|
|
|
|
;;; CSS
|
|
|
|
|
|
(defmethod css-sources ((compiler compiler))
|
|
|
(format nil "~{~A~^~%~%~}" (css compiler)))
|
|
|
|
|
|
;;; HTML
|
|
|
|
|
|
(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
|
|
|
(flute:h
|
|
|
(html
|
|
|
(head
|
|
|
(meta :charset "utf-8")
|
|
|
(title "txt2web"))
|
|
|
(body
|
|
|
body-template
|
|
|
(style css)
|
|
|
(script js))))
|
|
|
:stream out
|
|
|
:pretty nil))))
|
|
|
|
|
|
(defun filename-game (filename)
|
|
|
(let ((filename (alexandria:lastcar (uiop:split-string filename :separator "/"))))
|
|
|
(format nil "~{~A~^.~}" (butlast (uiop:split-string filename :separator ".")))))
|
|
|
|
|
|
(defmethod initialize-instance ((compiler compiler) &key sources ((:js js-files)) ((:css css-files)) ((:body body-file)) compile parse &allow-other-keys)
|
|
|
(call-next-method)
|
|
|
(with-slots (ast body css js)
|
|
|
compiler
|
|
|
;; Compile the game's JS
|
|
|
(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)
|
|
|
ast))))
|
|
|
(setf js (append ast js))
|
|
|
;; Does the user need us to do anything else
|
|
|
(unless (or parse compile)
|
|
|
;; Read in body
|
|
|
(when body-file
|
|
|
(setf body
|
|
|
(alexandria:read-file-into-string body-file :external-format :utf-8)))
|
|
|
;; Include js files
|
|
|
(dolist (js-file js-files)
|
|
|
(push (format nil "////// Included file ~A~%~A" js-file
|
|
|
(alexandria:read-file-into-string js-file :external-format :utf-8))
|
|
|
js))
|
|
|
;; Include css files
|
|
|
(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
|
|
|
(alexandria:read-file-into-string css-file :external-format :utf-8))
|
|
|
css))))))
|
|
|
|
|
|
(defmethod write-compiled-file ((compiler compiler))
|
|
|
(alexandria:write-string-into-file
|
|
|
(if (compile-only compiler)
|
|
|
;; Just the JS
|
|
|
(js-sources compiler)
|
|
|
;; All of it
|
|
|
(html-sources compiler))
|
|
|
(target compiler) :if-exists :supersede))
|
|
|
|