csg-0.1: Analytical CSG (Constructive Solid Geometry) library

Safe HaskellNone
LanguageHaskell2010

Data.CSG

Contents

Description

Types and routines for constructive solid geometry.

This module provides constructors for complex solids as well as membership predicates and routines to compute intersections of such solids with a ray.

Synopsis

Examples

Data.CSG uses Vec3 to represent vectors and points:

>>> let p1 = fromXYZ (5, -6.5, -5)
>>> toXYZ (origin :: Point)
(0.0,0.0,0.0)

Define some solids:

>>> let s = sphere origin 5.0
>>> let b = cuboid (fromXYZ (-1, -1, -1)) (fromXYZ (1, 1, 1))

See Data.CSG.Parser for a non-programmatic way to define solids.

Test if a point is inside the solid:

>>> origin `inside` (s `intersect` b)
True
>>> origin `inside` (s `subtract` b)
False

Find the distance to the next intersection of a ray with a solid, along with the surface normal:

>>> let axis = fromXYZ (1, 2, 10)
>>> let solid = cylinder origin axis 2.0 `intersect` sphere origin 3.5
>>> let ray = Ray (p1, origin <-> p1)
>>> ray `cast` solid
Just (HitPoint 0.7422558525331708 (Just (CVec3 0.7155468474912454 (-0.6952955216188516) 6.750441957464598e-2)))

Load a solid definition from a file:

>>> import Data.CSG.Parser
>>> Right solid2 <- parseGeometryFile "examples/reentry.geo"
>>> ray `cast` solid2
Just (HitPoint 10.877824491509912 (Just (CVec3 (-0.5690708596937849) 0.7397921176019203 0.3589790793088691)))

data Solid Source #

CSG solid is a recursive composition of primitive objects or other solids.

Instances

Primitives

plane :: Point -> Vec3 -> Solid Source #

A half-space defined by an arbitary point on the boundary plane and an outward normal (not necessarily a unit vector).

sphere :: Vec3 -> Double -> Solid Source #

A sphere defined by a center point and a radius.

cylinder :: Point -> Point -> Double -> Solid Source #

An infinite circular cylinder defined by two arbitary points on axis and a radius.

cone :: Vec3 -> Point -> Double -> Solid Source #

An infinite right circular cone defined by an outward axis vector, an apex point and an angle between the generatrix and the axis (in degrees, less than 90).

Complex solids

cuboid :: Point -> Point -> Solid Source #

A rectangular cuboid with faces parallel to axes, defined by two opposite vertices.

coneFrustum :: (Point, Double) -> (Point, Double) -> Solid Source #

A conical frustum defined by two points on its axis with radii at that points. One of radii may be zero (in which case one of frustum ends will be the apex).

cylinderFrustum :: Point -> Point -> Double -> Solid Source #

A finite right circular cylinder defined by two points on its top and bottom and a radius.

Operations

intersect :: Solid -> Solid -> Solid Source #

Intersection of two solids.

unite :: Solid -> Solid -> Solid Source #

Union of two solids.

complement :: Solid -> Solid Source #

Complement to a solid (normals flipped).

subtract :: Solid -> Solid -> Solid Source #

Subtract a solid from another.

Ray casting

type Vec3 = CVec3 Source #

We use CVec3 as a simple replacement for (Double, Double, Double). CVec3 implements a contiguous storage scheme for Unboxed and Storable vectors which shows better performance. Compile this package with triples flag and run benchmarks to see the difference.

newtype Ray Source #

A ray described by the equation p(t) = p_0 + v * t with an initial point p_0 and a direction v. Substituting a specific time t' in the equation yields a position of a point p(t') on the ray. For negative values of t', position precedes the initial point.

Constructors

Ray (Point, Vec3) 

data HitPoint Source #

A point at which a ray intersects a surface, given as a distance from the ray's initial point and an outward normal to the surface at the hit point. If hit is in infinity, then normal is Nothing. If the hit occures on the same line but precedes the initial point of the ray, the distance is negative.

Note that this datatype is strict only on first argument: we do not compare normals when combining traces and thus do not force calculation of normals.

Constructors

HitPoint !Double (Maybe Vec3) 

type HitSegment = Pair HitPoint HitPoint Source #

A segment of ray inside a solid.

type Trace = [HitSegment] Source #

Trace of a ray/line on a solid is a list of segments corresponding to the portions of the ray inside the solid.

                      O - ray
                       -- >                         -- >                          +------------

trace :: Solid -> Ray -> Trace Source #

Trace of a ray on a solid.

cast :: Ray -> Solid -> Maybe HitPoint Source #

Find the next point where a ray hits a solid, if any.

Here we consider only future intersections: the HitPoint is guaranteed to have non-negative distance (unlike when using trace).

This means that if the ray starts inside the solid the only way to tell that from cast result is to compare it's direction and the surface normal at the hit point.

Membership

inside :: Point -> Solid -> Bool Source #

True if the point is in inside the solid.