base/bounding-box.rkt
#lang racket


(require ;"box.rkt"
         "coord.rkt")

(provide
 make-bbox
 bbox-zero
 (prefix-out
  bbox-
  (combine-out min-x max-x half-x
               min-y max-y half-y
               min-z max-z half-z
               center
               x-neg
               x-pos
               y-neg
               y-pos
               z-pos
               z-neg
               corner
               
               width
               length
               height
               
               inflate
               
               center<-left
               center<-right
               center<-front
               center<-back
               center<-top
               center<-bottom))
 list<-bbox
 vector<-bbox)


(define (bbox-print bb port mode)
  (write-string "bbox" port)
  (write-string (format "~A" (bbox-coords bb)) port))

(define-struct bbox
  (coords)
  #:omit-define-syntaxes
  #:property prop:custom-write bbox-print)

(define bbox-zero
  (make-bbox (make-list 8 u0)))

(define (filter-coordinate bb coord-fn fn)
  (apply fn (map coord-fn (bbox-coords bb))))

(define (half-coordinate bb coord)
  (let ((min (filter-coordinate bb coord min))
        (max (filter-coordinate bb coord max)))
    (/ (+ min max) 2)))


(define (min-x bb)
  (filter-coordinate bb xyz-x min))

(define (max-x bb)
  (filter-coordinate bb xyz-x max))

(define (half-x bb)
  (half-coordinate bb xyz-x))

(define (min-y bb)
  (filter-coordinate bb xyz-y min))

(define (max-y bb)
  (filter-coordinate bb xyz-y max))

(define (half-y bb)
  (half-coordinate bb xyz-y))

(define (min-z bb)
  (filter-coordinate bb xyz-z min))

(define (max-z bb)
  (filter-coordinate bb xyz-z max))

(define (half-z bb)
  (half-coordinate bb xyz-z))


(define (center bb)
  (xyz
   (half-x bb)
   (half-y bb)
   (half-z bb)))

(define (x-neg bb)
  (xyz
   (min-x bb)
   (half-y bb)
   (half-z bb)))

(define (x-pos bb)
  (xyz
   (max-x bb)
   (half-y bb)
   (half-z bb)))

(define (y-neg bb)
  (xyz
   (half-x bb)
   (min-y bb)
   (half-z bb)))

(define (y-pos bb)
  (xyz
   (half-x bb)
   (max-y bb)
   (half-z bb)))

(define (z-neg bb)
  (xyz
   (half-x bb)
   (half-y bb)
   (min-z bb)))

(define (z-pos bb)
  (xyz
   (half-x bb)
   (half-y bb)
   (max-z bb)))

(define (corner bb x-fn y-fn z-fn)
  (xyz
   (xyz-x (x-fn bb))
   (xyz-y (y-fn bb))
   (xyz-z (z-fn bb))))


(define (width bb)
  (abs (- (min-x bb) (max-x bb))))

(define (length bb)
  (abs (- (min-y bb) (max-y bb))))

(define (height bb)
  (abs (- (min-z bb) (max-z bb))))


(define (inflate bb p)
  (make-bbox
   (box-corners
    (center bb)
    (+ (width bb) (xyz-x p))
    (+ (length bb) (xyz-y p))
    (+ (height bb) (xyz-z p)))))


(define (center<-left bb p)
  (+c p (-c (center bb) (x-neg bb))))

(define (center<-right bb p)
  (+c p (-c (center bb) (x-pos bb))))

(define (center<-front bb p)
  (+c p (-c (center bb) (y-neg bb))))

(define (center<-back bb p)
  (+c p (-c (center bb) (y-pos bb))))

(define (center<-top bb p)
  (+c p (-c (center bb) (z-pos bb))))

(define (center<-bottom bb p)
  (+c p (-c (center bb) (z-neg bb))))


(define list<-bbox bbox-coords)
(define (vector<-bbox bb) (list->vector (bbox-coords bb)))


(provide box-corners
         box-corners-pp)


(define (box-corners p width length height)
  (let ((width (/ width 2))
        (length (/ length 2))
        (height (/ height 2)))
    (list
     (+xyz p (- width) length (- height))
     (+xyz p (- width) (- length) (- height))
     (+xyz p width (- length) (- height))
     (+xyz p width length (- height))
     (+xyz p (- width) length height)
     (+xyz p (- width) (- length) height)
     (+xyz p width (- length) height)
     (+xyz p width length height))))

(define (midcoord c1 c2)
  (/c (+c c1 c2) 2))

(define (box-corners-pp min-p max-p)
  (let ((d (-c max-p min-p)))
    (box-corners (midcoord min-p max-p) (abs (xyz-x d)) (abs (xyz-y d)) (abs (xyz-z d)))))