Bugfixes, remaining font stuff

examples/txt2gam-game.txt

@@ -1,6 +1,7 b''
 
 # start
 USEHTML=1
+BCOLOR = RGB(255, 255, 255)
 '<center><font size="20" color="#FF0000" face="Times New Roman"><b>Текстовый квест</b></font></center><br>'
 '   <b>Ваша цель</b> - зарабатывать <i>деньги</i>, покупать на них <i>подарки</i> и дарить своим <i>близким</i>.'
 ACT '<b>Начать игру</b>':GOTO 'Дом'

extras/default.css

@@ -130,3 +130,7 b''
   pointer-events: none;
   cursor: default;
 }
+
+.qsp-objs li.qsp-obj-selected {
+    background-color: blue;
+}

src/api-macros.lisp

@@ -18,7 +18,7 b''
   `(+ "javascript:" (inline-call ,func ,@args)))
 
 (defpsmacro inline-call (func &rest args)
-  `(+ ,func
+  `(+ ',func
       "(\""
       ,(first args)
       ,@(loop :for arg :in (cdr args)
@@ -35,11 +35,9 b''
                                  (resolve)))))
            ,@body))))
 
-(defvar serv-vars (create))
-
 (defpsmacro define-serv-var (name (slot value &optional index) &body body)
   (setf name (string-upcase (symbol-name name)))
-  `(setf (getprop serv-vars name)
+  `(setf (getprop serv-vars ,name)
          (create :name ,name
                  :slot ,slot
                  :body (lambda (,value ,@(when index (list index)))

src/api.ps

@@ -21,11 +21,10 b''
      "</a>"))
 
 (defun make-obj (title img selected)
-  (+ "<li>"
-     "<a href='" (href-call select-obj title img) "'"
-        "class='qsp-obj" (if selected " qsp-obj-selected" "") "'>"
+  (+ "<li onclick='" (inline-call select-obj title img) "'>"
+     "<a class='qsp-obj" (if selected " qsp-obj-selected" "") "'>"
      (if img (+ "<img src='" img "'>") "")
-     obj
+     title
      "</a>"))
 
 (defun make-menu-delimiter ()
@@ -55,6 +54,7 b''
   ;; Close image on click
   (setf (@ (by-id "qsp-image-container") onclick)
         show-image)
+  ;; Enter in input field
   (setf (@ (get-frame :input) onkeyup)
         on-input-key)
   ;; Close the dropdown on any click
@@ -196,7 +196,7 b''
 
 (defun select-act (title)
   (loop :for (k v) :of (root acts)
-       (setf (getprop v :selected) nil))
+     :do (setf (getprop v :selected) nil))
   (setf (getprop (root acts) title :selected) t)
   (call-serv-loc "ONACTSEL"))
 
@@ -290,7 +290,7 b''
   (chain (ensure-var name) (set index slot value))
   (let ((serv-var (getprop serv-vars name)))
     (when serv-var
-      (funcall (@ serv-var :func)
+      (funcall (@ serv-var :body)
                (get-var name index (@ serv-var :slot))
                index)))
   (void))
@@ -339,16 +339,16 b''
 
 (defun select-obj (title img)
   (loop :for (k v) :of (root objs)
-       (setf (getprop v :selected) nil))
+     :do (setf (getprop v :selected) nil))
   (setf (getprop (root objs) title :selected) t)
   (call-serv-loc "ONOBJSEL" title img))
 
 (defun update-objs ()
   (let ((elt (by-id "qsp-objs")))
     (setf (inner-html elt) "<ul>")
-    (loop :for obj :in (root objs)
+    (loop :for (name obj) :of (root objs)
        :do (incf (inner-html elt)
-                 (make-obj obj)))
+                 (make-obj name (@ obj :img) (@ obj :selected))))
     (incf (inner-html elt) "</ul>")))
 
 ;;; Menu
@@ -412,9 +412,9 b''
            (setf (@ img style display) "hidden")))))
 
 (defun rgb-string (rgb)
-  (let ((red (rgb >> 16))
-        (green (& (rgb >> 8) 255))
-        (blue (& rgb 255)))
+  (let ((red (ps::>> rgb 16))
+        (green (logand (ps::>> rgb 8) 255))
+        (blue (logand rgb 255)))
     (flet ((rgb-to-hex (comp)
              (let ((hex (chain (*number comp) (to-string 16))))
                (if (< (length hex) 2)
@@ -514,6 +514,8 b''
 
 ;;; Special variables
 
+(defvar serv-vars (create))
+
 (define-serv-var backimage (:str path)
   (setf (@ (get-frame :main) style background-image) path))
 
@@ -526,3 +528,9 b''
 (define-serv-var lcolor (:num color)
   (setf (@ (get-frame :style) inner-text)
         (+ "a { color: " (rgb-string color) ";}")))
+
+(define-serv-var fsize (:num size)
+  (setf (@ (get-frame :all) style font-size) size))
+
+(define-serv-var fname (:str font-name)
+  (setf (@ (get-frame :all) style font-family) (+ font-name ",serif")))

src/intrinsic-macros.lisp

@@ -17,10 +17,10 b''
 ;;; 3expr
 
 (defpsmacro obj (name)
-  `(funcall (root objs includes) ,name))
+  `(in ,name (root objs)))
 
 (defpsmacro loc (name)
-  `(funcall (root locs includes) ,name))
+  `(in ,name (root locs)))
 
 (defpsmacro no (arg)
   `(- -1 ,arg))

src/js-syms.lisp

@@ -18,7 +18,7 b''
  keys includes
  has-own-property
  ;; api
- document get-element-by-id
+ document get-element-by-id get-elements-by-tag-name
  onclick onchange
  atob btoa split
  alert prompt

src/patches.lisp

@@ -67,3 +67,8 b''
       nil
       (funcall *old-return-result-of* tag form)))
 (export 'void)
+
+;;; Bitwise stuff
+;; No idea why these are not exported
+(export '<<)
+(export '>>)