module Graphics.Implicit.Primitives (
sphere,
cube,
circle,
cylinder,
square,
regularPolygon,
polygon,
zsurface--,
--ellipse
) where
import Graphics.Implicit.Definitions
import qualified Graphics.Implicit.SaneOperators as S
sphere ::
ℝ
-> Obj3
sphere r = \(x,y,z) -> sqrt (x**2 + y**2 + z**2) r
cube ::
ℝ
-> Obj3
cube l = \(x,y,z) -> (maximum $ map abs [x,y,z]) l/2.0
cylinder ::
ℝ
-> ℝ
-> Obj3
cylinder r h = \(x,y,z) -> max (sqrt(x^2+y^2) r) (abs(z) h)
circle ::
ℝ
-> Obj2
circle r = \(x,y) -> sqrt (x**2 + y**2) r
torus ::
ℝ
-> ℝ
-> Obj3
torus r_main r_second = \(x,y,z) -> sqrt( ( sqrt (x^2 + y^2) r_main )^2 + z^2 ) r_second
square ::
ℝ
-> Obj2
square l = \(x,y) -> (maximum $ map abs [x,y]) l/2.0
polygon ::
[ℝ2]
-> Obj2
polygon points =
let
pairs =
[ (points !! n, points !! (mod (n+1) (length points) ) ) | n <- [0 .. (length points) 1] ]
isIn p@(p1,p2) =
let
crossing_points =
[x1 + (x2x1)*y2/(y2y1) |
((x1,y1), (x2,y2)) <-
map (\((a1,a2),(b1,b2)) -> ((a1p1,a2p2), (b1p1,b2p2)) ) pairs,
( (y2 < 0) && (y1 > 0) ) || ( (y2 > 0) && (y1 < 0) ) ]
in
if odd $ length $ filter (>0) crossing_points then 1 else 1
dist a@(a1,a2) b@(b1,b2) p@(p1,p2) =
let
ab = b S.- a
nab = (1 / S.norm ab) S.* ab
ap = p S.- a
d = nab S.⋅ ap
closest
| d < 0 = a
| d > S.norm ab = b
| otherwise = a S.+ d S.* nab
in
S.norm (closest S.- p)
dists = \ p -> map (\(a,b) -> dist a b p) pairs
in
\ p -> isIn p * minimum (dists p)
regularPolygon ::
ℕ
-> ℝ
-> Obj2
regularPolygon sides r = let sidesr = fromIntegral sides in
\(x,y) -> maximum [ x*cos(2*pi*m/sidesr) + y*sin(2*pi*m/sidesr) | m <- [0.. sidesr 1]] r
zsurface ::
(ℝ2 -> ℝ)
-> Obj3
zsurface f = \(x,y,z) -> f (x,y) z