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

PortabilityGHC
Stabilityhighly unstable
MaintainerStephen Tetley <stephen.tetley@gmail.com>

Wumpus.Core.Geometry

Contents

Description

Objects and operations for 2D geometry.

Vector, point, 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.

This very useful for reducing the kind of type classes to *.

Doing this then allows constraints on the Unit type on the instances rather than in the class declaration.

type family GuardEq a b :: *Source

Data types

data UNil u Source

Phantom ().

This newtype is Haskell's () with unit of dimension u as a phantom type.

This has no use in wumpus-core, but it has affine instances which cannot be written for (). By supporting affine instances it becomes useful to higher-level software (wumpus-basic employs it for the Graphic type.)

Instances

Bounded (UNil u) 
Enum (UNil u) 
Eq (UNil u) 
Ord (UNil u) 
Show (UNil u) 
Monoid (UNil u) 
Translate (UNil u) 
Scale (UNil u) 
RotateAbout (UNil u) 
Rotate (UNil u) 
Transform (UNil u) 

data Vec2 u Source

2D Vector - both components are strict.

Constructors

V2 

Fields

vector_x :: !u
 
vector_y :: !u
 

Instances

Functor Vec2 
Eq u => Eq (Vec2 u) 
Show u => Show (Vec2 u) 
(u ~ Scalar u, Num u, InnerSpace u) => InnerSpace (Vec2 u) 
Num u => VectorSpace (Vec2 u) 
Num u => AdditiveGroup (Vec2 u) 
PSUnit u => Format (Vec2 u) 
Num u => MatrixMult (Vec2 u) 
Num u => Translate (Vec2 u) 
Num u => Scale (Vec2 u) 
(Floating u, Real u) => RotateAbout (Vec2 u) 
(Floating u, Real u) => Rotate (Vec2 u) 
Num u => Transform (Vec2 u) 

data Point2 u Source

2D Point - both components are strict.

Note - Point2 derives Ord so it can be used as a key in Data.Map etc.

Constructors

P2 

Fields

point_x :: !u
 
point_y :: !u
 

Instances

Functor Point2 
Eq u => Eq (Point2 u) 
Ord u => Ord (Point2 u) 
Show u => Show (Point2 u) 
Num u => AffineSpace (Point2 u) 
PSUnit u => Format (Point2 u) 
Num u => MatrixMult (Point2 u) 
Num u => Translate (Point2 u) 
Num u => Scale (Point2 u) 
(Floating u, Real u) => RotateAbout (Point2 u) 
(Floating u, Real u) => Rotate (Point2 u) 
Num u => Transform (Point2 u) 

data Matrix3'3 u 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 !u !u !u !u !u !u !u !u !u 

Instances

Functor Matrix3'3 
Eq u => Eq (Matrix3'3 u) 
Num u => Num (Matrix3'3 u) 
Show u => Show (Matrix3'3 u) 
Num u => VectorSpace (Matrix3'3 u) 
Num u => AdditiveGroup (Matrix3'3 u) 
PSUnit u => Format (Matrix3'3 u) 

data Radian Source

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

class MatrixMult t whereSource

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

Methods

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

Instances

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

UNil operations

uNil :: UNil uSource

Construct a UNil.

Vector operations

vec :: Num u => u -> u -> Vec2 uSource

vec - a synonym for the constructor V2 with a Num constraint on the arguments.

Essentially superfluous, but it can be slightly more typographically pleasant when used in lists of vectors:

 [ vec 2 2, vvec 4, hvec 4, vec 2 2 ]

Versus:

 [ V2 2 2, vvec 4, hvec 4, V2 2 2 ]

hvec :: Num u => u -> Vec2 uSource

Construct a vector with horizontal displacement.

vvec :: Num u => u -> Vec2 uSource

Construct a vector with vertical displacement.

avec :: Floating u => Radian -> u -> Vec2 uSource

Construct a vector from an angle and magnitude.

pvec :: Num u => Point2 u -> Point2 u -> Vec2 uSource

The vector between two points

 pvec = flip (.-.)

vreverse :: Num u => Vec2 u -> Vec2 uSource

Reverse a vector.

direction :: (Floating u, Real u) => Vec2 u -> RadianSource

Direction of a vector - i.e. the counter-clockwise angle from the x-axis.

vlength :: Floating u => Vec2 u -> uSource

Length of a vector.

vangle :: (Floating u, Real u, InnerSpace (Vec2 u)) => Vec2 u -> Vec2 u -> RadianSource

Extract the angle between two vectors.

Point operations

zeroPt :: Num u => Point2 uSource

Construct a point at (0,0).

maxPt :: Ord u => Point2 u -> Point2 u -> Point2 uSource

Component-wise max on points.

 maxPt (P2 1 2) (Pt 2 1) = Pt 2 2

minPt :: Ord u => Point2 u -> Point2 u -> Point2 uSource

Component-wise min on points. Standard min and max via Ord are defined lexographically on pairs, e.g.:

 min (1,2) (2,1) = (1,2)

For Points we want the component-wise min and max, e.g:

 minPt (P2 1 2) (Pt 2 1) = Pt 1 1 
 maxPt (P2 1 2) (Pt 2 1) = Pt 2 2

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

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

Matrix contruction

identityMatrix :: Num u => Matrix3'3 uSource

Construct the identity matrix:

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

scalingMatrix :: Num u => u -> u -> Matrix3'3 uSource

Construct a scaling matrix:

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

translationMatrix :: Num u => u -> u -> Matrix3'3 uSource

Construct a translation matrix:

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

rotationMatrix :: (Floating u, Real u) => Radian -> Matrix3'3 uSource

Construct a rotation matrix:

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

originatedRotationMatrix :: (Floating u, Real u) => Radian -> Point2 u -> Matrix3'3 uSource

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 u => Matrix3'3 u -> Matrix3'3 uSource

Invert a matrix.

determinant :: Num u => Matrix3'3 u -> uSource

Determinant of a matrix.

transpose :: Matrix3'3 u -> Matrix3'3 uSource

Transpose a matrix.

Radian operations

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.

circularModulo :: Radian -> RadianSource

Modulo a (positive) angle into the range 0..2*pi.

Bezier curves

bezierArc :: Floating u => u -> Radian -> Radian -> Point2 u -> (Point2 u, Point2 u, Point2 u, Point2 u)Source

bezierArc : radius * ang1 * ang2 * center -> (start_point, control_point1, control_point2, end_point)

Create an arc - this construction is the analogue of PostScript's arc command, but the arc is created as a Bezier curve so it should span less than 90deg.

CAVEAT - ang2 must be greater than ang1

bezierCircle :: (Fractional u, Floating u) => Int -> u -> Point2 u -> [Point2 u]Source

bezierCircle : n * radius * center -> [Point]

Make a circle from Bezier curves - n is the number of subdivsions per quadrant.