eventloop-0.8.2.5: A different take on an IO system. Based on Amanda's IO loop, this eventloop takes a function that maps input events to output events. It can easily be extended by modules that represent IO devices or join multiple modules together.

Safe HaskellNone
LanguageHaskell2010

Eventloop.Module.Graphs

Synopsis

Documentation

onNode :: [Node] -> Pos -> Maybe Node Source #

Checkes to see if there is a node on a certain position

graphsPreProcessor :: PreProcessor Source #

Abstracts the standardized EventTypes to GraphsIn

graphsPostProcessor :: PostProcessor Source #

Abstracts GraphsOut back to BasicShapes and Canvas events

colorToRGBAColor :: Color -> Color Source #

Translates color datatype to RGBA codes

thicknessToFloat :: Thickness -> StrokeLineThickness Source #

Translates the thickness to a float

posOnVector :: Float -> Vector -> Pos -> Pos Source #

Returns the point when making a step f long from the point start in the direction of the vector. The length between start pos and result pos is always f.

vectorize :: Pos -> Pos -> Vector Source #

Vector from p1 to p2

downPerpendicularTo :: Pos -> Pos -> Vector Source #

Returns the vector perpendicular on the given vector between the 2 points. Always has positive y and vector length 1; y is inverted in canvas

upPerpendicularTo :: Pos -> Pos -> Vector Source #

Returns the vector perpendicular on the given vector between the 2 points. Always has negative y and vector length 1; y is inverted in canvas

vectorSize :: Vector -> Float Source #

Returns the size of the vector

type Pos = (Float, Float) Source #

data GraphsOut Source #

Instances

Eq GraphsOut Source # 
Show GraphsOut Source # 
Generic GraphsOut Source # 

Associated Types

type Rep GraphsOut :: * -> * #

NFData GraphsOut Source # 

Methods

rnf :: GraphsOut -> () #

type Rep GraphsOut Source # 
type Rep GraphsOut = D1 (MetaData "GraphsOut" "Eventloop.Module.Graphs.Types" "eventloop-0.8.2.5-2xkWAiRT8jy1Kz4bNfpdit" False) ((:+:) (C1 (MetaCons "SetupGraphs" PrefixI False) U1) ((:+:) (C1 (MetaCons "DrawGraph" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Graph))) (C1 (MetaCons "Instructions" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [String])))))

type Node = (Label, Pos, Color) Source #

data Graph Source #

Constructors

Graph 

Fields

Instances

Eq Graph Source # 

Methods

(==) :: Graph -> Graph -> Bool #

(/=) :: Graph -> Graph -> Bool #

Show Graph Source # 

Methods

showsPrec :: Int -> Graph -> ShowS #

show :: Graph -> String #

showList :: [Graph] -> ShowS #

Generic Graph Source # 

Associated Types

type Rep Graph :: * -> * #

Methods

from :: Graph -> Rep Graph x #

to :: Rep Graph x -> Graph #

NFData Graph Source # 

Methods

rnf :: Graph -> () #

type Rep Graph Source # 

data Color Source #

Constructors

Red 
Blue 
Green 
Purple 
Grey 
Yellow 
Orange 
Black 
White 

Instances

Eq Color Source # 

Methods

(==) :: Color -> Color -> Bool #

(/=) :: Color -> Color -> Bool #

Show Color Source # 

Methods

showsPrec :: Int -> Color -> ShowS #

show :: Color -> String #

showList :: [Color] -> ShowS #

Generic Color Source # 

Associated Types

type Rep Color :: * -> * #

Methods

from :: Color -> Rep Color x #

to :: Rep Color x -> Color #

NFData Color Source # 

Methods

rnf :: Color -> () #

type Rep Color Source # 
type Rep Color = D1 (MetaData "Color" "Eventloop.Module.Graphs.Types" "eventloop-0.8.2.5-2xkWAiRT8jy1Kz4bNfpdit" False) ((:+:) ((:+:) ((:+:) (C1 (MetaCons "Red" PrefixI False) U1) (C1 (MetaCons "Blue" PrefixI False) U1)) ((:+:) (C1 (MetaCons "Green" PrefixI False) U1) (C1 (MetaCons "Purple" PrefixI False) U1))) ((:+:) ((:+:) (C1 (MetaCons "Grey" PrefixI False) U1) (C1 (MetaCons "Yellow" PrefixI False) U1)) ((:+:) (C1 (MetaCons "Orange" PrefixI False) U1) ((:+:) (C1 (MetaCons "Black" PrefixI False) U1) (C1 (MetaCons "White" PrefixI False) U1)))))

data Thickness Source #

Constructors

Thin 
Thick 

Instances

Eq Thickness Source # 
Show Thickness Source # 
Generic Thickness Source # 

Associated Types

type Rep Thickness :: * -> * #

NFData Thickness Source # 

Methods

rnf :: Thickness -> () #

type Rep Thickness Source # 
type Rep Thickness = D1 (MetaData "Thickness" "Eventloop.Module.Graphs.Types" "eventloop-0.8.2.5-2xkWAiRT8jy1Kz4bNfpdit" False) ((:+:) (C1 (MetaCons "Thin" PrefixI False) U1) (C1 (MetaCons "Thick" PrefixI False) U1))

data Directed Source #

Constructors

Directed 
Undirected 

Instances

Eq Directed Source # 
Show Directed Source # 
Generic Directed Source # 

Associated Types

type Rep Directed :: * -> * #

Methods

from :: Directed -> Rep Directed x #

to :: Rep Directed x -> Directed #

NFData Directed Source # 

Methods

rnf :: Directed -> () #

type Rep Directed Source # 
type Rep Directed = D1 (MetaData "Directed" "Eventloop.Module.Graphs.Types" "eventloop-0.8.2.5-2xkWAiRT8jy1Kz4bNfpdit" False) ((:+:) (C1 (MetaCons "Directed" PrefixI False) U1) (C1 (MetaCons "Undirected" PrefixI False) U1))

data Weighted Source #

Constructors

Weighted 
Unweighted 

Instances

Eq Weighted Source # 
Show Weighted Source # 
Generic Weighted Source # 

Associated Types

type Rep Weighted :: * -> * #

Methods

from :: Weighted -> Rep Weighted x #

to :: Rep Weighted x -> Weighted #

NFData Weighted Source # 

Methods

rnf :: Weighted -> () #

type Rep Weighted Source # 
type Rep Weighted = D1 (MetaData "Weighted" "Eventloop.Module.Graphs.Types" "eventloop-0.8.2.5-2xkWAiRT8jy1Kz4bNfpdit" False) ((:+:) (C1 (MetaCons "Weighted" PrefixI False) U1) (C1 (MetaCons "Unweighted" PrefixI False) U1))

data MouseButton Source #

Instances

Eq MouseButton Source # 
Show MouseButton Source # 
Generic MouseButton Source # 

Associated Types

type Rep MouseButton :: * -> * #

NFData MouseButton Source # 

Methods

rnf :: MouseButton -> () #

type Rep MouseButton Source # 
type Rep MouseButton = D1 (MetaData "MouseButton" "Eventloop.Module.Websocket.Mouse.Types" "eventloop-0.8.2.5-2xkWAiRT8jy1Kz4bNfpdit" False) ((:+:) (C1 (MetaCons "MouseLeft" PrefixI False) U1) ((:+:) (C1 (MetaCons "MouseRight" PrefixI False) U1) (C1 (MetaCons "MouseMiddle" PrefixI False) U1)))