api.ps
287 lines
| 8.5 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 | |||
r16 | (defm (root api stash-state) (args) | |||
r10 | (setf (root state-stash) | |||
r11 | (*j-s-o-n.stringify | |||
(ps:create vars (root vars) | ||||
objs (root objs) | ||||
r16 | 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) | ||||
r11 | next-location (root current-location)))) | |||
r10 | (values)) | |||
r6 | ||||
r16 | (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))) | ||||
r11 | (defm (root api state-to-base64) () | |||
(btoa (encode-u-r-i-component (root state-stash)))) | ||||
(defm (root api base64-to-state) (data) | ||||
r16 | (setf (root state-stash) (decode-u-r-i-component (atob data)))) | |||
r11 | ||||
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) | ||||
r16 | (if (var "USEHTML" 0 :num) | |||
r9 | (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) | ||||
r16 | (if (var "USEHTML" 0 :num) | |||
r9 | (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) | ||||
r16 | (if (var "USEHTML" 0 :num) | |||
r9 | (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)) | ||||
r16 | (let ((arg (elt args i))) | |||
(if (numberp arg) | ||||
(this.set-var args i :num arg) | ||||
(this.set-var args i :str arg))))) | ||||
r1 | ||||
(defm (root api get-result) () | ||||
r16 | (if (not (equal "" (var result 0 :str))) | |||
(var result 0 :str) | ||||
(var result 0 :num))) | ||||
r1 | ||||
;;; 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) | |||
r15 | (document.get-element-by-id (this.key-to-id key))) | |||
r11 | ||||
r6 | (defm (root api add-text) (key text) | |||
r15 | (this.append-id (this.key-to-id key) text)) | |||
r6 | ||||
(defm (root api get-text) (key) | ||||
r15 | (this.get-id (this.key-to-id key))) | |||
r6 | ||||
(defm (root api clear-text) (key) | ||||
r15 | (this.clear-id (this.key-to-id key))) | |||
r6 | ||||
(defm (root api newline) (key) | ||||
r15 | (let ((div (this.get-frame key))) | |||
r6 | (ps:chain div (append-child (document.create-element "br"))))) | |||
r1 | ||||
r11 | (defm (root api enable-frame) (key enable) | |||
r15 | (let ((clss (ps:getprop (this.get-frame key) 'class-list))) | |||
r11 | (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)) | |||
r15 | (this.update-acts)) | |||
r6 | ||||
(defm (root api del-act) (title) | ||||
(delete (ps:getprop (root acts) title)) | ||||
r15 | (this.update-acts)) | |||
r6 | ||||
(defm (root api clear-act) () | ||||
(setf (root acts) (ps:create)) | ||||
r15 | (this.clear-id "qsp-acts")) | |||
r6 | ||||
(defm (root api update-acts) () | ||||
r15 | (this.clear-id "qsp-acts") | |||
r6 | (ps:for-in (title (root acts)) | |||
(let ((obj (ps:getprop (root acts) title))) | ||||
r15 | (this.append-id "qsp-acts" | |||
(this.make-act-html title (ps:getprop obj :img)))))) | ||||
r1 | ||||
r16 | ;;; 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 "")) | ||||
r1 | ||||
r16 | (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 | ||||
r6 | ||||
(defm (root api var-real-name) (name) | ||||
(if (= (ps:@ name 0) #\$) | ||||
r16 | (values (ps:chain name (substr 1)) :str) | |||
(values name :num))) | ||||
r6 | ||||
r16 | (defm (root api ensure-var) (name) | |||
r15 | (let ((store (this.var-ref name))) | |||
r14 | (unless store | |||
r16 | (setf store (ps:new (this.-var name))) | |||
(setf (ps:getprop (root vars) name) store)) | ||||
store)) | ||||
r6 | ||||
r14 | (defm (root api var-ref) (name) | |||
r16 | (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)) | ||||
r14 | (t nil)))) | |||
r16 | (defm (root api get-var) (name index slot) | |||
(ps:chain (this.ensure-var name) (get index slot))) | ||||
r6 | ||||
r16 | (defm (root api set-var) (name index slot value) | |||
(ps:chain (this.ensure-var name) (set index slot value)) | ||||
(values)) | ||||
r6 | ||||
r14 | (defm (root api get-array) (name) | |||
r16 | (this.var-ref name)) | |||
r11 | ||||
r14 | (defm (root api set-array) (name value) | |||
r16 | (let ((store (this.var-ref name))) | |||
(setf (ps:@ store values) (ps:@ value values)) | ||||
(setf (ps:@ store indexes) (ps:@ value indexes))) | ||||
(values)) | ||||
r14 | ||||
(defm (root api kill-var) (name &optional index) | ||||
r16 | (if (and index (not (= 0 index))) | |||
(ps:chain (ps:getprop (root vars) name) (kill index)) | ||||
r14 | (ps:delete (ps:getprop (root vars) name))) | |||
r6 | (values)) | |||
r11 | (defm (root api array-size) (name) | |||
r16 | (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))) | ||||
r11 | ||||
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) | ||||
r15 | :do (incf elt.inner-h-t-m-l (this.make-menu-item-html i item.text item.icon item.loc))) | |||
r11 | (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))))) | ||||
r14 | ||||