wumpus-core-0.15.0: Pure Haskell PostScript and SVG generation.

PortabilityGHC with TypeFamilies and more
Stabilityunstable
Maintainerstephen.tetley@gmail.com

Wumpus.Core.Geometry

Contents

Description

Objects and operations for 2D geometry.

Vector, point, affine frame, 3x3 matrix, and radian representations, plus a type family DUnit for parameterizing type classes with some dimension.

Synopsis

Type family

type family DUnit a :: *Source

Some unit of dimension usually double.

Data types

data Vec2 a Source

2D Vector - both components are strict.

Constructors

V2 !a !a 

Instances

Functor Vec2 
Eq a => Eq (Vec2 a) 
Show a => Show (Vec2 a) 
Num a => Monoid (Vec2 a) 
Num a => VectorSpace (Vec2 a) 
(Scalar a ~ a, Num a, InnerSpace a) => InnerSpace (Vec2 a) 
Num a => AdditiveGroup (Vec2 a) 
Pretty a => Pretty (Vec2 a) 
Num a => MatrixMult (Vec2 a) 
Pointwise (Vec2 a) 
Num u => Translate (Vec2 u) 
Num u => Scale (Vec2 u) 
(Floating a, Real a) => RotateAbout (Vec2 a) 
(Floating a, Real a) => Rotate (Vec2 a) 

data Point2 a Source

2D Point - both components are strict.

Constructors

P2 !a !a 

Instances

Functor Point2 
Eq a => Eq (Point2 a) 
Show a => Show (Point2 a) 
Num a => AffineSpace (Point2 a) 
Pretty a => Pretty (Point2 a) 
Ord a => CMinMax (Point2 a) 
Num a => MatrixMult (Point2 a) 
Pointwise (Point2 a) 
Num u => Translate (Point2 u) 
Num u => Scale (Point2 u) 
(Floating a, Real a) => RotateAbout (Point2 a) 
(Floating a, Real a) => Rotate (Point2 a) 

data Frame2 a Source

A two dimensional frame.

The components are the two basis vectors e0 and e1 and the origin o.

Typically these names for the elements will be used:

 Frame2 (V2 e0x e0y) (V2 e1x e1y) (P2 ox oy)

Constructors

Frame2 (Vec2 a) (Vec2 a) (Point2 a) 

Instances

Eq a => Eq (Frame2 a) 
Show a => Show (Frame2 a) 
(Num a, InnerSpace (Vec2 a)) => Monoid (Frame2 a) 
Pretty a => Pretty (Frame2 a) 
ToCTM (Frame2 a) 

data Matrix3'3 a Source

3x3 matrix, considered to be in row-major form.

 (M3'3 a b c
       d e f
       g h i)

For instance the rotation matrix is represented as

  ( cos(a) -sin(a) 0
    sin(a)  cos(a) 0  
      0         0  1 )

This seems commplace in geometry texts, but PostScript represents the current-transformation-matrix in column-major form.

The right-most column is considered to represent a coordinate:

  ( 1 0 x
    0 1 y  
    0 0 1 ) 

So a translation matrix representing the displacement in x of 40 and in y of 10 would be:

  ( 1 0 40
    0 1 10  
    0 0 1  ) 

Constructors

M3'3 !a !a !a !a !a !a !a !a !a 

Instances

Functor Matrix3'3 
Eq a => Eq (Matrix3'3 a) 
Num a => Num (Matrix3'3 a) 
Show a => Show (Matrix3'3 a) 
Num a => VectorSpace (Matrix3'3 a) 
Num a => AdditiveGroup (Matrix3'3 a) 
PSUnit a => Pretty (Matrix3'3 a) 
ToCTM (Matrix3'3 a) 

data Radian Source

Radian is represented with a distinct type. Equality and ordering are approximate where the epsilon is 0.0001.

Pointwise type class

class Pointwise sh whereSource

Pointwise is a Functor like type class, except that the container/element relationship is defined via an associated type rather than a type parameter. This means that applied function must be type preserving.

Associated Types

type Pt sh :: *Source

Methods

pointwise :: (Pt sh -> Pt sh) -> sh -> shSource

Matrix multiply type class

class MatrixMult t whereSource

Matrix multiplication - typically of points and vectors represented as homogeneous coordinates.

Methods

(*#) :: DUnit t ~ a => Matrix3'3 a -> t -> tSource

Instances

Num a => MatrixMult (Point2 a) 
Num a => MatrixMult (Vec2 a) 

Vector operations

hvec :: Num a => a -> Vec2 aSource

Construct a vector with horizontal displacement.

vvec :: Num a => a -> Vec2 aSource

Construct a vector with vertical displacement.

avec :: Floating a => Radian -> a -> Vec2 aSource

Construct a vector from an angle and magnitude.

Point operations

zeroPt :: Num a => Point2 aSource

Construct a point at 0 0.

langle :: (Floating u, Real u) => Point2 u -> Point2 u -> RadianSource

Calculate the counter-clockwise angle between two points and the x-axis.

Frame operations

ortho :: Num a => Point2 a -> Frame2 aSource

Create a frame with standard (orthonormal bases) at the supplied point.

displaceOrigin :: Num a => Vec2 a -> Frame2 a -> Frame2 aSource

Displace the origin of the frame by the supplied vector.

pointInFrame :: Num a => Point2 a -> Frame2 a -> Point2 aSource

'World coordinate' calculation of a point in the supplied frame.

frame2Matrix :: Num a => Frame2 a -> Matrix3'3 aSource

Concatenate the elements of the frame as columns forming a 3x3 matrix. Points and vectors are considered homogeneous coordinates - triples where the least element is either 0 indicating a vector or 1 indicating a point:

 Frame (V2 e0x e0y) (V2 e1x e1y) (P2 ox oy)

becomes

 (M3'3 e0x e1x ox
       e0y e1y oy
        0   0   1  )

matrix2Frame :: Matrix3'3 a -> Frame2 aSource

Interpret the matrix as columns forming a frame.

 (M3'3 e0x e1x ox
       e0y e1y oy
        0   0   1  )

becomes

 Frame (V2 e0x e0y) (V2 e1x e1y) (P2 ox oy)

frameProduct :: (Num a, InnerSpace (Vec2 a)) => Frame2 a -> Frame2 a -> Frame2 aSource

Multiplication of frames to form their product.

standardFrame :: Num a => Frame2 a -> BoolSource

Is the origin at (0,0) and are the basis vectors orthogonal with unit length?

Matrix contruction

identityMatrix :: Num a => Matrix3'3 aSource

Construct the identity matrix:

 (M3'3 1 0 0
       0 1 0
       0 0 1 )

scalingMatrix :: Num a => a -> a -> Matrix3'3 aSource

Construct a scaling matrix:

 (M3'3 sx 0  0
       0  sy 0
       0  0  1 )

translationMatrix :: Num a => a -> a -> Matrix3'3 aSource

Construct a translation matrix:

 (M3'3 1  0  x
       0  1  y
       0  0  1 )

rotationMatrix :: (Floating a, Real a) => Radian -> Matrix3'3 aSource

Construct a rotation matrix:

 (M3'3 cos(a)  -sin(a)  x
       sin(a)   cos(a)  y
       0        0       1 )

originatedRotationMatrix :: (Floating a, Real a) => Radian -> Point2 a -> Matrix3'3 aSource

Construct a matrix for rotation about some point.

This is the product of three matrices: T R T^-1

(T being the translation matrix, R the rotation matrix and T^-1 the inverse of the translation matrix).

matrix operations

invert :: Fractional a => Matrix3'3 a -> Matrix3'3 aSource

Invert a matrix.

determinant :: Num a => Matrix3'3 a -> aSource

Determinant of a matrix.

transpose :: Matrix3'3 a -> Matrix3'3 aSource

Transpose a matrix.

Radian operations

req :: Radian -> Radian -> BoolSource

Equality on radians, this is the operation used for (==) in Radian's Eq instance.

toRadian :: Real a => a -> RadianSource

Convert to radians.

fromRadian :: Fractional a => Radian -> aSource

Convert from radians.

d2r :: (Floating a, Real a) => a -> RadianSource

Degrees to radians.

r2d :: (Floating a, Real a) => Radian -> aSource

Radians to degrees.