diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -1,3 +1,6 @@ + +* @ for literal strings +* LOOP * Save-load game in slots diff --git a/examples/9jump.qsps b/examples/9jump.qsps --- a/examples/9jump.qsps +++ b/examples/9jump.qsps @@ -1,1134 +1,28 @@ - -txt2web -
-
-
-
- -
-
-
-
-
-
- - -
-
-
-
- -
- -
- - - \ No newline at end of file +:loop2 +if y y0: exit +end +- diff --git a/examples/9loops.qsps b/examples/9loops.qsps deleted file mode 100644 --- a/examples/9loops.qsps +++ /dev/null @@ -1,28 +0,0 @@ - -# loops -jump 'КонеЦ' -p 'Это сообщение не будет выведено' -:конец -p 'А это сообщение пользователь увидит' - -s=0 -:loop1 -if s<9: - s=s+1 - pl s - jump 'loop1' -end -p 'Всё!' - -:loop2 -if y y0: exit -end -- diff --git a/src/class.lisp b/src/class.lisp --- a/src/class.lisp +++ b/src/class.lisp @@ -4,11 +4,13 @@ (defclass compiler () ((body :accessor body :initform #.(load-src "extras/body.html")) (css :accessor css :initform (list #.(load-src "extras/default.css"))) + (ast :accessor ast :initform nil) (js :accessor js :initform (reverse (list '#.(read-progn-from-string (load-src "src/main.ps")) '#.(read-progn-from-string (load-src "src/api.ps")) '#.(read-progn-from-string (load-src "src/intrinsics.ps"))))) + (parse :accessor parse-only :initarg :parse) (compile :accessor compile-only :initarg :compile) (target :accessor target :initarg :target) (beautify :accessor beautify :initarg :beautify))) diff --git a/src/main.lisp b/src/main.lisp --- a/src/main.lisp +++ b/src/main.lisp @@ -11,12 +11,15 @@ (let ((*package* (find-package :txt2web))) (catch :terminate (let ((compiler (apply #'make-instance 'compiler (parse-opts args)))) - (write-compiled-file compiler)))) + (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 :beautify nil))) + (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)) @@ -24,6 +27,7 @@ ("--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))) @@ -42,6 +46,7 @@ (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) @@ -113,9 +118,9 @@ (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 &allow-other-keys) +(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 (body css js) + (with-slots (ast body css js) compiler ;; Compile the game's JS (dolist (source sources) @@ -127,9 +132,10 @@ (report-error "Internal error!")) (push `(lib:game (,game-name) ,@locations) - js)))) + ast)))) + (setf js (append ast js)) ;; Does the user need us to do anything else - (unless compile + (unless (or parse compile) ;; Read in body (when body-file (setf body diff --git a/src/parser.lisp b/src/parser.lisp --- a/src/parser.lisp +++ b/src/parser.lisp @@ -127,7 +127,7 @@ ;;; Identifiers -(defparameter *keywords* '(act addlib addobj addqst and arrcomp arrpos arrsize cla clear *clear close clr *clr cls cmdclear cmdclr copyarr countobj curact curacts curloc debug delact dellib delobj desc disablescroll disablesubex dynamic dyneval else elseif end exit loop freelib func getobj gosub goto gs gt if iif img *img inclib input instr isnum isplay jump killall killobj killqst killvar lcase len let loc local maintxt max menu mid min mod msecscount msg nl *nl no nosave obj opengame openqst or p *p pl *pl play qspver rand refint replace rgb rnd savegame selact selobj set settimer showacts showinput showobjs showstat stattxt step str strcomp strfind strpos to trim ucase unsel unselect user_text usrtxt val view wait while xgoto xgt)) +(defparameter *keywords* '(act addlib addobj addqst and arrcomp arrpos arrsize cla clear *clear close clr *clr cls cmdclear cmdclr copyarr countobj curact curacts curloc debug delact dellib delobj desc disablescroll dynamic dyneval else elseif end exit loop freelib func getobj gosub goto gs gt if iif img *img inclib input instr isnum isplay jump killall killobj killqst killvar lcase len let loc local maintxt max menu mid min mod msecscount msg nl *nl no nosave obj opengame openqst or p *p pl *pl play qspver rand refint replace rgb rnd savegame selact selobj set settimer showacts showinput showobjs showstat stattxt step str strcomp strfind strpos to trim ucase unsel unselect user_text usrtxt val view wait while xgoto xgt)) (defun trim-$ (str) (if (char= #\$ (elt str 0)) @@ -593,7 +593,7 @@ (:function do-binop)) (p:defrule eq-expr (and sum-expr (* (and spaces? (or "<=" ">=" "=<" "=>" "<>" - "=" "<" ">" "!") + "=" "<" ">") spaces? sum-expr))) (:function do-binop)) diff --git a/src/ps-macros.lisp b/src/ps-macros.lisp --- a/src/ps-macros.lisp +++ b/src/ps-macros.lisp @@ -225,9 +225,6 @@ (defpsmacro <> (op1 op2) `(not (equal ,op1 ,op2))) -(defpsmacro ! (op1 op2) - `(not (equal ,op1 ,op2))) - (defpsmacro qspmod (&rest ops) (case (length ops) (1 (first ops))