common/point.ss
#lang scheme
(require "../utils.ss")
;;(require mzlib/struct)

(provide (struct-out point-2d)
         (struct-out point-3d)

         ;; Constructors
         xy xyz origin origin-2d

         ;; Selectors
         cx cy cz

         ;; Recognizers
         point? xy? xyz?

         point=
         ;; Operations
         +xy +xyz +x +y +z

         p-between)

(define (point= p1 p2)
  (cond [(and (point-3d? p1) (point-3d? p2))
         (and (= (cx p1) (cx p2))
              (= (cy p1) (cy p2))
              (= (cz p1) (cz p2)))]
        [(and (point-2d? p1) (point-2d? p2))
         (and (= (cx p1) (cx p2))
              (= (cy p1) (cy p2)))]
        [else (error "One of " p1 " or " p2 " is not a point!")]))

;; Point implementation.
;; Primitives to:
;; - Create
;; - Select components
;; - Recognize
;; - Test
;; ... points.

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

(define (xy x y)
  (assert (and (real? x) (real? y)))
  (make-point-2d x y))
(define (xyz x y z)
  (assert (and (real? x) (real? y) (real? z)))
  (make-point-3d x y z))

(define origin  (xyz 0 0 0))
(define origin-2d (xy 0 0))

;;;; Selectors
(define cx point-2d-x)
(define cy point-2d-y)
(define (cz p)
  (if (point-3d? p)
      (point-3d-z p)
      0))

;;;; Recognizers
(define (point? p)
  (or (point-2d? p)
      (point-3d? p)))

(define xy? point-2d?)
(define xyz? point-3d?)

;;;; Operations
(define (+xy p x y)
  (if (point-3d? p)
      (xyz (+ (cx p) x)
           (+ (cy p) y)
           (cz p))
      (struct-copy point-2d p
                   [x (+ (cx p) x)]
                   [y (+ (cy p) y)])))
(define (+xyz p x y z)
  ;; struct-copy doesn't work...
  (xyz (+ (cx p) x)
       (+ (cy p) y)
       (+ (cz p) z)))


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


(define (p-between a b)
  (define (avg a b)
    (/ (+ a b) 2))
  (case* a
    [point-3d?
     (assert (point-3d? b))
     (xyz (avg (cx a) (cx b))
          (avg (cy a) (cy b))
          (avg (cz a) (cz b)))]
    [point-2d?
     (assert (point-2d? b))
     (xy (avg (cx a) (cx b))
         (avg (cy a) (cy b)))]
    [else (error "" a " is not a point.")]))