Commit | Line | Data |
---|---|---|
97eb9b75 | 1 | (in-package :parenscript) |
3eb7802d VS |
2 | |
3 | ;;; Handy utilities for doing common tasks found in many web browser | |
4 | ;;; JavaScript implementations | |
5 | ||
4a987e2b | 6 | (defpsmacro do-set-timeout ((timeout) &body body) |
3eb7802d VS |
7 | `(set-timeout (lambda () ,@body) ,timeout)) |
8 | ||
9 | ;;; Arithmetic | |
10 | ||
11 | (defmacro def-js-maths (&rest mathdefs) | |
4a987e2b | 12 | `(progn ,@(mapcar (lambda (def) (cons 'defpsmacro def)) mathdefs))) |
3eb7802d VS |
13 | |
14 | (def-js-maths | |
3eb7802d | 15 | (max (&rest nums) `(*math.max ,@nums)) |
9b89687a TC |
16 | (min (&rest nums) `(*math.min ,@nums)) |
17 | (floor (n &optional divisor) `(*math.floor ,(if divisor `(/ ,n ,divisor) n))) | |
31ad390e | 18 | (ceiling (n &optional divisor) `(*math.ceil ,(if divisor `(/ ,n ,divisor) n))) |
9b89687a | 19 | (round (n &optional divisor) `(*math.round ,(if divisor `(/ ,n ,divisor) n))) |
3eb7802d VS |
20 | (sin (n) `(*math.sin ,n)) |
21 | (cos (n) `(*math.cos ,n)) | |
22 | (tan (n) `(*math.tan ,n)) | |
3eb7802d | 23 | (asin (n) `(*math.asin ,n)) |
9b89687a | 24 | (acos (n) `(*math.acos ,n)) |
e7ae4979 | 25 | (atan (y &optional x) (if x `(*math.atan2 ,y ,x) `(*math.atan ,y))) |
a1abb4e4 TC |
26 | (sinh (n) `((lambda (x) (return (/ (- (exp x) (exp (- x))) 2))) ,n)) |
27 | (cosh (n) `((lambda (x) (return (/ (+ (exp x) (exp (- x))) 2))) ,n)) | |
28 | (tanh (n) `((lambda (x) (return (/ (- (exp x) (exp (- x))) (+ (exp x) (exp (- x)))))) ,n)) | |
29 | (asinh (n) `((lambda (x) (return (log (+ x (sqrt (1+ (* x x))))))) ,n)) | |
30 | (acosh (n) `((lambda (x) (return (* 2 (log (+ (sqrt (/ (1+ x) 2)) (sqrt (/ (1- x) 2))))))) ,n)) | |
31 | (atanh (n) `((lambda (x) (return (/ (- (log (+ 1 x)) (log (- 1 x))) 2))) ,n)) | |
8b9d8bc7 TC |
32 | (1+ (n) `(+ ,n 1)) |
33 | (1- (n) `(- ,n 1)) | |
9b89687a TC |
34 | (abs (n) `(*math.abs ,n)) |
35 | (evenp (n) `(not (oddp ,n))) | |
36 | (oddp (n) `(% ,n 2)) | |
3eb7802d | 37 | (exp (n) `(*math.exp ,n)) |
9b89687a | 38 | (expt (base power) `(*math.pow ,base ,power)) |
9a2c0f23 TC |
39 | (log (n &optional base) |
40 | (or (and (null base) `(*math.log ,n)) | |
41 | (and (numberp base) (= base 10) `(* (log ,n) *math.*log10e*)) | |
42 | `(/ (log ,n) (log ,base)))) | |
a7b7afae | 43 | (sqrt (n) `(*math.sqrt ,n)) |
3eb7802d VS |
44 | (random (&optional upto) (if upto |
45 | `(floor (* ,upto (*math.random))) | |
9b89687a | 46 | '(*math.random)))) |
854b1c7e | 47 | |
5288d666 | 48 | (define-ps-symbol-macro pi *math.*pi*) |
11fd716c | 49 | |
854b1c7e VS |
50 | ;;; Exception handling |
51 | ||
4a987e2b | 52 | (defpsmacro ignore-errors (&body body) |
854b1c7e | 53 | `(try (progn ,@body) (:catch (e)))) |
2e51aff5 | 54 | |
c72e87d8 VS |
55 | ;;; Data structures |
56 | ||
06ed0d3a VS |
57 | (defpsmacro [] (&rest args) |
58 | `(array ,@(mapcar (lambda (arg) | |
59 | (if (and (consp arg) (not (equal '[] (car arg)))) | |
60 | (cons '[] arg) | |
61 | arg)) | |
62 | args))) | |
63 | ||
c72e87d8 | 64 | (defpsmacro length (a) |
3366794f | 65 | `(@ ,a length)) |
c72e87d8 | 66 | |
2e51aff5 VS |
67 | ;;; Misc |
68 | ||
69 | (defpsmacro null (x) | |
70 | `(= ,x nil)) | |
c72e87d8 VS |
71 | |
72 | (defpsmacro @ (obj &rest props) | |
73 | "Handy slot-value/aref composition macro." | |
7ac25d0d VS |
74 | (if props |
75 | `(@ (slot-value ,obj ,(if (symbolp (car props)) `',(car props) (car props))) ,@(cdr props)) | |
76 | obj)) | |
d5c9059a VS |
77 | |
78 | (defpsmacro concatenate (result-type &rest sequences) | |
79 | (assert (equal result-type ''string) () "Right now Parenscript 'concatenate' only support strings.") | |
80 | (cons '+ sequences)) | |
1937c30a VS |
81 | |
82 | (defmacro concat-string (&rest things) | |
bb8ba95a | 83 | "Like concatenate but prints all of its arguments." |
1937c30a VS |
84 | `(format nil "~@{~A~}" ,@things)) |
85 | ||
86 | (defpsmacro concat-string (&rest things) | |
87 | (cons '+ things)) | |
88 | ||
ce44c98c VS |
89 | (defpsmacro elt (array index) |
90 | `(aref ,array ,index)) | |
f61db7bb DG |
91 | |
92 | (defpsmacro with-lambda (() &body body) | |
93 | "Wraps BODY in a lambda so that it can be treated as an expression." | |
94 | `((lambda () ,@body))) |