{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, TypeSynonymInstances, FlexibleInstances #-}
module Graphics.Implicit.Primitives (
translate,
scale,
outset,
complement, union, intersect, difference,
unionR, intersectR, differenceR,
shell,
getBox,
getImplicit,
extrudeR,
extrudeRM,
extrudeRotateR,
extrudeOnEdgeOf,
sphere,
rect3R,
circle,
cylinder,
cylinder2,
rectR,
polygonR,
rotateExtrude,
rotate3,
rotate3V,
pack3,
rotate,
pack2,
implicit
) where
import Prelude(Maybe(Just, Nothing), Either, map, ($))
import Graphics.Implicit.Definitions (ℝ, ℝ2, ℝ3, Box2,
SymbolicObj2(
RectR,
Circle,
PolygonR,
Complement2,
UnionR2,
DifferenceR2,
IntersectR2,
Translate2,
Scale2,
Rotate2,
Outset2,
Shell2,
EmbedBoxedObj2
),
SymbolicObj3(
Rect3R,
Sphere,
Cylinder,
Complement3,
UnionR3,
DifferenceR3,
IntersectR3,
Translate3,
Scale3,
Rotate3,
Rotate3V,
Outset3,
Shell3,
EmbedBoxedObj3,
ExtrudeR,
ExtrudeRotateR,
ExtrudeRM,
RotateExtrude,
ExtrudeOnEdgeOf
)
)
import Graphics.Implicit.MathUtil (pack)
import Graphics.Implicit.ObjectUtil (getBox2, getBox3, getImplicit2, getImplicit3)
sphere ::
ℝ
-> SymbolicObj3
sphere = Sphere
rect3R ::
ℝ
-> ℝ3
-> ℝ3
-> SymbolicObj3
rect3R = Rect3R
cylinder2 ::
ℝ
-> ℝ
-> ℝ
-> SymbolicObj3
cylinder2 r1 r2 h = Cylinder h r1 r2
cylinder ::
ℝ
-> ℝ
-> SymbolicObj3
cylinder r = cylinder2 r r
circle ::
ℝ
-> SymbolicObj2
circle = Circle
rectR ::
ℝ
-> ℝ2
-> ℝ2
-> SymbolicObj2
rectR = RectR
polygonR ::
ℝ
-> [ℝ2]
-> SymbolicObj2
polygonR = PolygonR
class Object obj vec | obj -> vec where
complement ::
obj
-> obj
unionR ::
ℝ
-> [obj]
-> obj
differenceR ::
ℝ
-> [obj]
-> obj
intersectR ::
ℝ
-> [obj]
-> obj
translate ::
vec
-> obj
-> obj
scale ::
vec
-> obj
-> obj
outset ::
ℝ
-> obj
-> obj
shell ::
ℝ
-> obj
-> obj
getBox ::
obj
-> (vec, vec)
getImplicit ::
obj
-> (vec -> ℝ)
implicit ::
(vec -> ℝ)
-> (vec, vec)
-> obj
instance Object SymbolicObj2 ℝ2 where
translate = Translate2
scale = Scale2
complement = Complement2
unionR = UnionR2
intersectR = IntersectR2
differenceR = DifferenceR2
outset = Outset2
shell = Shell2
getBox = getBox2
getImplicit = getImplicit2
implicit a b= EmbedBoxedObj2 (a,b)
instance Object SymbolicObj3 ℝ3 where
translate = Translate3
scale = Scale3
complement = Complement3
unionR = UnionR3
intersectR = IntersectR3
differenceR = DifferenceR3
outset = Outset3
shell = Shell3
getBox = getBox3
getImplicit = getImplicit3
implicit a b= EmbedBoxedObj3 (a,b)
union :: forall obj vec. Object obj vec => [obj] -> obj
union = unionR 0
difference :: forall obj vec. Object obj vec => [obj] -> obj
difference = differenceR 0
intersect :: forall obj vec. Object obj vec => [obj] -> obj
intersect = intersectR 0
extrudeR :: ℝ -> SymbolicObj2 -> ℝ -> SymbolicObj3
extrudeR = ExtrudeR
extrudeRotateR :: ℝ -> ℝ -> SymbolicObj2 -> ℝ -> SymbolicObj3
extrudeRotateR = ExtrudeRotateR
extrudeRM :: ℝ
-> Maybe (ℝ -> ℝ)
-> Maybe (ℝ -> ℝ)
-> Maybe (ℝ -> ℝ2)
-> SymbolicObj2
-> Either ℝ (ℝ2 -> ℝ)
-> SymbolicObj3
extrudeRM = ExtrudeRM
rotateExtrude :: ℝ
-> Maybe ℝ
-> Either ℝ2 (ℝ -> ℝ2)
-> Either ℝ (ℝ -> ℝ)
-> SymbolicObj2
-> SymbolicObj3
rotateExtrude = RotateExtrude
extrudeOnEdgeOf :: SymbolicObj2 -> SymbolicObj2 -> SymbolicObj3
extrudeOnEdgeOf = ExtrudeOnEdgeOf
rotate3 :: (ℝ, ℝ, ℝ) -> SymbolicObj3 -> SymbolicObj3
rotate3 = Rotate3
rotate3V :: ℝ -> ℝ3 -> SymbolicObj3 -> SymbolicObj3
rotate3V = Rotate3V
pack3 :: ℝ2 -> ℝ -> [SymbolicObj3] -> Maybe SymbolicObj3
pack3 (dx, dy) sep objs =
let
boxDropZ :: forall t t1 t2 t3 t4 t5. ((t2, t3, t), (t4, t5, t1)) -> ((t2, t3), (t4, t5))
boxDropZ ((a,b,_),(d,e,_)) = ((a,b),(d,e))
withBoxes :: [(Box2, SymbolicObj3)]
withBoxes = map (\obj -> ( boxDropZ $ getBox3 obj, obj)) objs
in case pack ((0,0),(dx,dy)) sep withBoxes of
(a, []) -> Just $ union $ map (\((x,y),obj) -> translate (x,y,0) obj) a
_ -> Nothing
rotate :: ℝ -> SymbolicObj2 -> SymbolicObj2
rotate = Rotate2
pack2 :: ℝ2 -> ℝ -> [SymbolicObj2] -> Maybe SymbolicObj2
pack2 (dx, dy) sep objs =
let
withBoxes :: [(Box2, SymbolicObj2)]
withBoxes = map (\obj -> ( getBox2 obj, obj)) objs
in case pack ((0,0),(dx,dy)) sep withBoxes of
(a, []) -> Just $ union $ map (\((x,y),obj) -> translate (x,y) obj) a
_ -> Nothing