# HG changeset patch # User naryl # Date 2020-08-10 23:54:43 # Node ID 517f9c140c85e0934ecd4679dd3c224bf98a994e # Parent 09309f46637b928e1677f5951318fb6dae6c5c5f txt->qsps, remove FOR and IMG, broken LOCAL and LOOP diff --git a/.hgignore b/.hgignore --- a/.hgignore +++ b/.hgignore @@ -1,9 +1,10 @@ .*~ +.*.txt .qlot .html .png .orig tests txt2web -txt2web.tar.xz +.*.tar.xz system-index.txt diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -1,9 +1,6 @@ -* Localization * Save-load game in slots -* CLI build for Windows - * Reporting error lines in the parser * Report duplicate label (in the parser) * reporting error lines at runtime (by storing them in every form in the parser diff --git a/examples/10dynamic.txt b/examples/10dynamic.qsps rename from examples/10dynamic.txt rename to examples/10dynamic.qsps diff --git a/examples/11main.txt b/examples/11main.qsps rename from examples/11main.txt rename to examples/11main.qsps diff --git a/examples/12aux.txt b/examples/12aux.qsps rename from examples/12aux.txt rename to examples/12aux.qsps diff --git a/examples/13diag.txt b/examples/13diag.qsps rename from examples/13diag.txt rename to examples/13diag.qsps diff --git a/examples/14act.txt b/examples/14act.qsps rename from examples/14act.txt rename to examples/14act.qsps diff --git a/examples/15objs.txt b/examples/15objs.qsps rename from examples/15objs.txt rename to examples/15objs.qsps diff --git a/examples/16menu.txt b/examples/16menu.qsps rename from examples/16menu.txt rename to examples/16menu.qsps diff --git a/examples/17sound.txt b/examples/17sound.qsps rename from examples/17sound.txt rename to examples/17sound.qsps diff --git a/examples/18img.txt b/examples/18img.qsps rename from examples/18img.txt rename to examples/18img.qsps --- a/examples/18img.txt +++ b/examples/18img.qsps @@ -11,16 +11,4 @@ USEHTML = 1 '' ! Выводим картинку в доп. описание PL '' - -!! РАСШИРЕНИЕ КОМПИЛЯТОРА (не используйте если хотитие переносимости на другие плееры) -! Выводим картинку в основное описание -*IMG 'content/room.jpg' -! Выводим две картинки рядом в дополнительное описание -IMG 'content/stat1.png' -IMG 'content/stat2.png' -! Т.е. картинки ведут себя как текст и переносы строк нужно вставлять явно - -! Несколько картинок располагаются в одном и том же месте в порядке перечисления. -! Используя прозрачность можно получить эффект наложения нескольких картинок слоями -IMG 'content/ragdoll.png', $equipment['body'], $equipment['head'] - diff --git a/examples/19input.txt b/examples/19input.qsps rename from examples/19input.txt rename to examples/19input.qsps diff --git a/examples/1loc.txt b/examples/1loc.qsps rename from examples/1loc.txt rename to examples/1loc.qsps diff --git a/examples/20time.txt b/examples/20time.qsps rename from examples/20time.txt rename to examples/20time.qsps diff --git a/examples/21locals.txt b/examples/21locals.qsps rename from examples/21locals.txt rename to examples/21locals.qsps diff --git a/examples/22for.txt b/examples/22loop.qsps rename from examples/22for.txt rename to examples/22loop.qsps --- a/examples/22for.txt +++ b/examples/22loop.qsps @@ -1,18 +1,18 @@ # for -FOR k1=0 TO 5: +LOOP k1=0 WHILE k1 < 5: *PL k1 IF k1=3: EXIT END -FOR номер_нпц = 1 TO количество_нпц: GS 'инициализировать нпц', номер_нпц +LOOP номер_нпц = 1 WHILE номер_нпц < количество_нпц: GS 'инициализировать нпц', номер_нпц стоимость['меч'] = 10 стоимость['доспех'] = 250 стоимость['щит'] = 15 стоимость_снаряжения = 0 -FOR номер_предмета = 0 TO ARRSIZE('стоимость')-1: стоимость_снаряжения += стоимость[номер_предмета] +LOOP номер_предмета = 0 WHILE номер_предмета < ARRSIZE('стоимость'): стоимость_снаряжения += стоимость[номер_предмета] -FOR i = 1 TO 10 STEP 2: *PL i +LOOP i = 1 WHILE i < 10 STEP i += 2: *PL i - diff --git a/examples/2var.txt b/examples/2var.qsps rename from examples/2var.txt rename to examples/2var.qsps diff --git a/examples/3expr.txt b/examples/3expr.qsps rename from examples/3expr.txt rename to examples/3expr.qsps diff --git a/examples/4code.txt b/examples/4code.qsps rename from examples/4code.txt rename to examples/4code.qsps diff --git a/examples/5arrays.txt b/examples/5arrays.qsps rename from examples/5arrays.txt rename to examples/5arrays.qsps diff --git a/examples/6str.txt b/examples/6str.qsps rename from examples/6str.txt rename to examples/6str.qsps diff --git a/examples/7if.txt b/examples/7if.qsps rename from examples/7if.txt rename to examples/7if.qsps diff --git a/examples/8sub.txt b/examples/8sub.qsps rename from examples/8sub.txt rename to examples/8sub.qsps diff --git a/examples/9999error.txt b/examples/9999error.qsps rename from examples/9999error.txt rename to examples/9999error.qsps diff --git a/examples/9jump.qsps b/examples/9jump.qsps new file mode 100644 --- /dev/null +++ b/examples/9jump.qsps @@ -0,0 +1,1134 @@ + +txt2web +
+
+
+
+ +
+
+
+
+
+
+ + +
+
+ +
+
+ +
+ +
+ + + \ No newline at end of file diff --git a/examples/9loops.txt b/examples/9loops.qsps rename from examples/9loops.txt rename to examples/9loops.qsps diff --git a/examples/bench.txt b/examples/bench.qsps rename from examples/bench.txt rename to examples/bench.qsps diff --git a/examples/txt2gam-game.txt b/examples/txt2gam-game.txt deleted file mode 100644 --- a/examples/txt2gam-game.txt +++ /dev/null @@ -1,100 +0,0 @@ - -# start -USEHTML=1 -BCOLOR = RGB(250, 250, 200) -'
Текстовый квест

' -' Ваша цель - зарабатывать деньги, покупать на них подарки и дарить своим близким.' -ACT 'Начать игру':GOTO 'Дом' -- - -#Работа -'
Порт

' -' Порт находится на самой южной окраине города. Здесь постоянно загружаются и разгружаются различные суда. Рабочих рук не хватает и складской бригадир всегда рад заплатить деньги за помощь.' -' У вас <<Деньги>> монет.' -' Вам нужно перенести <<3-Ящик>> ящика.' -ACT 'Идти домой':GOTO 'Дом' -ACT 'Идти в магазин':GOTO 'Магазин' -ACT 'Перенести ящик': - Ящик = Ящик + 1 - WAIT 500 - IF Ящик = 3: - Деньги = Деньги + 5 - Ящик = 0 - END - GOTO 'Работа' -END -- - -#Магазин -'
Магазин

' -' Магазин небольшой, но тут обычно есть всё, что нужно простому горожанину. Витрины заставлены различными товарами. У кассы стоит полная женщина и хмуро смотрит на вас.' -' У вас <<Деньги>> монет.' -IF Деньги >= 3: - ACT 'Купить конструктор': - Деньги = Деньги - 3 - ADDOBJ 'Конструктор' - GOTO 'Магазин' - END -END -IF Деньги >= 5: - ACT 'Купить плюшевого медведя': - Деньги = Деньги - 5 - ADDOBJ 'Плюшевый медведь' - GOTO 'Магазин' - END - ACT 'Купить вязальный набор': - Деньги = Деньги - 5 - ADDOBJ 'Вязальный набор' - GOTO 'Магазин' - END -END -IF Деньги >= 7: - ACT 'Купить инструменты': - Деньги = Деньги - 7 - ADDOBJ 'Инструменты' - GOTO 'Магазин' - END -END -ACT 'Идти домой':GOTO 'Дом' -ACT 'Идти в порт':GOTO 'Работа' -- - -#Дом -'
Дом

' -' Дома всегда очень уютно. И вкусно пахнет едой. Мама, сидя в кресле, вяжет носки. Отец с вашим братом чинит скворечник. Сестра хлопочет на кухне. Дома всегда хорошо.' -' У вас <<Деньги>> монет.' -IF OBJ 'Конструктор': - ACT 'Подарить конструктор брату': - DELOBJ 'Конструктор' - ' - Вот тебе конструктор.' - ' - Спасибо, брат.' - DELACT $SELACT - END -END -IF OBJ 'Плюшевый медведь': - ACT 'Подарить медведя сестре': - DELOBJ 'Плюшевый медведь' - ' - Вот тебе плюшевый медведь.' - ' - Спасибо, брат.' - DELACT $SELACT - END -END -IF OBJ 'Вязальный набор': - ACT 'Подарить набор маме': - DELOBJ 'Вязальный набор' - ' - Вот тебе вязальный набор.' - ' - Спасибо, сынок.' - DELACT $SELACT - END -END -IF OBJ 'Инструменты': - ACT 'Подарить инструменты отцу': - DELOBJ 'Инструменты' - ' - Вот тебе инструменты.' - ' - Спасибо, сын.' - DELACT $SELACT - END -END -ACT 'Идти в порт':GOTO 'Работа' -ACT 'Идти в магазин':GOTO 'Магазин' -- diff --git a/sandbox.qsps b/sandbox.qsps new file mode 100644 --- /dev/null +++ b/sandbox.qsps @@ -0,0 +1,3 @@ +# loc +LCOLOR = rgb(106,90,205) +- diff --git a/src/api.ps b/src/api.ps --- a/src/api.ps +++ b/src/api.ps @@ -209,14 +209,6 @@ (setf (getprop *acts title :selected) t) (call-serv-loc "$ONACTSEL")) -;;; "Syntax" - -(defun qspfor (name index from to step body) - (loop :for i :from from :to to :by step - :do (set-var name index :num i) - :do (unless (await (funcall body)) - (return-from qspfor)))) - ;;; Variables (defun new-var (slot &rest indexes) @@ -360,17 +352,6 @@ (setf (@ img src) "") (setf (@ img style display) "hidden"))))) -(defun show-inline-images (frame-name images) - (let ((frame (get-frame frame-name)) - (text "")) - (incf text "
") - (incf text (+ "")) - (loop :for image :in (chain images (slice 1)) - :do (incf text - (+ ""))) - (incf text "
") - (incf (inner-html frame) text))) - (defun rgb-string (rgb) (let ((red (ps::>> rgb 16)) (green (logand (ps::>> rgb 8) 255)) diff --git a/src/intrinsic-macros.lisp b/src/intrinsic-macros.lisp --- a/src/intrinsic-macros.lisp +++ b/src/intrinsic-macros.lisp @@ -136,12 +136,6 @@ (defpsmacro view (&optional path) `(api-call show-image ,path)) -(defpsmacro img (&rest images) - `(api-call show-inline-images :stat (list ,@images))) - -(defpsmacro *img (&rest images) - `(api-call show-inline-images :main (list ,@images))) - ;;; 19input (defpsmacro showinput (enable) diff --git a/src/main.lisp b/src/main.lisp --- a/src/main.lisp +++ b/src/main.lisp @@ -100,6 +100,7 @@ (flute:h (html (head + (meta :charset "utf-8") (title "txt2web")) (body body-template diff --git a/src/package.lisp b/src/package.lisp --- a/src/package.lisp +++ b/src/package.lisp @@ -52,7 +52,7 @@ (:use :cl :ps :txt2web.main :txt2web.js) (:local-nicknames (#:api :txt2web.api) (#:walker :code-walker)) - (:export #:str #:exec #:qspblock #:qspfor #:game #:location + (:export #:str #:exec #:qspblock #:qsploop #:game #:location #:qspcond #:qspvar #:set #:local #:jump #:killvar #:killall 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 for 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 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 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)) (defun trim-$ (str) (if (char= #\$ (elt str 0)) @@ -308,7 +308,7 @@ ;;; Blocks -(p:defrule block (or block-act block-if block-for)) +(p:defrule block (or block-act block-if block-loop)) (p:defrule block-if (and block-if-head block-if-body) (:destructure (head body) @@ -379,26 +379,30 @@ (:lambda (list) (or (third list) ""))) -(p:defrule block-for (and block-for-head (or block-ml block-sl)) +(p:defrule block-loop (and block-loop-head (or block-ml block-sl)) (:lambda (list) (apply #'append list))) -(p:defrule block-for-head (and (p:~ "for") spaces variable spaces? equal spaces? expression - (p:~ "to") spaces expression - block-for-head-step - colon spaces?) +(p:defrule block-loop-head (and (p:~ "loop") spaces + (p:? (and block-loop-head-init spaces?)) + block-loop-head-while spaces? + (p:? (and block-loop-head-step spaces?)) + colon spaces?) (:lambda (list) - (list 'lib:qspfor + (break "~S" list) + (list 'lib:qsploop (elt list 2) (elt list 6) (elt list 9) (elt list 10)))) -(p:defrule block-for-head-step (p:? (and (p:~ "step") spaces expression spaces?)) - (:lambda (list) - (if list - (third list) - 1))) +(p:defrule block-loop-head-init (or local plain-assignment)) + +(p:defrule block-loop-head-while (and (p:~ "while") eq-expr) + (:function second)) + +(p:defrule block-loop-head-step (and (p:~ "step") (or plain-assignment op-assignment)) + (:function second)) (p:defrule block-sl line-body) diff --git a/src/ps-macros.lisp b/src/ps-macros.lisp --- a/src/ps-macros.lisp +++ b/src/ps-macros.lisp @@ -259,7 +259,7 @@ ;;; 8sub -;;; 9loops +;;; 9jump ;;; Yep, that's a huge kludge since Javascript doesn't support arbitrary labels (defpsmacro jump (target) @@ -374,7 +374,15 @@ ;;; 21local -;;; 22for +;;; 22loop + +(defpsmacro qsploop (init cond step &body body) + `(progn + ,init + (loop :while ,cond + :do (progn + ,@body + ,step)))) ;; Transform because it creates a (set ...) hence it has to be processed ;; before the apply-vars transform. And macros are processed after all