forked from psilord/option-9
-
Notifications
You must be signed in to change notification settings - Fork 0
/
utils.lisp
157 lines (130 loc) · 5.63 KB
/
utils.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
(in-package :option-9)
#+option-9-debug (declaim (optimize (safety 3) (space 0) (speed 0) (debug 3)))
(defun lerp (a b interp &key truncp)
"Perform a mathematically stable linear interpolation from A to B by INTERP.
The keyword argument TRUNCP indicates if the result should be TRUNCATed or not."
(let ((result (+ (* (- 1.0 interp) a) (* interp b))))
(if truncp (truncate result) result)))
(defmethod distance ((a frame) (b frame) &key (sqrt t))
(let ((ao (matrix-translate-get (world-basis a)))
(bo (matrix-translate-get (world-basis b))))
(vdist ao bo :sqrt sqrt)))
(defun random-sign ()
(if (zerop (random 2)) 1d0 -1d0))
(defun random-delta (&key (velocity .02d0))
(* (random velocity) (random-sign)))
(defun random-in-range (start end)
"Produce a random double-float in the range specified."
;; I wish I didn't have to have a branch here...
(let ((range (abs (- end start))))
(if (zerop range)
0d0
(+ start (random (coerce (abs (- end start)) 'double-float))))))
(defun clamp (val minimum maximum)
"Clamp VAL into the range MINIMUM and MAXIMUM."
(cond
((< val minimum)
minimum)
((> val maximum)
maximum)
(t
val)))
;; From LOL
(defun group (lst n)
(when (zerop n) (error "A zero group size is illegal"))
(labels ((rec (lst acc)
(let ((rst (nthcdr n lst)))
(if (consp rst)
(rec rst (cons (subseq lst 0 n)
acc))
(nreverse
(cons lst acc))))))
(if lst (rec lst nil) nil)))
;; Not all of this is used, it is here because it is the full
;; utility macro sketch of hash table utilities.
;; Help with making initialized hash tables.
(defun miht-set-key/value (key value ht)
`(setf (gethash ,key ,ht) ,value))
(defun miht-make-hash-table (&rest args)
(if (equal args '(nil))
`(make-hash-table)
`(make-hash-table ,@args)))
;; use like:
;; (make-initialized-hash-table (:test #'equal) :a 0 :b 1 :c 2 ....)
;; The init-forms or keys/values can be empty if desired.
(defmacro make-initialized-hash-table ((&rest init-form) &body keys/values)
(let ((h (gensym)))
`(let ((,h ,(apply #'miht-make-hash-table init-form)))
,@(mapcar #'(lambda (key/value)
(when (= (length key/value) 1)
(error "make-initalized-hash-table: Please supply a value for key ~S"
(car key/value)))
(destructuring-bind (key value) key/value
(miht-set-key/value key value h)))
(group keys/values 2))
,h)))
;; Shorter helper macros for more brevity
(defmacro miht ((&rest init-form) &body keys/values)
`(make-initialized-hash-table (,@init-form) ,@keys/values))
;; Really short macros for common cases.
(defmacro mihteq (&body keys/values)
`(make-initialized-hash-table (:test #'eq) ,@keys/values))
(defmacro mihteql (&body keys/values)
`(make-initialized-hash-table (:test #'eql) ,@keys/values))
(defmacro mihtequal (&body keys/values)
`(make-initialized-hash-table (:test #'equal) ,@keys/values))
(defmacro mihtequalp (&body keys/values)
`(make-initialized-hash-table (:test #'equalp) ,@keys/values))
;; TODO: This math utility needs a better home and memory optimization.
(defun dist-line-point (s e p)
"Find the shortest distance from point P to the infinite line
defined by the start point S to the end point E. S, E, P are all
pvectors which happen to be used as points."
;; See this page:
;; http://geomalgorithms.com/a02-_lines.html#Distance-to-Infinite-Line
;; This implements the d(P, L) equation.
(let* (;; Compute the vector l from the two points: l = e - s
(l (vsub e s))
;; Compute the vector w from the line starting from s and ending at p
(w (vsub p s))
;; Compute the cross product of l and w
(lw-cross (vcross l w))
;; Get the magnitude of lw-cross
(lw-cross-mag (vnorm lw-cross))
;; Then compute the magnitiude of l
(l-norm (vnorm l)))
;; Now, compute the distance and return it
(/ lw-cross-mag l-norm)))
;; single threaded cache of memory for the enclosed function to prevent
;; a lot of memory churn during the transform interpolation code.
(let ((q-from (pquat))
(q-to (pquat))
(q-inter (pquat))
(trans-from (pvec))
(trans-to (pvec))
(trans-inter (pvec)))
(defun interpolate-transform-matricies-into (mat-dst mat-from mat-to interp)
"Interpolate from MAT-FROM to MAT-TO by INTERP amont and store into MAT-DST.
Return MAT-DST. The interpolation happens via conversion to quaternions."
;; Compute the rotational interpolation
(quat-mtoq-into q-from mat-from)
(quat-mtoq-into q-to mat-to)
(quat-slerp-into q-inter q-from q-to interp)
;; Compute the translational interpolation.
(matrix-translate-get-into trans-from mat-from)
(matrix-translate-get-into trans-to mat-to)
(vect-interpolate-into trans-inter trans-from trans-to interp)
;; Now assemble everything into the interpolated matrix.
(quat-qtom-into mat-dst q-inter)
(matrix-translate-set-into mat-dst trans-inter)
mat-dst))
(defun interpolate-transform-matricies (mat-from mat-to interp)
(interpolate-transform-matricies-into (pmat) mat-from mat-to interp))
(defun get-monitor-refresh-rate ()
;; TODO: Put a config entry in here in case I need to specify it manually.
;; This isn't exactly right, since some LCD monitors use 59.95 and
;; SDL just truncates it to an integer.
(let ((val (nth-value 3 (sdl2:get-current-display-mode 0))))
(if (or (null val) (zerop val))
60d0
59.95d0 #++(float val 1d0))))