#lang scheme
;; vector.ss
;; (Geometric) vector-related operations

(require "../utils.ss")
(require "point.ss")

(provide (except-out (struct-out vector-2d) make-vector-2d)
         (except-out (struct-out vector-3d) make-vector-3d)

         ;; Constructors: From coordinates, a point and two points
         vxy vxyz vp vpp

         ;; Accessors
         vx vy vz

         ;; Recognizers
         gvector? vxy? vxyz?

         ;; Operations
         v+xy v+xyz v+x v+y v+z

         p+v p->q v*r vlength

         cross-product v-colinear v-angle dot-product

         same-dimension? to-point-2d)

;; Constructors
(define-struct vector-2d (x y)
  #:transparent)
(define-struct (vector-3d vector-2d) (z)
  #:transparent)

(define (vxy x y)
  (make-vector-2d x y))

(define (vxyz x y z)
  (make-vector-3d x y z))

(define (vp p)
  (case* p
    [point-3d? (vxyz (cx p)
                    (cy p)
                    (cz p))]
    [point-2d? (vxy (cx p)
                   (cy p))]
    [else
     (error
      "Trying to create a vector from something other than a point")]))

(define (vpp p0 p1)
  (p->q p0 p1))


;; Selectors
(define vx vector-2d-x)
(define vy vector-2d-y)
(define vz vector-3d-z)

;; Recognizers
(define (gvector? v)
  (or (vector-2d? v)
      (vector-3d? v)))

(define vxy? vector-2d?)
(define vxyz? vector-3d?)

;; Operations
(define (v+xy v x y)
  (struct-copy vector-2d v
               [x (+ (vx v) x)]
               [y (+ (vy v) y)]))

;; struct-copy doesn't work...
(define (v+xyz v x y z)
  (vxyz (+ (vx v) x)
        (+ (vy v) y)
        (+ (vz v) z)))

(define (v+x v x)
  (case* v
    [vector-2d? (v+xy v x 0)]
    [vector-3d? (v+xyz v x 0 0)]
    [else (error "" v " is not a vector.")]))
(define (v+y v y)
  (case* v
    [vector-2d? (v+xy v 0 y)]
    [vector-3d? (v+xyz v 0 y 0)]
    [else (error "" v " is not a vector.")]))
(define (v+z v z)
  (case* v
    [vector-3d? (v+xyz v 0 0 z)]
    [else (error "" v " is not a 3D vector.")]))


;; Point operations which return vectors
(define (p+v p v)
  (case* p
    [point-3d? (assert (vector-3d? v))
               (+xyz p (vx v) (vy v) (vz v))]
    [point-2d? (assert (vector-2d? v))
               (+xy p (vx v) (vy v))]
    [else (error "" p " is not a point or " v " is not a vector.")]))

(define (p->q p q)
  (case* q
    [point-3d? (assert (point-3d? p))
               (vxyz (- (cx q) (cx p))
                     (- (cy q) (cy p))
                     (- (cz q) (cz p)))]
    [point-2d? (assert (point-2d? p))
               (vxy (- (cx q) (cx p))
                    (- (cy q) (cy p)))]
    [else (error "Can't calculate distance-vector between "
                 q " and " p ".")]))

(define (v*r v r)
  (case* v
    [vector-3d? (vxyz (* (vx v) r)
                      (* (vy v) r)
                      (* (vz v) r))]
    [vector-2d? (vxy (* (vx v) r)
                     (* (vy v) r))]
    [else (error "" v " is not a vector.")]))

(define (vlength v)
  (case* v
    [vector-3d?
     (sqrt (+ (* (vx v) (vx v))
              (* (vy v) (vy v))
              (* (vz v) (vz v))))]
    [vector-2d?
     (sqrt (+ (* (vx v) (vx v))
              (* (vy v) (vy v))))]
    [else (error "" v " is not a vector.")]))

(define (cross-product a b)
  (vxyz (- (* (vy a) (vz b)) (* (vz a) (vy b)))
        (- (* (vz a) (vx b)) (* (vx a) (vz b)))
        (- (* (vx a) (vy b)) (* (vy a) (vx b)))))

(define (v-colinear a b)
  (cond [(and (zero? (vx b)) (zero? (vy b)))
         (and (zero? (vx a)) (zero? (vy a)))]
        [(and (zero? (vx b)) (zero? (vz b)))
         (and (zero? (vx a)) (zero? (vz a)))]
        [(and (zero? (vz b)) (zero? (vy b)))
         (and (zero? (vz a)) (zero? (vy a)))]
        [(zero? (vx b))
         (and (zero? (vx a))
              (= (/ (vy a) (vy b))
                 (/ (vz a) (vz b))))]
        [(zero? (vy b))
         (and (zero? (vy a))
              (= (/ (vx a) (vx b))
                 (/ (vz a) (vz b))))]
        [(zero? (vz b))
         (and (zero? (vz a))
              (= (/ (vy a) (vy b))
                 (/ (vx a) (vx b))))]
        [else (= (/ (vx a) (vx b))
                 (/ (vy a) (vy b))
                 (/ (vz a) (vz b)))]))

(define (same-dimension? arg1 arg2)
  (if (gvector? arg1)
      (or (and (vector-3d? arg1) (vector-3d? arg2))
          (and (vector-2d? arg1) (vector-2d? arg2))
          (same-dimension? arg2 arg1))
      (or (and (point-3d? arg1) (point-3d? arg2))
          (and (point-3d? arg1) (vector-3d? arg2))
          (and (point-2d? arg1) (point-2d? arg2))
          (and (point-2d? arg1) (vector-2d? arg2)))))

(define (dot-product v1 v2)
  (if (vector-3d? v1)
      (+ (* (vx v1) (vx v2))
         (* (vy v1) (vy v2))
         (* (vz v1) (vz v2)))
      (+ (* (vx v1) (vx v2))
         (* (vy v1) (vy v2)))))

(define (v-angle v1 v2)
  (acos (/ (dot-product v1 v2) (* (vlength v1) (vlength v2)))))

(define (to-point-2d p)
  (cond [(point-3d? p)
         (xy (cx p) (cy p))]
        [(point-2d? p)
         p]
        [(vector-2d? p) ;; Works for 2D and 3D vectors
         (xy (vx p) (vy p))]
        [else (error "Can't convert " p " to a 2D point.")]))