diff --git a/src/FPPrac/Graphs.hs b/src/FPPrac/Graphs.hs --- a/src/FPPrac/Graphs.hs +++ b/src/FPPrac/Graphs.hs @@ -17,6 +17,7 @@ , preEventloop ) where +import Prelude import EventLoop import EventLoop.Input as EI import EventLoop.Output @@ -62,13 +63,15 @@ data Weighted = Weighted | Unweighted deriving (Eq, Show) - + +-- | The output expected in a graph graphical program data GraphOutput = NodeG Label Pos ColorG | LineG Node Node ColorG Thickness Directed | WeightedLineG Node Node Weight ColorG Thickness Directed | Instructions [String] | RemoveNodeG Label | RemoveEdgeG Label Label + | ClearAllG nodeRadius = 20 :: Float textSize = 16 :: Float @@ -83,14 +86,14 @@ canvasHeight = snd dimCanvas ------ Abstracted Input ------ +-- | The input expected in a graph graphical program data GraphInput = MouseUp MouseButton Pos | MouseDown MouseButton Pos | MouseClick MouseButton Pos | KeyPress KeyboardButton | Start - +-- | Checkes to see if there is a node on a certain position onNode :: [Node] -> Pos -> Maybe Node onNode [] _ = Nothing onNode (n@(_, (nx, ny), _):ns) (x,y) | difference <= nodeRadius = Just n @@ -100,13 +103,16 @@ dy = ny - y difference = sqrt (dx^2 + dy^2) - +-- | Starting point for the library. Call this function to start the eventloop with the given handler. +-- Takes 'FPPrac.Graph.Input' and returns 'FPPrac.Graph.Output' instead of the standardized 'EventLoop.Input' +-- and 'EventLoop.Output'. preEventloop :: (a -> GraphInput -> ([GraphOutput], a)) -> a -> IO () preEventloop handler beginState = start handler' beginState where handler' = changeTypes handler - +-- | Changes the eventhandler to use the 'FPPrac.Graphs.GraphInput' instead of the 'EventLoop.Input.InputEvent' +-- Also catches the 'EventLoop.Input.InSysMessage.Setup' message and gives the correct dimensions. changeTypes :: (a -> GraphInput -> ([GraphOutput], a)) -> a -> EI.InputEvent -> ([OutputEvent], a) changeTypes _ state (EI.InSysMessage Setup) = ([OutSysMessage [CanvasSetup dimCanvas]],state) changeTypes handler state inputE = (out, state') @@ -115,20 +121,25 @@ (graphOut, state') = handler state inputE' out = map (\a -> OutGraphical a) $ concat $ map graphOutputToGraphical graphOut - +-- | Abstracts the standardized 'EventLoop.Input.InputEvent' to 'FPPrac.Graphs.GraphInput' inputEventToGraphIn :: EI.InputEvent -> GraphInput inputEventToGraphIn (EI.InKeyboard k) = keyboardToGraphIn k inputEventToGraphIn (EI.InMouse m ) = mouseToGraphIn m inputEventToGraphIn (EI.InSysMessage Background) = Start +-- | Abstracts the standardized 'EventLoop.Input.Mouse' to 'FPPrac.Graphs.GraphInput' mouseToGraphIn :: EI.Mouse -> GraphInput mouseToGraphIn (EI.MouseClick mb p _) = FPPrac.Graphs.MouseClick mb p mouseToGraphIn (EI.MouseUp mb p _) = FPPrac.Graphs.MouseUp mb p mouseToGraphIn (EI.MouseDown mb p _) = FPPrac.Graphs.MouseDown mb p - + +-- | Abstracts the standardized 'EventLoop.Input.Keyboard' to 'FPPrac.Graphs.GraphInput' keyboardToGraphIn :: EI.Keyboard -> GraphInput keyboardToGraphIn (EI.KeyPress k) = FPPrac.Graphs.KeyPress k - + +{-| +Converts the graphical graph output to standardized 'Eventloop.Output.Graphical' output +-} graphOutputToGraphical :: GraphOutput -> [Graphical] graphOutputToGraphical (NodeG l pos colG) = [Draw (Container [nodeG, textG]) [l]] where @@ -182,15 +193,19 @@ isG' = Container (lineG:isG) graphOutputToGraphical (RemoveNodeG l) = [RemoveGroup [l]] -graphOutputToGraphical (RemoveEdgeG l1 l2) = [RemoveGroup (lineName l1 l2)] - +graphOutputToGraphical (RemoveEdgeG l1 l2) = [RemoveGroup (lineName l1 l2)] +graphOutputToGraphical (ClearAllG) = [ClearAll] + +-- | Returns a standardized naming scheme for lines in the graph lineName :: Char -> Char -> String lineName l1 l2 = "line."++[l1]++"."++[l2] - + +-- | Translates the thickness to a float thicknessToFloat :: Thickness -> Float thicknessToFloat Thick = 2.0 thicknessToFloat Thin = 1.0 - + +-- | Translates color datatype to RGB codes colorGToColor :: ColorG -> Color colorGToColor Red = (255, 0, 0) colorGToColor Blue = (0, 0, 255) @@ -205,7 +220,8 @@ black = colorGToColor Black white = colorGToColor White --- The length between Start pos and Result pos is always f + +-- | 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. posOnVector :: Float -> Vector -> Pos -> Pos posOnVector f (xv, yv) (xStart, yStart) = (x, y) where @@ -214,30 +230,27 @@ fraction = f / size size = vectorSize (xv, yv) --- Vector from p1 to p2 +-- | Vector from p1 to p2 vectorize :: Pos -> Pos -> Vector vectorize (x1, y1) (x2, y2) = (x2 - x1, y2 - y1) --- Always has positive y and vector length 1 -upPerpendicularTo :: Pos -> Pos -> Vector -upPerpendicularTo (x1, y1) (x2, y2) | y2 > y1 = (yv1 / size1, -xv1 / size1) - | otherwise = (yv2 / size2, -xv2 / size2) +-- | 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 +downPerpendicularTo :: Pos -> Pos -> Vector +downPerpendicularTo (x1, y1) (x2, y2) | y2 > y1 = ((-1) * sign * (abs yv) / size, (abs xv) / size) + | otherwise = ( sign * (abs yv) / size, (abs xv) / size) where - (xv1, yv1) = vectorize (x1, y1) (x2, y2) - (xv2, yv2) = vectorize (x2, y2) (x1, y1) - size1 = vectorSize (xv1, yv1) - size2 = vectorSize (xv2, yv2) + (xv, yv) = vectorize (x1, y1) (x2, y2) + size = vectorSize (xv, yv) + sign = xv / (abs xv) --- Always has negative y and vector length 1 -downPerpendicularTo :: Pos -> Pos -> Vector -downPerpendicularTo (x1, y1) (x2, y2) | y1 > y2 = (yv1 / size1, -xv1 / size1) - | otherwise = (yv2 / size2, -xv2 / size2) - where - (xv1, yv1) = vectorize (x1, y1) (x2, y2) - (xv2, yv2) = vectorize (x2, y2) (x1, y1) - size1 = vectorSize (xv1, yv1) - size2 = vectorSize (xv2, yv2) +-- | 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 +upPerpendicularTo :: Pos -> Pos -> Vector +upPerpendicularTo p1 p2 = ((-1) * xp, (-1) * yp) + where + (xp, yp) = upPerpendicularTo p1 p2 + +-- | Returns the size of the vector vectorSize :: Vector -> Float vectorSize (x, y) = sqrt (x^2 + y^2) diff --git a/twentefp-graphs.cabal b/twentefp-graphs.cabal --- a/twentefp-graphs.cabal +++ b/twentefp-graphs.cabal @@ -1,5 +1,5 @@ name: twentefp-graphs -version: 0.1.0.0 +version: 0.1.0.1 synopsis: Lab Assignments Environment at Univeriteit Twente description: Lab Assignments Environment at Univeriteit Twente license: BSD3 @@ -14,5 +14,5 @@ exposed-modules: FPPrac.Graphs other-modules: build-depends: base >=4.6.0.0 && < 5, - twentefp-eventloop-graphics >= 0.1.0.2 + twentefp-eventloop-graphics >= 0.1.0.4 hs-source-dirs: src