#lang scheme
;; primitives.ss
;; Support for various geometric primitives
(require "csg.ss"
         "operations.ss"
         "point.ss"
         "vector.ss")

(require "../utils.ss")

(provide (except-out (struct-out primitive) make-primitive))

(define-struct primitive
  ()
  #:transparent)

(define-syntax define-primitive
  (syntax-rules ()
    [(_ name slot ...)
     (begin
       (provide (struct-out name))
       (define-struct (name primitive)
         (slot ...)
         #:transparent))]))

(define-primitive null)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; 2D shapes
(define-primitive circle
  center radius)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; 3D shapes
(define-primitive box
  center length width height)

(provide make-box*)
(define (make-box* from to)
  (let* ([v (p->q from to)]
         [origin (p+v from (v*r v 1/2))])
    (make-box origin (vx v) (vy v) (vz v))))


(define-primitive cone
  center base-radius cap)

;(define (make-cut-cone p1 r1 p2 r2)
;  (intersect (make-cone p1 r1 ... ...)
;             (make-box ... ... ... ...)))


(define-primitive cylinder
  center radius height)

(provide make-cylinder*)
(define (make-cylinder* p0 p1 radius)
  (assert (and (point-3d? p0) (point-3d? p1)))
  (let* ([p0p1   (vpp p0 p1)]
         [height (vlength p0p1)])
    (make-cylinder (p+v p0 (v*r p0p1 1/2))
                   radius
                   height)))

(define-primitive sphere
  center radius)

(define-primitive loft
  f start step stop?)

(define-primitive text
  string lower-left height)

(define-primitive torus
  center radius tube-radius)

(define-primitive wedge
  center length width height)