Copyright | (C) Frank Staals |
---|---|
License | see the LICENSE file |
Maintainer | Frank Staals |
Safe Haskell | None |
Language | Haskell2010 |
Synopsis
- data HyperPlane (d :: Nat) (r :: *) = HyperPlane {
- _inPlane :: !(Point d r)
- _normalVec :: !(Vector d r)
- normalVec :: forall d r. Lens' (HyperPlane d r) (Vector d r)
- inPlane :: forall d r. Lens' (HyperPlane d r) (Point d r)
- type Plane = HyperPlane 3
- pattern Plane :: Point 3 r -> Vector 3 r -> Plane r
- from3Points :: Num r => Point 3 r -> Point 3 r -> Point 3 r -> HyperPlane 3 r
- _asLine :: Num r => Iso' (HyperPlane 2 r) (Line 2 r)
- class HasSupportingPlane t where
- supportingPlane :: t -> HyperPlane (Dimension t) (NumType t)
- planeCoordinatesWith :: Fractional r => Plane r -> Vector 3 r -> Point 3 r -> Point 2 r
- planeCoordinatesTransform :: Num r => Plane r -> Vector 3 r -> Transformation 3 r
Documentation
data HyperPlane (d :: Nat) (r :: *) Source #
Hyperplanes embedded in a \(d\) dimensional space.
HyperPlane | |
|
Instances
3 Dimensional planes
type Plane = HyperPlane 3 Source #
from3Points :: Num r => Point 3 r -> Point 3 r -> Point 3 r -> HyperPlane 3 r Source #
Produces a plane. If r lies counter clockwise of q w.r.t. p then the normal vector of the resulting plane is pointing "upwards".
>>>
from3Points origin (Point3 1 0 0) (Point3 0 1 0)
HyperPlane {_inPlane = Point3 0 0 0, _normalVec = Vector3 0 0 1}
Lines
Supporting Planes
class HasSupportingPlane t where Source #
Types for which we can compute a supporting hyperplane, i.e. a hyperplane that contains the thing of type t.
supportingPlane :: t -> HyperPlane (Dimension t) (NumType t) Source #
Instances
HasSupportingPlane (HyperPlane d r) Source # | |
Defined in Data.Geometry.HyperPlane supportingPlane :: HyperPlane d r -> HyperPlane (Dimension (HyperPlane d r)) (NumType (HyperPlane d r)) Source # | |
Num r => HasSupportingPlane (Triangle 3 p r) Source # | |
Defined in Data.Geometry.Triangle supportingPlane :: Triangle 3 p r -> HyperPlane (Dimension (Triangle 3 p r)) (NumType (Triangle 3 p r)) Source # |
planeCoordinatesWith :: Fractional r => Plane r -> Vector 3 r -> Point 3 r -> Point 2 r Source #
Given * a plane, * a unit vector in the plane that will represent the y-axis (i.e. the "view up" vector), and * a point in the plane,
computes the plane coordinates of the given point, using the inPlane point as the origin, the normal vector of the plane as the unit vector in the "z-direction" and the view up vector as the y-axis.
>>>
planeCoordinatesWith (Plane origin (Vector3 0 0 1)) (Vector3 0 1 0) (Point3 10 10 0)
Point2 10.0 10.0
planeCoordinatesTransform :: Num r => Plane r -> Vector 3 r -> Transformation 3 r Source #