api.ps
210 lines
| 6.1 KiB
| application/postscript
|
PostScriptLexer
/ src / api.ps
r1 | ||||
(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)) | ||||
r6 | ;;; Utils | |||
(defm (root api make-act-html) (title img) | ||||
(+ "<a class='qsp-act' href='#' onclick='SugarQSP.acts[\"" title "\"].act();'>" | ||||
title | ||||
"</a>")) | ||||
r11 | (defm (root api make-menu-item-html) (num title img loc) | |||
(+ "<a href='#' onclick='SugarQSP.api.runMenu(" num ", \"" loc "\")();'>" | ||||
"<img src='" img "'>" | ||||
title | ||||
"</a>")) | ||||
r10 | ;; To be used in saving game | |||
(defm (root api stash-state) () | ||||
(setf (root state-stash) | ||||
r11 | (*j-s-o-n.stringify | |||
(ps:create vars (root vars) | ||||
objs (root objs) | ||||
next-location (root current-location)))) | ||||
r10 | (values)) | |||
r6 | ||||
r11 | (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)))) | ||||
r12 | (api-call clear-id :qsp-main) | |||
(api-call clear-id :qsp-stat) | ||||
r11 | (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))) | ||||
r9 | ;;; 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))) | ||||
r1 | ;;; 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 | ||||
r6 | (defm (root api key-to-id) (key) | |||
(case key | ||||
(:main "qsp-main") | ||||
(:stat "qsp-stat") | ||||
r11 | (:objs "qsp-objs") | |||
(:acts "qsp-acts") | ||||
(:input "qsp-input") | ||||
(:dropdown "qsp-dropdown") | ||||
r6 | (t (report-error "Internal error!")))) | |||
r11 | (defm (root api get-frame) (key) | |||
(document.get-element-by-id (api-call key-to-id key))) | ||||
r6 | (defm (root api add-text) (key text) | |||
r9 | (api-call append-id (api-call key-to-id key) text)) | |||
r6 | ||||
(defm (root api get-text) (key) | ||||
r9 | (api-call get-id (api-call key-to-id key))) | |||
r6 | ||||
(defm (root api clear-text) (key) | ||||
r9 | (api-call clear-id (api-call key-to-id key))) | |||
r6 | ||||
(defm (root api newline) (key) | ||||
r11 | (let ((div (api-call get-frame key))) | |||
r6 | (ps:chain div (append-child (document.create-element "br"))))) | |||
r1 | ||||
r11 | (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))) | ||||
r1 | ;;; Actions | |||
r6 | (defm (root api add-act) (title img act) | |||
(setf (ps:getprop (root acts) title) | ||||
r11 | (ps:create :img img :act act)) | |||
(api-call update-acts)) | ||||
r6 | ||||
(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)) | ||||
r9 | (api-call clear-id "qsp-acts")) | |||
r6 | ||||
(defm (root api update-acts) () | ||||
r9 | (api-call clear-id "qsp-acts") | |||
r6 | (ps:for-in (title (root acts)) | |||
(let ((obj (ps:getprop (root acts) title))) | ||||
r9 | (api-call append-id "qsp-acts" | |||
(api-call make-act-html title (ps:getprop obj :img)))))) | ||||
r1 | ||||
;;; Variables | ||||
r6 | (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))) | ||||
r11 | (defm (root api get-array) (name type) | |||
(ps:getprop (root vars) (api-call var-real-name name))) | ||||
r6 | (defm (root api kill-var) (name index) | |||
(if (eq index :whole) | ||||
r9 | (ps:delete (ps:getprop (root vars) name)) | |||
(ps:delete (ps:getprop (root vars) name index))) | ||||
r6 | (values)) | |||
r11 | (defm (root api array-size) (name) | |||
(ps:getprop (root vars) (api-call var-real-name name) 'length)) | ||||
r6 | ;;; 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>"))) | ||||
r11 | ||||
;;; 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"))) | ||||
r12 | ||||
;;; 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))))) | ||||