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

PortabilityGHC
Stabilityunstable
Maintainerstephen.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 *.

Then constraints on the Unit type can be declared on the instances rather than in the class declaration.

class Num u => Tolerance u whereSource

Class for tolerance on floating point numbers.

Two tolerances are required tolerance for equality - commonly used for testing if two points are equal - and tolerance for path length measurement.

Path length measurement in Wumpus does not have a strong need to be exact (precision is computational costly) - by default it is 100x the equality tolerance.

Bezier path lengths are calculated by iteration, so greater accuracy requires more compution. As it is hard to visually differentiate measures of less than a point the tolerance for Points is quite high quite high (0.1).

The situation is more complicated for contextual units (Em and En) as they are really scaling factors. The bigger the point size the less accurate the measure is.

Data types

data Vec2 u Source

2D Vector - both components are strict.

Note - equality is defined with Tolerance and tolerance is quite high for the usual units. See the note for Point2.

Constructors

V2 

Fields

vector_x :: !u
 
vector_y :: !u
 

Instances

Functor Vec2 
MatrixMult Vec2 
(Tolerance u, Ord u) => Eq (Vec2 u) 
(Tolerance u, Ord u) => Ord (Vec2 u) 
Show u => Show (Vec2 u) 
Num u => VectorSpace (Vec2 u) 
(u ~ Scalar u, Num u, InnerSpace u) => InnerSpace (Vec2 u) 
Num u => AdditiveGroup (Vec2 u) 
Format u => Format (Vec2 u) 
Translate (Vec2 u)

Vectors do not respond to translation.

Fractional u => Scale (Vec2 u) 
(Real u, Floating u) => RotateAbout (Vec2 u) 
(Real u, Floating u) => Rotate (Vec2 u) 
Num u => Transform (Vec2 u) 

data Point2 u Source

2D Point - both components are strict.

Note - equality is defined with Tolerance and tolerance is quite high for the usual units.

This is useful for drawing, *but* unacceptable data centric work. If more accurate equality is needed define a newtype wrapper over the unit type and make a Tolerance instance with much greater accuracy.

Constructors

P2 

Fields

point_x :: !u
 
point_y :: !u
 

Instances

Functor Point2 
MatrixMult Point2 
(Tolerance u, Ord u) => Eq (Point2 u) 
(Tolerance u, Ord u) => Ord (Point2 u) 
Show u => Show (Point2 u) 
Num u => AffineSpace (Point2 u) 
Format u => Format (Point2 u) 
Num u => Translate (Point2 u) 
Fractional u => Scale (Point2 u) 
(Real u, Floating u) => RotateAbout (Point2 u) 
(Real u, Floating 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

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

(*#) :: Num u => Matrix3'3 u -> t u -> t uSource

Tolerance helpers

tEQ :: (Tolerance u, Ord u) => u -> u -> BoolSource

Tolerant equality - helper function for defining Eq instances that use tolerance.

Note - the definition actually needs Ord which is unfortunate (as Ord is inaccurate).

tGT :: (Tolerance u, Ord u) => u -> u -> BoolSource

Tolerant greater than.

Note - the definition actually needs Ord which is unfortunate (as Ord is inaccurate).

tLT :: (Tolerance u, Ord u) => u -> u -> BoolSource

Tolerant less than.

Note - the definition actually needs Ord which is unfortunate (as Ord is inaccurate).

tGTE :: (Tolerance u, Ord u) => u -> u -> BoolSource

Tolerant greater than or equal.

Note - the definition actually needs Ord which is unfortunate (as Ord is inaccurate).

tLTE :: (Tolerance u, Ord u) => u -> u -> BoolSource

Tolerant less than or equal.

Note - the definition actually needs Ord which is unfortunate (as Ord is inaccurate).

tCompare :: (Tolerance u, Ord u) => u -> u -> OrderingSource

Tolerant compare.

Vector operations

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

vec : x_component * y_component -> Vec2

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

Essentially this function is superfluous, but it is slightly more pleasant typographically 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

hvec : x_component -> Vec2

Construct a vector with horizontal displacement.

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

vvec y_component -> Vec2

Construct a vector with vertical displacement.

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

avec : angle * distance -> Vec2

Construct a vector from an angle and magnitude.

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

pvec : point_from * point_to -> Vec2

The vector between two points

 pvec = flip (.-.)

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

vreverse : vec -> Vec2

Reverse a vector.

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

vdirection : vec -> Radian

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

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

vlength : vec -> Length

Length of a vector.

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

vangle : vec1 * vec2 -> Radian

Extract the angle between two vectors.

Point operations

zeroPt :: Num u => Point2 uSource

Construct a point at (0,0).

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

minPt : point1 * point2 -> Point2

Synthetic, 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, that potentially synthesizes a new point, e.g:

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

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

maxPt : point1 * point2 -> Point

Synthetic, component-wise max on points.

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

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

lineDirection : start_point * end_point -> Radian

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

scalingMatrix : x_scale_factor * y_scale_factor -> Matrix

Construct a scaling matrix:

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

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

translationMatrix : x_displacement * y_displacement -> Matrix

Construct a translation matrix:

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

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

rotationMatrix : ang -> Matrix

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

originatedRotationMatrix : ang * point -> Matrix

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

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

bezierCircle : radius * center -> [Point]

Make a circle from four Bezier curves. Although this function produces an approximation of a circle, the approximation seems fine in practice.

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

bezierEllipse : x_radius * y_radius * center -> [Point]

Make an ellipse from four Bezier curves. Although this function produces an approximation of a ellipse, the approximation seems fine in practice.

rbezierEllipse :: (Real u, Floating u) => u -> u -> Radian -> Point2 u -> [Point2 u]Source

rbezierEllipse : x_radius * y_radius * center * angle -> [Point]

Make an rotated ellipse from four Bezier curves.

Although this function produces an approximation of a ellipse, the approximation seems fine in practice.

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

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

subvisionCircle : subdivisions * radius * center -> [Point]

Make a circle from Bezier curves - the number of subdivsions controls the accuracy or the curve, more subdivisions produce better curves, but less subdivisions are better for rendering (producing more efficient PostScript).

Before revision 0.43.0, this was the only method in Wumpus to draw Bezier circles in Wumpus. However the kappa method seems to draw equally good circles and is more efficient both in the Haskell implementation and the generated PostScript code. This function is retained for completeness and testing.