basket/basket/vec.scm

(define-module (basket vec)
               #:use-module (srfi srfi-1)
               #:use-module (basket))

(export
  pi tau
  vec?
  vec-x vec-y make-vec
  vec-add vec-sub
  vec-dot
  vec-mult vec-div
  lerp vec-lerp vec-midpoint
  vec-magnitude
  vec-distance
  vec-normalize
  vec-rotate)

(define pi 3.141592654)
(define tau (* 2 pi))

(define vec-x car)
(define vec-y cdr)
(define make-vec cons)

(define (vec? v)
  (and
    (pair? v)
    (number? (car v))
    (number? (cdr v))))

(define (vec-add . vs)
  "Adds any amount of vectors."
  (fold
    (lambda (a b) (make-vec (+ (vec-x a) (vec-x b))
                            (+ (vec-y a) (vec-y b))))
    '(0 . 0)
    vs))

(define (vec-sub . vs)
  "Subtracts any amount of vectors."
  (cond ((null? vs) '(0 . 0))
        ((= (length vs) 1) (vec-mult (car vs) -1))
        (else
          (fold
            (lambda (b a) (make-vec (- (vec-x a) (vec-x b))
                                    (- (vec-y a) (vec-y b))))
            (car vs)
            (cdr vs)))))

(define (vec-mult a n)
  "Multiplies a vector by a scalar."
  (make-vec (* (vec-x a) n) (* (vec-y a) n)))

(define (vec-div a n)
  "Divides a vector by a scalar."
  (vec-mult a (/ 1 n)))

(define (vec-dot a b)
  "Returns the dot product of two vectors."
  (+ (* (vec-x a) (vec-x b)) (* (vec-y a) (vec-y b))))

(define (lerp a b t)
  "Linearly interpolates between two numbers."
  (+ (* a (- 1 t)) (* b t)))

(define (vec-lerp a b t)
  "Linearly interpolates between two vectors."
  (vec-add (vec-mult a (- 1 t)) (vec-mult b t)))

(define (vec-midpoint a b)
  "Returns the midpoint of two vectors."
  (vec-lerp a b 0.5))

(define (vec-magnitude a)
  "Returns the magnitude of a vector."
  (sqrt (+ (* (vec-x a) (vec-x a)) (* (vec-y a) (vec-y a)))))

(define (vec-distance a b)
  "Returns the distance between two vectors."
  (vec-magnitude (vec-sub a b)))

(define (vec-normalize a)
  "Normalizes (sets the magnitude to 1) of a vector."
  (if (= (vec-magnitude a) 0)
    a
    (vec-div a (vec-magnitude a))))

(define (vec-rotate a t)
  "Rotates a vector by an angle."
  (make-vec
    (- (* (vec-x a) (cos t)) (* (vec-y a) (sin t)))
    (+ (* (vec-x a) (sin t)) (* (vec-y a) (cos t)))))