A proposal for structuring ImplicitCAD's primitives

implicitcad-proposal.hs

class HasBox a box | a -> box where
    getBox :: a -> box

class HasImplicit a obj | a -> obj where
    getImplicit :: a -> obj 
      
type Obj2 = (Double,Double) -> Double
type Obj3 = (Double,Double) -> Double

data ImplicitObj obj = forall a. HasImplicit a obj => ImplicitObj a

data Circle = Circle Double
instance HasBox Circle R2 where
    getBox (Circle r) = ((-r,-r), (r,r))
instance HasImplicit Circle Obj2 where
    getImplicit (Circle r) =  \(x,y) -> sqrt (x**2 + y**2) - r

data Sphere = Sphere Double
instance HasBox Sphere R3 where
    getBox (Sphere r) = ((-r,-r,-r), (r,r,r))
instance HasImplicit Sphere Obj3 where
    getImplicit (Sphere r) =  \(x,y,z) -> sqrt (x**2 + y**2 + z**2) - r

data Sphere = Sphere Double
instance HasBox Sphere R3 where
    getBox (Sphere r) = ((-r,-r,-r), (r,r,r))
instance HasImplicit Sphere Obj3 where
    getImplicit (Sphere r) =  \(x,y,z) -> sqrt (x**2 + y**2 + z**2) - r

data Cylinder = Cylinder Double Double Double
instance HasBox Cylinder R3 where
    getBox (Cylinder h r1 r2) = ( (-r,-r,0), (r,r,h) ) where r = max r1 r2
instance HasImplicit Cylinder Obj3 where
    getImplicit (Cylinder h r1 r2) =
        let	d = sqrt(x^2+y^2) - ((r2-r1)/h*z+r1)
		    θ = atan2 (r2-r1) h
        in max (d * cos θ) (abs(z-h/(2::ℝ)) - h/(2::ℝ))

data Union obj = Union [ImplicitObj obj]
instance HasImplicit (Union Obj3) Obj3 where
    getImplicit (Union symbObjs) =
        let objs = map getImplicit symbObjs
        in if r == 0
            then \p -> minimum $ map ($p) objs 
            else \p -> MathUtil.rminimum r $ map ($p) objs

data Difference obj = Diff (ImplicitObj obj) [ImplicitObj obj]