# HG changeset patch # User # Date 2020-03-29 20:29:00 # Node ID fac4b25bf4ae2283d0592bbe77a477626cefa38f # Parent 7e7dc5dd84c26fb9c87f8ee45006730294642037 IMG and *IMG diff --git a/.hgignore b/.hgignore --- a/.hgignore +++ b/.hgignore @@ -1,4 +1,5 @@ .*~ .qlot .html +.png tests diff --git a/examples/18img.txt b/examples/18img.txt --- a/examples/18img.txt +++ b/examples/18img.txt @@ -11,4 +11,16 @@ 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/src/api.ps b/src/api.ps --- a/src/api.ps +++ b/src/api.ps @@ -411,6 +411,17 @@ (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 @@ -140,6 +140,12 @@ (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/intrinsics.ps b/src/intrinsics.ps --- a/src/intrinsics.ps +++ b/src/intrinsics.ps @@ -265,7 +265,7 @@ (defun refint () ;; "Force interface update" Uh... what exactly do we do here? - (api:report-error "REFINT is not supported") + ;(api:report-error "REFINT is not supported") ) ;;; 19input diff --git a/src/parser.lisp b/src/parser.lisp --- a/src/parser.lisp +++ b/src/parser.lisp @@ -3,6 +3,9 @@ ;;;; Parses TXT source to an intermediate representation +(eval-when (:compile-toplevel :load-toplevel :execute) + (defparameter *max-args* 10)) + ;;; Utility (defun remove-nth (list nth) @@ -107,7 +110,7 @@ ;;; Identifiers -(defparameter *keywords* '(act addlib addobj addqst and arrcomp arrpos arrsize cla clear *clear close clr *clr cls cmdclear cmdclr copyarr counter countobj 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 inclib input instr isnum isplay jump killall killobj killqst killvar lcase lcolor 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 usercom 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 counter countobj 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 lcolor 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 usercom user_text usrtxt val view wait xgoto xgt)) (defun trim-$ (str) (if (char= #\$ (elt str 0)) @@ -415,8 +418,10 @@ clauses)))) (p:defrule ,rule-name (or ,returning-rule-name ,non-returning-rule-name)))) -(defmacro defintrinsic (sym returning &optional (min-arity 0) (max-arity 10) &rest names) +(defmacro defintrinsic (sym returning &optional (min-arity 0) max-arity &rest names) (declare (ignore returning)) + (unless max-arity + (setf max-arity *max-args*)) (setf names (if names (mapcar #'string-upcase names) @@ -433,8 +438,8 @@ (defintrinsics (intrinsic returning-intrinsic non-returning-intrinsic) ;; Transitions - (goto% nil 0 10 "gt" "goto") - (xgoto% nil 0 10 "xgt" "xgoto") + (goto% nil 0 nil "gt" "goto") + (xgoto% nil 0 nil "xgt" "xgoto") ;; Variables (killvar nil 0 2) ;; Expressions @@ -446,8 +451,8 @@ (curloc t 0 0) (rand t 1 2) (rnd t 0 0) - (qspmax t 1 10 "max") - (qspmin t 1 10 "min") + (qspmax t 1 nil "max") + (qspmin t 1 nil "min") ;; Arrays (killall nil 0 0) (copyarr nil 2 4) @@ -471,14 +476,14 @@ ;; IF (iif t 2 3) ;; Subs - (gosub nil 1 10 "gosub" "gs") - (func t 1 10) + (gosub nil 1 nil "gosub" "gs") + (func t 1 nil) (exit nil 0 0) ;; Jump (jump nil 1 1) ;; Dynamic - (dynamic nil 1 10) - (dyneval t 1 10) + (dynamic nil 1 nil) + (dyneval t 1 nil) ;; Sound (play nil 1 2) (isplay t 1 1) @@ -512,12 +517,14 @@ (delobj nil 1 1 "delobj" "del obj") (killobj nil 0 1) (countobj t 0 0) - (getobj t 1 1) + (getobj t 1 1) ;; Menu (menu nil 1 1) ;; Images (refint nil 0 0) (view nil 0 1) + (img nil 1) + (*img nil 1) ;; Fonts (rgb t 3 3) ;; Input