(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>"))

;; To be used in saving game
(defm (root api stash-state) ()
  (setf (root state-stash)
        (ps:create vars (root vars)
                   objs (root objs)
                   next-location (root current-location)))
  (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")
    (t (report-error "Internal error!"))))

(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 (document.get-element-by-id
               (api-call key-to-id key))))
    (ps:chain div (append-child (document.create-element "br")))))

;;; Actions

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

(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 kill-var) (name index)
  (if (eq index :whole)
      (ps:delete (ps:getprop (root vars) name))
      (ps:delete (ps:getprop (root vars) name index)))
  (values))

;;; 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>")))