#lang racket
(require "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)))))