src/api.ps

(in-package sugar-qsp)

;;; API deals with DOM manipulation and some bookkeeping for the
;;; intrinsics, namely variables
;;; API is an implementation detail and has no QSP documentation. It
;;; doesn't call intrinsics

(setf (root api) (ps:create))

;;; Utils

(defm (root api make-act-html) (title img)
  (+ "<a class='qsp-act' href='#' onclick='SugarQSP.acts[\"" title "\"].act();'>"
     title
     "</a>"))

(defm (root api make-menu-item-html) (num title img loc)
  (+ "<a href='#' onclick='SugarQSP.api.runMenu(" num ", \"" loc "\")();'>"
     "<img src='" img "'>"
     title
     "</a>"))

;; To be used in saving game
(defm (root api stash-state) ()
  (setf (root state-stash)
        (*j-s-o-n.stringify
         (ps:create vars (root vars)
                    objs (root objs)
                    next-location (root current-location))))
  (values))

(defm (root api state-to-base64) ()
  (btoa (encode-u-r-i-component (root state-stash))))

(defm (root api base64-to-state) (data)
  (setf (root state-stash) (decode-u-r-i-component (atob data)))
  (let ((data (*j-s-o-n.parse (root state-stash))))
    (api-call clear-act)
    (setf (root vars) (ps:@ data vars))
    (setf (root objs) (ps:@ data objs))
    (setf (root current-location) (ps:@ data next-location))
    (funcall (root locs (root current-location)))
    (api-call update-objs)
    (values)))

;;; Misc

(defm (root api clear-id) (id)
  (setf (ps:chain document (get-element-by-id id) inner-text) ""))

(defm (root api get-id) (id)
  (if (var "USEHTML" 0)
      (ps:chain (document.get-element-by-id id) inner-h-t-m-l)
      (ps:chain (document.get-element-by-id id) inner-text)))

(defm (root api set-id) (id contents)
  (if (var "USEHTML" 0)
      (setf (ps:chain (document.get-element-by-id id) inner-h-t-m-l) contents)
      (setf (ps:chain (document.get-element-by-id id) inner-text) contents)))

(defm (root api append-id) (id contents)
  (if (var "USEHTML" 0)
      (incf (ps:chain (document.get-element-by-id id) inner-h-t-m-l) contents)
      (incf (ps:chain (document.get-element-by-id id) inner-text) contents)))

;;; Function calls

(defm (root api init-args) (args)
  (dotimes (i (length args))
    (if (numberp (elt args i))
        (set (var args i) (elt args i))
        (set (var $args i) (elt args i)))))

(defm (root api get-result) ()
  (if (not (equal "" (var $result 0)))
      (var $result 0)
      (var result 0)))

;;; Text windows

(defm (root api key-to-id) (key)
  (case key
    (:main "qsp-main")
    (:stat "qsp-stat")
    (:objs "qsp-objs")
    (:acts "qsp-acts")
    (:input "qsp-input")
    (:dropdown "qsp-dropdown")
    (t (report-error "Internal error!"))))

(defm (root api get-frame) (key)
  (document.get-element-by-id (api-call key-to-id key)))

(defm (root api add-text) (key text)
  (api-call append-id (api-call key-to-id key) text))

(defm (root api get-text) (key)
  (api-call get-id (api-call key-to-id key)))

(defm (root api clear-text) (key)
  (api-call clear-id (api-call key-to-id key)))

(defm (root api newline) (key)
  (let ((div (api-call get-frame key)))
    (ps:chain div (append-child (document.create-element "br")))))

(defm (root api enable-frame) (key enable)
  (let ((clss (ps:getprop (api-call get-frame key) 'class-list)))
    (setf clss.style.display (if enable "block" "none"))
    (values)))

;;; Actions

(defm (root api add-act) (title img act)
  (setf (ps:getprop (root acts) title)
        (ps:create :img img :act act))
  (api-call update-acts))

(defm (root api del-act) (title)
  (delete (ps:getprop (root acts) title))
  (api-call update-acts))

(defm (root api clear-act) ()
  (setf (root acts) (ps:create))
  (api-call clear-id "qsp-acts"))

(defm (root api update-acts) ()
  (api-call clear-id "qsp-acts")
  (ps:for-in (title (root acts))
    (let ((obj (ps:getprop (root acts) title)))
      (api-call append-id "qsp-acts"
                (api-call make-act-html title (ps:getprop obj :img))))))

;;; Variables

(defm (root api var-slot) (name)
  (if (= (ps:@ name 0) #\$)
      :str
      :num))

(defm (root api var-real-name) (name)
  (if (= (ps:@ name 0) #\$)
      (ps:chain name (substr 1))
      name))

(defm (root api ensure-var) (name index)
  (unless (in name (root vars))
    (setf (ps:getprop (root vars) name)
          (ps:create)))
  (unless (in index (ps:getprop (root vars) name))
    (setf (ps:getprop (root vars) name index)
          (ps:create :num 0 :str "")))
  (values))

(defm (root api get-var) (name index)
  (let ((var-name (api-call var-real-name name)))
    (api-call ensure-var var-name index)
    (ps:getprop (root vars) var-name index
                (api-call var-slot name))))

(defm (root api set-var) (name index value)
  (let ((var-name (api-call var-real-name name)))
    (api-call ensure-var var-name index)
    (setf (ps:getprop (root vars) var-name index
                      (api-call var-slot name))
          value)
    (values)))

(defm (root api get-array) (name type)
  (ps:getprop (root vars) (api-call var-real-name name)))

(defm (root api kill-var) (name index)
  (if (eq index :whole)
      (ps:delete (ps:getprop (root vars) name))
      (ps:delete (ps:getprop (root vars) name index)))
  (values))

(defm (root api array-size) (name)
  (ps:getprop (root vars) (api-call var-real-name name) 'length))

;;; Objects

(defm (root api update-objs) ()
  (let ((elt (document.get-element-by-id "qsp-objs")))
    (setf elt.inner-h-t-m-l "<ul>")
    (loop :for obj :in (root objs)
       :do (incf elt.inner-h-t-m-l (+ "<li>" obj)))
    (incf elt.inner-h-t-m-l "</ul>")))

;;; Menu

(defm (root api menu) (menu-data)
  (let ((elt (document.get-element-by-id "qsp-dropdown"))
        (i 0))
    (setf elt.inner-h-t-m-l "")
    (loop :for item :in menu-data
       :do (incf i)
       :do (incf elt.inner-h-t-m-l (api-call make-menu-item-html i item.text item.icon item.loc)))
    (setf elt.style.display "block")))