api.ps
150 lines
| 4.2 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>")) | ||||
r10 | ;; 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)) | ||||
r6 | ||||
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") | ||||
(t (report-error "Internal error!")))) | ||||
(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) | ||||
(let ((div (document.get-element-by-id | ||||
(api-call key-to-id key)))) | ||||
(ps:chain div (append-child (document.create-element "br"))))) | ||||
r1 | ||||
;;; Actions | ||||
r6 | (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)) | ||||
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))) | ||||
(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)) | |||
;;; 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>"))) | ||||