intrinsic-macros.lisp
180 lines
| 3.1 KiB
| text/x-common-lisp
|
CommonLispLexer
/ src / intrinsic-macros.lisp
r11 | ||||
r49 | (in-package txt2web.lib) | |||
r11 | ||||
;;;; Macros implementing some intrinsics where it makes sense | ||||
;;;; E.g. an equivalent JS function exists, or it's a direct API call | ||||
;;; 1loc | ||||
;;; 2var | ||||
r64 | (defpsmacro killvar (&optional varname index) | |||
r30 | `(api-call kill-var ,varname ,index)) | |||
r11 | ||||
r25 | (defpsmacro killall () | |||
r64 | `(progn | |||
(killvar) | ||||
(killobj))) | ||||
r11 | ||||
;;; 3expr | ||||
r25 | (defpsmacro no (arg) | |||
r11 | `(- -1 ,arg)) | |||
;;; 4code | ||||
r25 | (defpsmacro qspver () | |||
r11 | "0.0.1") | |||
r25 | (defpsmacro curloc () | |||
r40 | `*current-location) | |||
r11 | ||||
r25 | (defpsmacro rnd () | |||
`(funcall rand 1 1000)) | ||||
r11 | ||||
r25 | (defpsmacro qspmax (&rest args) | |||
r13 | (if (= 1 (length args)) | |||
`(*math.max.apply nil ,@args) | ||||
`(*math.max ,@args))) | ||||
r11 | ||||
r25 | (defpsmacro qspmin (&rest args) | |||
r13 | (if (= 1 (length args)) | |||
`(*math.min.apply nil ,@args) | ||||
`(*math.min ,@args))) | ||||
r11 | ||||
;;; 5arrays | ||||
r25 | (defpsmacro arrsize (name) | |||
r11 | `(api-call array-size ,name)) | |||
;;; 6str | ||||
r25 | (defpsmacro len (s) | |||
r11 | `(length ,s)) | |||
r25 | (defpsmacro mid (s from &optional count) | |||
`(chain ,s (substring ,from ,count))) | ||||
r11 | ||||
r25 | (defpsmacro ucase (s) | |||
`(chain ,s (to-upper-case))) | ||||
r11 | ||||
r25 | (defpsmacro lcase (s) | |||
`(chain ,s (to-lower-case))) | ||||
r11 | ||||
r25 | (defpsmacro trim (s) | |||
`(chain ,s (trim))) | ||||
r11 | ||||
r51 | (defpsmacro qspreplace (s from to) | |||
r25 | `(chain ,s (replace ,from ,to))) | |||
r11 | ||||
r25 | (defpsmacro val (s) | |||
r11 | `(parse-int ,s 10)) | |||
r25 | (defpsmacro qspstr (n) | |||
`(chain ,n (to-string))) | ||||
r11 | ||||
;;; 7if | ||||
;;; 8sub | ||||
;;; 9loops | ||||
;; JUMP is in ps-macros.lisp (because it's a part of a huge kludge) | ||||
r25 | (defpsmacro exit () | |||
r11 | `(return-from nil (values))) | |||
;;; 10dynamic | ||||
r64 | (defpsmacro dynamic (block &rest args) | |||
`(progn | ||||
(when (stringp ,block) | ||||
(api:report-error "DYNAMIC can't evaluate arbitrary strings.\\nUse {braces} to create blocks for DYNAMIC.")) | ||||
r65 | (api:with-call-args ,args nil | |||
(funcall ,block)))) | ||||
r64 | ||||
(defpsmacro dyneval (block &rest args) | ||||
`(progn | ||||
r65 | (when (stringp ,block) | |||
r64 | (api:report-error "DYNEVAL can't evaluate arbitrary strings.\\nUse {braces} to create blocks for DYNEVAL.")) | |||
r65 | (api:with-call-args ,args t | |||
(funcall ,block)))) | ||||
r64 | ||||
r11 | ;;; 11main | |||
r25 | (defpsmacro desc (s) | |||
r11 | (declare (ignore s)) | |||
"") | ||||
;;; 12stat | ||||
r25 | (defpsmacro showstat (enable) | |||
r11 | `(api-call enable-frame :stat ,enable)) | |||
;;; 13diag | ||||
r25 | (defpsmacro msg (text) | |||
r11 | `(alert ,text)) | |||
;;; 14act | ||||
r25 | (defpsmacro showacts (enable) | |||
r11 | `(api-call enable-frame :acts ,enable)) | |||
r40 | (defpsmacro delact (&optional name) | |||
r41 | (if name | |||
`(api-call del-act ,name) | ||||
`(api-call del-act))) | ||||
r11 | ||||
r25 | (defpsmacro cla () | |||
r11 | `(api-call clear-act)) | |||
;;; 15objs | ||||
r25 | (defpsmacro showobjs (enable) | |||
r11 | `(api-call enable-frame :objs ,enable)) | |||
r25 | (defpsmacro countobj () | |||
r40 | `(length *objs)) | |||
r11 | ||||
r25 | (defpsmacro getobj (index) | |||
r40 | `(or (elt *objs ,index) "")) | |||
r11 | ||||
;;; 16menu | ||||
;;; 17sound | ||||
r25 | (defpsmacro isplay (filename) | |||
r39 | `(funcall (@ playing includes) ,filename)) | |||
r12 | ||||
r11 | ;;; 18img | |||
r25 | (defpsmacro view (&optional path) | |||
r18 | `(api-call show-image ,path)) | |||
r11 | ;;; 19input | |||
r25 | (defpsmacro showinput (enable) | |||
r20 | `(api-call enable-frame :input ,enable)) | |||
r11 | ;;; 20time | |||
r25 | (defpsmacro wait (msec) | |||
r24 | `(await (api-call sleep ,msec))) | |||
r25 | (defpsmacro settimer (interval) | |||
r20 | `(api-call set-timer ,interval)) | |||
r14 | ;;; 21local | |||
r18 | ;;; 22for | |||
;;; misc | ||||
r25 | (defpsmacro opengame (&optional filename) | |||
r18 | (declare (ignore filename)) | |||
`(api-call opengame)) | ||||
r25 | (defpsmacro savegame (&optional filename) | |||
r18 | (declare (ignore filename)) | |||
`(api-call savegame)) | ||||