blob: b769572b272e70d4723ca4d4faaa8a2cb38ecf25 (
plain)
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
|
(library (strigoform math)
(export fmod
pi
pi/2
tau
do-circle
clamp
smoothstep
lerp
s32-ref
s32-set!
f64-ref
f64-set!
vec2
vec2?
vec2-x
vec2-y
set-vec2-x!
set-vec2-y!
vec2-add!
vec2-sub!
vec2-mul-scalar!
vec2-magnitude
vec2-normalize!
vec2-clamp!
make-rect
rect-x
rect-y
rect-w
rect-h
within?
rect-within?)
(import (scheme base)
(scheme inexact)
(only (hoot bytevectors)
bytevector-s32-native-ref
bytevector-s32-native-set!
bytevector-ieee-double-native-ref
bytevector-ieee-double-native-set!)
(strigoform type))
(define (assert-float x)
(unless (and (number? x) (inexact? x) (rational? x))
(error "expected inexact rational" x)))
(define (fmod x y)
(assert-float x)
(assert-float y)
(- x (* (truncate (/ x y)) y)))
(define pi (* 4.0 (atan 1.0)))
(define pi/2 (/ pi 2.0))
(define tau (* pi 2.0))
(define (do-circle proc k)
(do ((i 0 (+ i 1)))
((= i k))
(proc (* tau (inexact (/ i k))))))
(define (clamp x min max)
(cond ((< x min) min)
((> x max) max)
(else x)))
(define (smoothstep t)
(* t t (- 3.0 (* 2.0 t))))
(define (lerp start end alpha)
(+ (* start (- 1.0 alpha))
(* end alpha)))
(define s32-ref bytevector-s32-native-ref)
(define s32-set! bytevector-s32-native-set!)
(define f64-ref bytevector-ieee-double-native-ref)
(define f64-set! bytevector-ieee-double-native-set!)
(define-type vec2
make-vec2
vec2?
(bv vec2-bv set-vec2-bv!))
(define (vec2 x y)
(let ((v (make-vec2 (make-bytevector 16))))
(set-vec2-x! v x)
(set-vec2-y! v y)
v))
(define (vec2-x v)
(f64-ref (vec2-bv v) 0))
(define (vec2-y v)
(f64-ref (vec2-bv v) 8))
(define (set-vec2-x! v x)
(f64-set! (vec2-bv v) 0 x))
(define (set-vec2-y! v y)
(f64-set! (vec2-bv v) 8 y))
(define (vec2-add! v w)
(set-vec2-x! v (+ (vec2-x v) (vec2-x w)))
(set-vec2-y! v (+ (vec2-y v) (vec2-y w))))
(define (vec2-sub! v w)
(set-vec2-x! v (- (vec2-x v) (vec2-x w)))
(set-vec2-y! v (- (vec2-y v) (vec2-y w))))
(define (vec2-mul-scalar! v x)
(set-vec2-x! v (* (vec2-x v) x))
(set-vec2-y! v (* (vec2-y v) x)))
(define (vec2-magnitude v)
(sqrt (+ (* (vec2-x v) (vec2-x v)) (* (vec2-y v) (vec2-y v)))))
(define (vec2-normalize! v)
(unless (and (= (vec2-x v) 0.0) (= (vec2-y v) 0.0))
(let ((m (vec2-magnitude v)))
(set-vec2-x! v (/ (vec2-x v) m))
(set-vec2-y! v (/ (vec2-y v) m)))))
(define (vec2-clamp! v xmin ymin xmax ymax)
(set-vec2-x! v (clamp (vec2-x v) xmin xmax))
(set-vec2-y! v (clamp (vec2-y v) ymin ymax)))
(define (make-rect x y w h)
(let ((r (make-bytevector (* 8 4))))
(f64-set! r 0 x)
(f64-set! r 8 y)
(f64-set! r 16 w)
(f64-set! r 24 h)
r))
(define (rect-x r)
(f64-ref r 0))
(define (rect-y r)
(f64-ref r 8))
(define (rect-w r)
(f64-ref r 16))
(define (rect-h r)
(f64-ref r 24))
(define (within? x y rx ry rw rh)
(and (>= x rx)
(>= y ry)
(< x (+ rx rw))
(< y (+ ry rh))))
(define (rect-within? ax ay aw ah bx by bw bh)
(let ((ax* (+ ax aw))
(ay* (+ ay ah)))
(or (within? ax ay bx by bw bh)
(within? ax* ay bx by bw bh)
(within? ax* ay* bx by bw bh)
(within? ax ay* bx by bw bh)))))
|
