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