|
|
|
|
|
(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>"))
|
|
|
|
|
|
(defm (root api init-dom) ()
|
|
|
;; Save/load buttons
|
|
|
(let ((btn (document.get-element-by-id "qsp-btn-save")))
|
|
|
(setf (ps:@ btn onclick) this.savegame)
|
|
|
(setf (ps:@ btn href) "#"))
|
|
|
(let ((btn (document.get-element-by-id "qsp-btn-open")))
|
|
|
(setf (ps:@ btn onclick) this.opengame)
|
|
|
(setf (ps:@ btn href) "#"))
|
|
|
;; Close image on click
|
|
|
(setf (ps:@ (document.get-element-by-id "qsp-image-container") onclick)
|
|
|
(this.show-image nil))
|
|
|
;; Close the dropdown on any click
|
|
|
(setf window.onclick
|
|
|
(lambda (event)
|
|
|
(setf (ps:@ (api-call get-frame :dropdown) style display) "none"))))
|
|
|
|
|
|
;; To be used in saving game
|
|
|
(defm (root api stash-state) (args)
|
|
|
(setf (root state-stash)
|
|
|
(*j-s-o-n.stringify
|
|
|
(ps:create vars (root vars)
|
|
|
objs (root objs)
|
|
|
loc-args args
|
|
|
main-html (ps:@
|
|
|
(document.get-element-by-id :qsp-main)
|
|
|
inner-h-t-m-l)
|
|
|
stat-html (ps:@
|
|
|
(document.get-element-by-id :qsp-stat)
|
|
|
inner-h-t-m-l)
|
|
|
next-location (root current-location))))
|
|
|
(values))
|
|
|
|
|
|
(defm (root api unstash-state) ()
|
|
|
(let ((data (*j-s-o-n.parse (root state-stash))))
|
|
|
(this.clear-act)
|
|
|
(setf (root vars) (ps:@ data vars))
|
|
|
(loop :for k :in (*object.keys (root vars))
|
|
|
:do (*object.set-prototype-of (ps:getprop (root vars) k)
|
|
|
(root api *var prototype)))
|
|
|
(setf (root objs) (ps:@ data objs))
|
|
|
(setf (root current-location) (ps:@ data next-location))
|
|
|
(setf (ps:@ (document.get-element-by-id :qsp-main) inner-h-t-m-l)
|
|
|
(ps:@ data main-html))
|
|
|
(setf (ps:@ (document.get-element-by-id :qsp-stat) inner-h-t-m-l)
|
|
|
(ps:@ data stat-html))
|
|
|
(funcall (root locs (root current-location)) (ps:@ data loc-args))
|
|
|
(this.update-objs)
|
|
|
(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))))
|
|
|
|
|
|
;;; 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 :num)
|
|
|
(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 :num)
|
|
|
(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 :num)
|
|
|
(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))
|
|
|
(let ((arg (elt args i)))
|
|
|
(if (numberp arg)
|
|
|
(this.set-var args i :num arg)
|
|
|
(this.set-var args i :str arg)))))
|
|
|
|
|
|
(defm (root api get-result) ()
|
|
|
(if (not (equal "" (var result 0 :str)))
|
|
|
(var result 0 :str)
|
|
|
(var result 0 :num)))
|
|
|
|
|
|
;;; 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 (this.key-to-id key)))
|
|
|
|
|
|
(defm (root api add-text) (key text)
|
|
|
(this.append-id (this.key-to-id key) text))
|
|
|
|
|
|
(defm (root api get-text) (key)
|
|
|
(this.get-id (this.key-to-id key)))
|
|
|
|
|
|
(defm (root api clear-text) (key)
|
|
|
(this.clear-id (this.key-to-id key)))
|
|
|
|
|
|
(defm (root api newline) (key)
|
|
|
(let ((div (this.get-frame key)))
|
|
|
(ps:chain div (append-child (document.create-element "br")))))
|
|
|
|
|
|
(defm (root api enable-frame) (key enable)
|
|
|
(let ((clss (ps:getprop (this.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))
|
|
|
(this.update-acts))
|
|
|
|
|
|
(defm (root api del-act) (title)
|
|
|
(delete (ps:getprop (root acts) title))
|
|
|
(this.update-acts))
|
|
|
|
|
|
(defm (root api clear-act) ()
|
|
|
(setf (root acts) (ps:create))
|
|
|
(this.clear-id "qsp-acts"))
|
|
|
|
|
|
(defm (root api update-acts) ()
|
|
|
(this.clear-id "qsp-acts")
|
|
|
(ps:for-in (title (root acts))
|
|
|
(let ((obj (ps:getprop (root acts) title)))
|
|
|
(this.append-id "qsp-acts"
|
|
|
(this.make-act-html title (ps:getprop obj :img))))))
|
|
|
|
|
|
;;; Variable class
|
|
|
|
|
|
(defm (root api *var) (name)
|
|
|
;; From strings to numbers
|
|
|
(setf this.indexes (ps:create))
|
|
|
;; From numbers to {num: 0, str: ""} objects
|
|
|
(setf this.values (list))
|
|
|
(values))
|
|
|
|
|
|
(defm (root api *var prototype new-value) ()
|
|
|
(ps:create :num 0 :str ""))
|
|
|
|
|
|
(defm (root api *var prototype index-num) (index)
|
|
|
(let ((num-index
|
|
|
(if (stringp index)
|
|
|
(if (in index this.indexes)
|
|
|
(ps:getprop this.indexes index)
|
|
|
(let ((n (length this.values)))
|
|
|
(setf (ps:getprop this.indexes index) n)
|
|
|
n))
|
|
|
index)))
|
|
|
(unless (in num-index this.values)
|
|
|
(setf (elt this.values num-index) (this.new-value)))
|
|
|
num-index))
|
|
|
|
|
|
(defm (root api *var prototype get) (index slot)
|
|
|
(unless (or index (= 0 index))
|
|
|
(setf index (1- (length this.values))))
|
|
|
(ps:getprop this.values (this.index-num index) slot))
|
|
|
|
|
|
(defm (root api *var prototype set) (index slot value)
|
|
|
(unless (or index (= 0 index))
|
|
|
(setf index (length store)))
|
|
|
(case slot
|
|
|
(:num (setf value (ps:chain *number (parse-int value))))
|
|
|
(:str (setf value (ps:chain value (to-string)))))
|
|
|
(setf (ps:getprop this.values (this.index-num index) slot) value)
|
|
|
(values))
|
|
|
|
|
|
(defm (root api *var prototype kill) (index)
|
|
|
(setf (elt this.values (this.index-num index)) (this.new-value)))
|
|
|
|
|
|
;;; Variables
|
|
|
|
|
|
(defm (root api var-real-name) (name)
|
|
|
(if (= (ps:@ name 0) #\$)
|
|
|
(values (ps:chain name (substr 1)) :str)
|
|
|
(values name :num)))
|
|
|
|
|
|
(defm (root api ensure-var) (name)
|
|
|
(let ((store (this.var-ref name)))
|
|
|
(unless store
|
|
|
(setf store (ps:new (this.-var name)))
|
|
|
(setf (ps:getprop (root vars) name) store))
|
|
|
store))
|
|
|
|
|
|
(defm (root api var-ref) (name)
|
|
|
(let ((local-store (this.current-local-frame)))
|
|
|
(cond ((in name local-store)
|
|
|
(ps:getprop local-store name))
|
|
|
((in name (root vars))
|
|
|
(ps:getprop (root vars) name))
|
|
|
(t nil))))
|
|
|
|
|
|
(defm (root api get-var) (name index slot)
|
|
|
(ps:chain (this.ensure-var name) (get index slot)))
|
|
|
|
|
|
(defm (root api set-var) (name index slot value)
|
|
|
(ps:chain (this.ensure-var name) (set index slot value))
|
|
|
(values))
|
|
|
|
|
|
(defm (root api get-array) (name)
|
|
|
(this.var-ref name))
|
|
|
|
|
|
(defm (root api set-array) (name value)
|
|
|
(let ((store (this.var-ref name)))
|
|
|
(setf (ps:@ store values) (ps:@ value values))
|
|
|
(setf (ps:@ store indexes) (ps:@ value indexes)))
|
|
|
(values))
|
|
|
|
|
|
(defm (root api kill-var) (name &optional index)
|
|
|
(if (and index (not (= 0 index)))
|
|
|
(ps:chain (ps:getprop (root vars) name) (kill index))
|
|
|
(ps:delete (ps:getprop (root vars) name)))
|
|
|
(values))
|
|
|
|
|
|
(defm (root api array-size) (name)
|
|
|
(ps:getprop (this.var-ref name) 'length))
|
|
|
|
|
|
;;; Locals
|
|
|
|
|
|
(defm (root api push-local-frame) ()
|
|
|
(ps:chain (root locals) (push (ps:create)))
|
|
|
(values))
|
|
|
|
|
|
(defm (root api pop-local-frame) ()
|
|
|
(ps:chain (root locals) (pop))
|
|
|
(values))
|
|
|
|
|
|
(defm (root api current-local-frame) ()
|
|
|
(elt (root locals) (1- (length (root locals)))))
|
|
|
|
|
|
(defm (root api new-local) (name)
|
|
|
(let ((frame (this.current-local-frame)))
|
|
|
(unless (in name frame)
|
|
|
(setf (ps:getprop frame name) (ps:create)))
|
|
|
(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>")))
|
|
|
|
|
|
;;; 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 (this.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)))))
|
|
|
|
|
|
(defm (root api show-image) (path)
|
|
|
(let ((img (document.get-element-by-id "qsp-image")))
|
|
|
(cond (path
|
|
|
(setf img.src path)
|
|
|
(setf img.style.display "flex"))
|
|
|
(t
|
|
|
(setf img.src "")
|
|
|
(setf img.style.display "hidden")))))
|
|
|
|
|
|
;;; Saves
|
|
|
|
|
|
(defm (root api opengame) ()
|
|
|
(let ((element (document.create-element :input)))
|
|
|
(element.set-attribute :type :file)
|
|
|
(element.set-attribute :id :qsp-opengame)
|
|
|
(element.set-attribute :tabindex -1)
|
|
|
(element.set-attribute "aria-hidden" t)
|
|
|
(setf element.style.display :block)
|
|
|
(setf element.style.visibility :hidden)
|
|
|
(setf element.style.position :fixed)
|
|
|
(setf element.onchange
|
|
|
(lambda (event)
|
|
|
(let* ((file (elt event.target.files 0))
|
|
|
(reader (ps:new (*file-reader))))
|
|
|
(setf reader.onload
|
|
|
(lambda (ev)
|
|
|
(block nil
|
|
|
(let ((target ev.current-target))
|
|
|
(unless target.result
|
|
|
(return))
|
|
|
(api-call base64-to-state target.result)
|
|
|
(api-call unstash-state)))))
|
|
|
(reader.read-as-text file))))
|
|
|
(document.body.append-child element)
|
|
|
(element.click)
|
|
|
(document.body.remove-child element)))
|
|
|
|
|
|
(defm (root api savegame) ()
|
|
|
(let ((element (document.create-element :a)))
|
|
|
(element.set-attribute :href (+ "data:text/plain;charset=utf-8," (api-call state-to-base64)))
|
|
|
(element.set-attribute :download "savegame.sav")
|
|
|
(setf element.style.display :none)
|
|
|
(document.body.append-child element)
|
|
|
(element.click)
|
|
|
(document.body.remove-child element)))
|
|
|
|