#lang scheme
(require "../utils.ss")
(provide (struct-out point-2d)
(struct-out point-3d)
xy xyz origin origin-2d
cx cy cz
point? xy? xyz?
point=
+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!")]))
(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))
(define cx point-2d-x)
(define cy point-2d-y)
(define (cz p)
(if (point-3d? p)
(point-3d-z p)
0))
(define (point? p)
(or (point-2d? p)
(point-3d? p)))
(define xy? point-2d?)
(define xyz? point-3d?)
(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)
(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.")]))