|
|
|
|
|
(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-id :qsp-main)
|
|
|
(api-call clear-id :qsp-stat)
|
|
|
(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)
|
|
|
(let ((store (api-call var-ref name)))
|
|
|
(unless store
|
|
|
(setf store (ps:create))
|
|
|
(setf (ps:getprop (root vars) name) store)))
|
|
|
(unless (in index store)
|
|
|
(setf (elt store index) (ps:create :num 0 :str "")))
|
|
|
(values))
|
|
|
|
|
|
(defm (root api var-ref) (name)
|
|
|
(let ((var-name (api-call var-real-name name))
|
|
|
(local-store (api-call current-local-frame)))
|
|
|
(cond ((in var-name local-store)
|
|
|
(ps:getprop local-store))
|
|
|
((in var-name (root vars))
|
|
|
(ps:getprop (root vars) var-name))
|
|
|
(t nil))))
|
|
|
|
|
|
(defm (root api get-var) (name index)
|
|
|
(let ((store (var-ref name)))
|
|
|
(if store
|
|
|
(if (in index store)
|
|
|
(ps:getprop store index (api-call var-slot name))
|
|
|
(report-error (+ "Non-existing index: " name "[" index "]")))
|
|
|
(report-error (+ "Unknown variable: " name)))))
|
|
|
|
|
|
(defm (root api set-var) (name index value)
|
|
|
(let ((store (var-ref name)))
|
|
|
(api-call ensure-var var-name index)
|
|
|
(setf (ps:getprop store index
|
|
|
(api-call var-slot name))
|
|
|
value)
|
|
|
(values)))
|
|
|
|
|
|
(defm (root api get-array) (name)
|
|
|
(ps:getprop (root vars) name))
|
|
|
|
|
|
(defm (root api set-array) (name value)
|
|
|
(setf (ps:getprop (root vars) name) value))
|
|
|
|
|
|
(defm (root api kill-var) (name &optional index)
|
|
|
(if index
|
|
|
(ps:delete (ps:getprop (root vars) name index))
|
|
|
(ps:delete (ps:getprop (root vars) name)))
|
|
|
(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")))
|
|
|
|
|
|
;;; Content
|
|
|
|
|
|
(defm (root api clean-audio) ()
|
|
|
(loop :for k :in (*object.keys (root playing))
|
|
|
:for v := (ps:getprop (root playing) k)
|
|
|
:do (when (ps:@ v ended)
|
|
|
(ps:delete (ps:@ (root playing) k)))))
|
|
|
|
|
|
;;; Locals
|
|
|
|
|
|
(defm (root api push-local-frame) ()
|
|
|
(ps:chain (root locals) (push (ps:create))))
|
|
|
|
|
|
(defm (root api pop-local-frame) ()
|
|
|
(ps:chain (root locals) (pop)))
|
|
|
|
|
|
(defm (root api current-local-frame) ()
|
|
|
(elt (root locals) (1- (length (root locals)))))
|
|
|
|
|
|
(defm (root api new-local) (name)
|
|
|
(let ((frame (api-call current-local-frame))
|
|
|
(var-name (api-call var-real-name name)))
|
|
|
(unless (in var-name frame)
|
|
|
(setf (ps:getprop frame var-name) (ps:create)))))
|
|
|
|
