diagrams-contrib-1.1.1.3: Collection of user contributions to diagrams EDSL

Safe HaskellNone

Diagrams.TwoD.Path.Metafont.Types

Synopsis

Documentation

data PathJoin d j Source

A PathJoin specifies the directions at both ends of a segment, and a join which describes the control points explicitly or implicitly.

Constructors

PJ 

Fields

_d1 :: d
 
_j :: j
 
_d2 :: d
 

j :: forall d j j. Lens (PathJoin d j) (PathJoin d j) j jSource

d2 :: forall d j. Lens' (PathJoin d j) dSource

d1 :: forall d j. Lens' (PathJoin d j) dSource

data PathDir Source

A direction can be specified at any point of a path. A curl should only be specified at the endpoints. The endpoints default to curl 1 if not set.

isCurl :: PathDir -> BoolSource

A predicate to determine the constructor used.

type Dir = R2Source

data Tension Source

Higher Tension brings the path closer to a straight line between segments. Equivalently, it brings the control points closer to the endpoints. TensionAmt introduces a fixed tension. TensionAtLeast introduces a tension which will be increased if by so doing, an inflection point can be eliminated.

Instances

data TensionJoin Source

Two tensions and two directions completely determine the control points of a segment.

Constructors

TJ 

Fields

_t1 :: Tension
 
_t2 :: Tension
 

data ControlJoin Source

The two intermediate control points of a segment, specified directly.

Constructors

CJ 

Fields

_c1 :: P2
 
_c2 :: P2
 

data P Source

data J Source

data MFPathData a whereSource

MFPathData is the type manipulated by the metafont combinators.

data MetafontSegment d j Source

MetafontSegment is used internally in solving the metafont equations. It represents a segment with two known endpoints, and a join, which may be specified in various ways.

Constructors

MFS 

Fields

_x1 :: P2
 
_pj :: PathJoin d j
 
_x2 :: P2
 

Instances

data MFPath d j Source

MFPath is the type used internally in solving the metafont equations. The direction and join types are progressively refined until all control points are known. The loop flag affects both the equations to be solved and the type of Trail in the result. If constructing an MFPath in new code, the responsibility rests on the user to ensure that successive MetafontSegments share an endpoint. If this is not true, the result is undefined.

Constructors

MFP 

Fields

_loop :: Bool
 
_segs :: [MetafontSegment d j]
 

Instances

(Show d, Show j) => Show (MFPath d j) 

type MFP = MFPath (Maybe PathDir) BasicJoinSource

MFP is a type synonym to clarify signatures in Metafont.Internal. Note that the type permits segments which are "overspecified", having one or both directions specified, and also a ControlJoin. In this case, Metafont.Internal ignores the directions.

type MFS = MetafontSegment (Maybe PathDir) BasicJoinSource

MFS is a type synonym to clarify signatures in Metafont.Internal.

x2 :: forall d j. Lens' (MetafontSegment d j) P2Source

x1 :: forall d j. Lens' (MetafontSegment d j) P2Source

pj :: forall d j d j. Lens (MetafontSegment d j) (MetafontSegment d j) (PathJoin d j) (PathJoin d j)Source

segs :: forall d j d j. Lens (MFPath d j) (MFPath d j) [MetafontSegment d j] [MetafontSegment d j]Source

loop :: forall d j. Lens' (MFPath d j) BoolSource