wumpus-basic-0.13.0: Common drawing utilities built on wumpus-core.

PortabilityGHC
Stabilityhighly unstable
Maintainerstephen.tetley@gmail.com

Wumpus.Basic.Graphic.ContextFunction

Contents

Description

The primary drawing type and base combinators to manipulate it.

Synopsis

Documentation

data CF a Source

Most drawing operations in Wumpus-Basic have an implicit graphics state the DrawingContext, so the most primitive building block is a function from the DrawingContext to some polymorphic answer.

This functional type is represented concretely as the initials CF for contextual function.

 CF :: DrawingContext -> a 

Instances

type LocCF u a = CF (Point2 u -> a)Source

type LocThetaCF u a = LocCF u (Radian -> a)Source

type ConnectorCF u a = LocCF u (Point2 u -> a)Source

Run functions

runCF :: DrawingContext -> CF a -> aSource

Run a CF (context function) with the supplied DrawingContext.

Extractors

drawingCtx :: CF DrawingContextSource

Extract the drawing context from a CtxFun.

 (ctx -> ctx)

queryCtx :: (DrawingContext -> a) -> CF aSource

Apply the projection function to the drawing context.

 (ctx -> a) -> (ctx -> a)

locCtx :: LocCF u DrawingContextSource

Extract the drawing context from a LocCF.

 (ctx -> pt -> ctx)

locPoint :: LocCF u (Point2 u)Source

Extract the start point from a LocCF.

 (ctx -> pt -> pt)

locThetaCtx :: LocThetaCF u DrawingContextSource

Extract the drawing context from a LocThetaCF.

 (ctx -> pt -> ang -> ctx)

locThetaPoint :: LocThetaCF u (Point2 u)Source

Extract the start point from a LocThetaCF.

 (ctx -> pt -> ang -> pt)

locThetaAng :: LocThetaCF u RadianSource

Extract the angle from a LocThetaCF.

 (ctx -> pt -> ang -> ang)

connCtx :: ConnectorCF u DrawingContextSource

Extract the drawing context from a ConnectorCF.

 (ctx -> pt1 -> pt2 -> ctx)

connStart :: ConnectorCF u (Point2 u)Source

Extract the start point from a ConnectorCF.

 (ctx -> pt1 -> pt2 -> pt1)

connEnd :: ConnectorCF u (Point2 u)Source

Extract the end point from a ConnectorCF.

 (ctx -> pt1 -> pt2 -> pt2)

Reducers

unLoc :: Point2 u -> LocCF u a -> CF aSource

This is unCF1 at a specific type.

unCF1 :: r1 -> CF (r1 -> a) -> CF aSource

unCF2 :: r1 -> r2 -> CF (r1 -> r2 -> a) -> CF aSource

Combinators

wrap :: a -> CF aSource

Lift a pure value into a Context functional. The DrawingContext is ignored.

 ans -> (ctx -> ans)

Without any other arguments, this is the same as the raise combinator for raising into the Context functional. However, the arity family of wrap combinators is different.

wrap1 :: a -> CF (r1 -> a)Source

Lift a pure value into a Context functional, ignoring both the DrawingContext and the static argument, e.g. this would ingnore start point for a LocDrawing).

 ans -> (ctx -> r1 -> ans)

wrap2 :: a -> CF (r1 -> r2 -> a)Source

Lift a pure value into a Context functional, ignoring both the DrawingContext and the two static arguments, e.g. this would ignore the start point and angle for a LocThetaDrawing.

 ans -> (ctx -> r1 -> r2 -> ans)

promote1 :: (r1 -> CF ans) -> CF (r1 -> ans)Source

Promote a Context functional with one argument outside the functional so that the the argument is inside the Context functional.

The type signature is probably more illustrative of the operation than this description:

 (r1 -> ctx -> ans) -> (ctx -> r1 -> ans)

This is essentially the cardinal combinator - flip in Haskell.

promote2 :: (r1 -> r2 -> CF ans) -> CF (r1 -> r2 -> ans)Source

Promote a Context functional with two arguments outside the functional so that the two arguments are inside the Context functional.

The type signature is probably more illustrative of the operation than this description:

 (r1 -> r2 -> ctx -> ans) -> (ctx -> r1 -> r2 -> ans)

raise :: a -> CF aSource

Lift a value into a Context functional.

 ans -> (ctx -> ans)

Essentially this is the kestrel combinator - const in Haskell, though due to newtype wrapping it is pure from the Applicative class.

raise1 :: (r1 -> ans) -> CF (r1 -> ans)Source

Lift a one argument function into a Context functional.

This is Applicative's pure with a specialized type signature.

raise2 :: (r1 -> r2 -> ans) -> CF (r1 -> r2 -> ans)Source

Lift a two argument function into a Context functional.

This is Applicative's pure with a specialized type signature.

static1 :: CF ans -> CF (r1 -> ans)Source

Extend the arity of a Context functional, the original function is oblivious to the added argument.

Typically this combinator is used to take a Graphic to a LocGraphic ingoring the start point (figuratively a Graphic is not coordinate free).

 (ctx -> ans) -> (ctx -> r1 -> ans)

This was called the J-combinator by Joy, Rayward-Smith and Burton (ref. Compling Functional Languages by Antoni Diller), however it is not the J combinator commonly in the Literature.

static2 :: CF (r1 -> ans) -> CF (r1 -> r2 -> ans)Source

Extend the arity of a Context functional, the original function is oblivious to the added argument.

Typically this combinator is used to take a LocGraphic to a LocThetaGraphic ingoring the angle of direction.

 (ctx -> r1 -> ans) -> (ctx -> r1 -> r2 -> ans)

This was called the J-Prime combinator by Joy, Rayward-Smith and Burton (ref. Compling Functional Languages by Antoni Diller).

dblstatic :: CF ans -> CF (r1 -> r2 -> ans)Source

Complementary combinator to static2.

This combinator raises a function two levels rather than one.

 (ctx -> ans) -> (ctx -> r1 -> r2 -> ans)

bind :: CF a -> (a -> CF ans) -> CF ansSource

Supply the output from the first function to the second function.

This is just monadic bind - specialized to the CF functional type.

 (ctx -> a) -> (a -> ctx -> ans) -> (ctx -> ans)

bind1 :: CF (r1 -> a) -> (a -> CF (r1 -> ans)) -> CF (r1 -> ans)Source

Supply the output from the first function to the second function, sharing the drawing context and the static argument r1.

 (ctx -> r1 -> a) -> (a -> ctx -> -> r1 -> ans) -> (ctx -> r1 -> ans)

bind2 :: CF (r1 -> r2 -> a) -> (a -> CF (r1 -> r2 -> ans)) -> CF (r1 -> r2 -> ans)Source

Supply the output from the first function to the second function, sharing the DrawingContext and the two static arguments r1 and r2.

 (ctx -> r1 -> r2 -> a) -> (a -> ctx -> -> r1 -> r2 -> ans) -> (ctx -> r1 -> r2 -> ans)

situ1 :: CF (r1 -> ans) -> r1 -> CF ansSource

Supply the arguments to an arity 1 Context functional so it can be situated. Typically this is supplying the start point to a LocGraphic or LocImage.

 (ctx -> r1 -> ans) -> r1 -> (ctx -> ans)

This is equivalent to the id** combinator.

situ2 :: CF (r1 -> r2 -> ans) -> r1 -> r2 -> CF ansSource

Supply the arguments to an arity 2 Conterxt functional so it can be situated. Typically this is supplying the start point and angle to a LocThetaGraphic or LocThetaImage.

 (ctx -> r1 -> r2 -> ans) -> r1 -> r2 -> (ctx -> ans)

apply :: CF (a -> ans) -> CF a -> CF ansSource

Apply the the functional produced by the first argument to the value produced by the second.

 (ctx -> a -> ans) -> (ctx -> a) -> (ctx -> ans) 

apply1 :: CF (r1 -> a -> ans) -> CF (r1 -> a) -> CF (r1 -> ans)Source

Apply the the functional produced by the first argument to the value produced by the second sharing the context of the first functional argument r1 (usually a Point2) as well as the DrawingContext.

 (ctx -> r1 -> a -> ans) -> (ctx -> r1 -> a) -> (ctx -> r1 -> ans) 

apply2 :: CF (r1 -> r2 -> a -> ans) -> CF (r1 -> r2 -> a) -> CF (r1 -> r2 -> ans)Source

Apply the the functional produced by the first argument to the value produced by the second sharing the context of the two functional arguments r1 and r2 as well as the DrawingContext.

 (ctx -> r1 -> r2 -> a -> ans) -> (ctx -> r1 -> r2 -> a) -> (ctx -> r1 -> r2 -> ans) 

Pre-transformers

prepro1 :: (r1 -> a) -> CF (a -> ans) -> CF (r1 -> ans)Source

Apply the static argument transfomer (r1 -> a) to the static argument before applying the Context functional.

 (r1 -> a) -> (ctx -> a -> ans) -> (ctx -> r1 -> ans)

prepro2 :: (r1 -> a) -> (r2 -> b) -> CF (a -> b -> ans) -> CF (r1 -> r2 -> ans)Source

Apply the static argument transfomers to their respective static arguments before applying the Context functional.

 (r1 -> a) -> (r2 -> b) -> (ctx -> a -> b -> ans) -> (ctx -> r1 -> r2 -> ans)

prepro2a :: (r1 -> a) -> CF (a -> r2 -> ans) -> CF (r1 -> r2 -> ans)Source

Apply the static argument transfomer to the first static argument of a two static argument functional before applying the Context functional.

 (r1 -> a) -> (ctx -> a -> r2 -> ans) -> (ctx -> r1 -> r2 -> ans)

prepro2b :: (r2 -> a) -> CF (r1 -> a -> ans) -> CF (r1 -> r2 -> ans)Source

Apply the static argument transfomer to the second static argument of a two static argument functional before applying the Context functional.

 (r2 -> a) -> (ctx -> r1 -> a -> ans) -> (ctx -> r1 -> r2 -> ans)

Post-transformers

postpro :: (a -> ans) -> CF a -> CF ansSource

Apply the post-transformer to the result of the Context functional.

 (a -> ans) -> (ctx -> a) -> (ctx -> ans) 

postpro1 :: (a -> ans) -> CF (r1 -> a) -> CF (r1 -> ans)Source

Apply the post-transformer to the result of the Context functional. Version for one static argument.

Note - the DrawingContext is always present so it is never counted as a static argument.

 (a -> ans) -> (ctx -> r1 -> a) -> (ctx -> r1 -> ans) 

postpro2 :: (a -> ans) -> CF (r1 -> r2 -> a) -> CF (r1 -> r2 -> ans)Source

Apply the post-transformer to the result of the Context functional. Version for two static arguments.

Note - the DrawingContext is always present so it is never counted as a static argument.

 (a -> ans) -> (ctx -> r1 -> r2 -> a) -> (ctx -> r1 -> r2 -> ans) 

Post-combiners

postcomb :: (a -> b -> ans) -> CF a -> CF b -> CF ansSource

Combine the results of the two Context Functions with the supplied operator.

 (a -> b -> ans) -> (ctx -> a) -> (ctx -> b) -> (ctx -> ans)

postcomb1 :: (a -> b -> c) -> CF (r1 -> a) -> CF (r1 -> b) -> CF (r1 -> c)Source

Combine the results of the two one-static-argument Context Functions with the supplied operator.

 (a -> b -> ans) -> (ctx -> r1 -> a) -> (ctx -> r1 -> b) -> (ctx -> r1 -> ans)

postcomb2 :: (a -> b -> ans) -> CF (r1 -> r2 -> a) -> CF (r1 -> r2 -> b) -> CF (r1 -> r2 -> ans)Source

Combine the results of the two two-static-argument Context Functions with the supplied operator.

 (a -> b -> ans) -> (ctx -> r1 -> a) -> (ctx -> r1 -> b) -> (ctx -> r1 -> ans)

accumulate1 :: (ans -> ans -> ans) -> CF (s1 -> (s1, ans)) -> CF (s1 -> (s1, ans)) -> CF (s1 -> (s1, ans))Source

Iteration combinator - the initial argument s1 is not shared bewteen the drawings.

Evaluate the first Context Function with the drawing context and the initial state st0. The result of the evaluation is a new state st1 and and answer a1.

Evaluate the second Context Function with the drawing context and the new state st1, producing a new state s2 and an answer a2.

Return the result of combining the answers with op :: (ans -> ans -> ans) and the second state s2.

(ans -> ans -> ans) -> (ctx -> s1 -> (s1,ans)) -> (ctx -> s1 -> (s1,ans)) -> (ctx -> s1 -> (s1,ans))

This models chaining start points together, which is the model PostScript uses for text output when succesively calling the show operator.

accumulate2 :: (ans -> ans -> ans) -> CF (s1 -> s2 -> (s1, s2, ans)) -> CF (s1 -> s2 -> (s1, s2, ans)) -> CF (s1 -> s2 -> (s1, s2, ans))Source

Arity two version of accumulate1 - this is not expected to be useful!

(ans -> ans -> ans) -> (ctx -> s1 -> -> s2 (s1,s2,ans)) -> (ctx -> s1 -> s2 -> (s1,s2,ans)) -> (ctx -> s1 -> s2 -> (s1,s2,ans))