/examples/boids/pt-lib/source.scm

 1
 2;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 3
 4(define vector-nth      (curry/ba   vector-ref))
 5(define set-vector-nth! (curry/b:ac vector-set!))
 6
 7;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 8;; pt
 9;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10
11(define (pt a b) (vector 'pt a b))
12
13(define pt-x (vector-nth 1))
14(define pt-y (vector-nth 2))
15
16(define pt-x! (set-vector-nth! 1))
17(define pt-y! (set-vector-nth! 2))
18
19(define x (vector-nth 1))
20(define y (vector-nth 2))
21
22(define x! (set-vector-nth! 1))
23(define y! (set-vector-nth! 2))
24
25;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26
27(define binary-pt-procedure
28  (lambda (op)
29    (lambda (a b)
30      (pt (op (x a) (x b))
31          (op (y a) (y b))))))
32
33(define pt+ (binary-pt-procedure +))
34(define pt- (binary-pt-procedure -))
35(define pt* (binary-pt-procedure *))
36(define pt/ (binary-pt-procedure /))
37
38;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
39
40(define (pt-n-procedure op)
41  (lambda (a n)
42    (pt (op (x a) n)
43        (op (y a) n))))
44
45(define pt+n (pt-n-procedure +))
46(define pt-n (pt-n-procedure -))
47(define pt*n (pt-n-procedure *))
48(define pt/n (pt-n-procedure /))
49
50;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
51
52(define (pt-neg p)
53  (pt (- (x p)) (- (y p))))
54
55;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
56
57(define (norm p)
58  (sqrt (+ (sq (x p))
59           (sq (y p)))))
60
61;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
62
63(define (normalize p)
64  (pt/n p (norm p)))
65
66;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
67
68(define (dot a b)
69  (bi (pt* a b) x y +))
70