IMG and *IMG

.hgignore

@@ -1,4 +1,5 b''
 .*~
 .qlot
 .html
+.png
 tests

examples/18img.txt

@@ -11,4 +11,16 b' USEHTML = 1'
 '<img src="content/room.jpg">'
 ! Выводим картинку в доп. описание
 PL '<img src="content/map.jpg">'
+
+!! РАСШИРЕНИЕ КОМПИЛЯТОРА (не используйте если хотитие переносимости на другие плееры)
+! Выводим картинку в основное описание
+*IMG 'content/room.jpg'
+! Выводим две картинки рядом в дополнительное описание
+IMG 'content/stat1.png'
+IMG 'content/stat2.png'
+! Т.е. картинки ведут себя как текст и переносы строк нужно вставлять явно
+
+! Несколько картинок располагаются в одном и том же месте в порядке перечисления.
+! Используя прозрачность можно получить эффект наложения нескольких картинок слоями
+IMG 'content/ragdoll.png', $equipment['body'], $equipment['head']
 -

src/api.ps

@@ -411,6 +411,17 b''
            (setf (@ img src) "")
            (setf (@ img style display) "hidden")))))
 
+(defun show-inline-images (frame-name images)
+  (let ((frame (get-frame frame-name))
+        (text ""))
+    (incf text "<div style='position:relative; display: inline-block'>")
+    (incf text (+ "<img src='" (@ images 0) "'>"))
+    (loop :for image :in (chain images (slice 1))
+       :do (incf text
+                 (+ "<img style='position:absolute' src='" image "'>")))
+    (incf text "</div>")
+    (incf (inner-html frame) text)))
+
 (defun rgb-string (rgb)
   (let ((red (ps::>> rgb 16))
         (green (logand (ps::>> rgb 8) 255))

src/intrinsic-macros.lisp

@@ -140,6 +140,12 b''
 (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)

src/intrinsics.ps

@@ -265,7 +265,7 b''
 
 (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

src/parser.lisp

@@ -3,6 +3,9 b''
 
 ;;;; 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 b''
 
 ;;; 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 b''
                                                         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 b''
 
 (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 b''
   (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 b''
   ;; 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)
@@ -518,6 +523,8 b''
   ;; Images
   (refint   nil 0 0)
   (view     nil 0 1)
+  (img      nil 1)
+  (*img     nil 1)
   ;; Fonts
   (rgb      t   3 3)
   ;; Input