module Eventloop.Module.Graphs.Graphs where





import Eventloop.Module.Graphs.Types

import qualified Eventloop.Module.Websocket.Canvas as C

import qualified Eventloop.Module.Websocket.Mouse as M

import qualified Eventloop.Module.Websocket.Keyboard as K

import qualified Eventloop.Module.BasicShapes as BS

import Eventloop.Types.Common

import Eventloop.Types.Events

import Eventloop.Types.System

import Eventloop.Utility.Vectors





setupGraphsModuleConfiguration :: EventloopSetupModuleConfiguration

setupGraphsModuleConfiguration = ( EventloopSetupModuleConfiguration

                                      graphsModuleIdentifier

                                      Nothing

                                      Nothing

                                      (Just graphsPreProcessor)

                                      (Just graphsPostProcessor)

                                      Nothing

                                      Nothing

                                   )



graphsModuleIdentifier :: EventloopModuleIdentifier

graphsModuleIdentifier = "graphs"

                                      





nodeRadius   = 20 :: Float                 

textSize     = 16 :: Float

textFont     = "Courier"

xArrowSize   = 6 :: Float

yArrowSize   = 6 :: Float

weightHeight = 15 :: Float



dimCanvasGraphs = (840,440) :: (Float, Float)

roundDimCanvasGraphs = (round $ fst dimCanvasGraphs, round $ snd dimCanvasGraphs) :: (Int, Int)

canvasGraphsWidth = fst dimCanvasGraphs

canvasGraphsHeight = snd dimCanvasGraphs



instructionsHeight = 200 :: Float

instructionsBeginAt = instructionsHeight + canvasGraphsHeight

canvasInstrWidth = canvasGraphsWidth

canvasInstrHeight = instructionsHeight * 2 + canvasGraphsHeight

dimCanvasInstr = (canvasInstrWidth, canvasInstrHeight)

roundDimCanvasInstr = (round $ fst dimCanvasInstr, round $ snd dimCanvasInstr) :: (Int, Int)



canvasIdGraphs = 1 :: C.CanvasId

canvasIdInstructions = 2 :: C.CanvasId



               

-- | 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

                                     | otherwise                = onNode ns (x,y)

                                    where

                                        dx         = nx - x

                                        dy         = ny - y

                                        difference = sqrt (dx^2 + dy^2)

                 





-- | Abstracts the standardized 'EventLoop.Types.EventTypes' to 'GraphsIn'

graphsPreProcessor :: PreProcessor

graphsPreProcessor sharedConst sharedIOT ioConst ioStateT (InMouse (M.Mouse M.MouseCanvas 1 event (Point p)))

    | x >=0 && y >= 0 && y <= canvasGraphsHeight && x <= canvasGraphsWidth = return [InGraphs $ Mouse event p]

    | otherwise = return []

    where

        (x, y) = p

    

graphsPreProcessor sharedConst sharedIOT ioConst ioStateT k@(InKeyboard (K.Key key))

    = return [k, InGraphs $ Key key]

    

graphsPreProcessor sharedConst sharedIOT ioConst ioStateT inEvent

    = return [inEvent]





-- | Abstracts 'GraphsOut' back to 'BasicShapes' and 'Canvas' events

graphsPostProcessor :: PostProcessor

graphsPostProcessor sharedConst sharedIOT ioConst ioStateT (OutGraphs SetupGraphs)

    = return [ OutCanvas $ C.SetupCanvas canvasIdGraphs  1 roundDimCanvasGraphs (C.CSSPosition C.CSSFromCenter (C.CSSPercentage 50, C.CSSPercentage 50))

             , OutCanvas $ C.SetupCanvas canvasIdInstructions 2 roundDimCanvasInstr (C.CSSPosition C.CSSFromCenter (C.CSSPercentage 50, C.CSSPercentage 50))

             ]

        

                   

graphsPostProcessor sharedConst sharedIOT ioConst ioStateT (OutGraphs (DrawGraph graph))

    = return [ OutCanvas $ C.CanvasOperations canvasIdGraphs [C.Clear C.ClearCanvas]

             , OutBasicShapes $ BS.DrawShapes canvasIdGraphs shapes

             ]

    where

        shapes = graphToShapes graph

    

graphsPostProcessor sharedConst sharedIOT ioConst ioStateT (OutGraphs (Instructions is))

    = return [ OutCanvas $ C.CanvasOperations canvasIdInstructions [C.Clear C.ClearCanvas]

             , OutBasicShapes $ BS.DrawShapes canvasIdInstructions shapes

             ]

    where

        startPLine  = Point (0, 0)

        endPLine    = Point (canvasGraphsWidth, 0)

        lineHeight  = 2

        lineShape   = BS.Line startPLine endPLine lineHeight (0,0,0,255) Nothing

        textShape   = (\line p -> BS.Text line textFont textSize p BS.AlignCenter (0,0,0,255) 0 (0,0,0,0) Nothing)

        textMargin        = 2

        heights           = iterate ((+) (textSize + textMargin)) lineHeight

        isAndHeights      = zip is heights

        instructionShapes = map (\(line, top) -> textShape line $ Point (0.5 * canvasGraphsWidth, top)) isAndHeights

        shapes            = [BS.CompositeShape (lineShape:instructionShapes) (Just (Point (0, instructionsBeginAt))) Nothing]



graphsPostProcessor sharedConst sharedIOT ioConst ioStateT out

    = return [out]

  

-- | Translates color datatype to RGBA codes

colorToRGBAColor :: Color -> BS.Color

colorToRGBAColor Red    = (255, 0, 0, 255)

colorToRGBAColor Blue   = (0, 0, 255, 255)

colorToRGBAColor Green  = (0, 255, 0, 255)

colorToRGBAColor Purple = (255, 0, 255, 255)

colorToRGBAColor Grey   = (125, 125, 125, 255)

colorToRGBAColor Yellow = (255, 255, 0, 255)

colorToRGBAColor Orange = (255, 125, 0, 255)

colorToRGBAColor Black  = (0, 0, 0, 255)

colorToRGBAColor White  = (255, 255, 255, 255)

     

     

-- | Translates the thickness to a float           

thicknessToFloat :: Thickness -> BS.StrokeLineThickness

thicknessToFloat Thick = 3.0

thicknessToFloat Thin  = 1.0





findNode :: [Node] -> Label -> Node

findNode [] l = error ("Tried to find a node in the graph with label '" ++ (show l) ++ "' but could not find it!")

findNode (n@(ln, _, _):ns) l | l == ln = n

                             | otherwise = findNode ns l

                             



graphToShapes :: Graph -> [BS.Shape]

graphToShapes graph

    = (concat nodeShapes) ++ (concat edgeShapes)

    where

        allNodes = nodes graph

        allEdges = edges graph

        isDirected = directed graph

        isWeighted = weighted graph

        allEdgesWithNodes = map (\e@(l1, l2,_,_,_) -> (findNode allNodes l1, findNode allNodes l2, e)) allEdges

        nodeShapes = map nodeToShapes allNodes

        edgeShapes = map (\(n1, n2, e) -> edgeToShapes n1 n2 e isDirected isWeighted) allEdgesWithNodes





nodeToShapes :: Node -> [BS.Shape]

nodeToShapes (l, p, col)

    = [ BS.Circle (Point p) nodeRadius color 2 (0,0,0,255) Nothing

      , BS.Text lStr textFont textSize (Point p) BS.AlignCenter (0,0,0,255) 3 (0,0,0,255) Nothing

      ]

    where

        color = colorToRGBAColor col

        lStr = [l]



        

edgeToShapes :: Node -> Node -> Edge -> Directed -> Weighted -> [BS.Shape]

edgeToShapes (_, p1, _) (_, p2, _) (_, _, col, w, thick) directed weighted

    = lineShape:(weightShapes ++ directShapes)

    where

        directShapes | directed == Directed   = [ BS.Line (Point arrowStart) (Point arrow1End) thickness color Nothing

                                                , BS.Line (Point arrowStart) (Point arrow2End) thickness color Nothing

                                                ]

                     | directed == Undirected = []

        weightShapes | weighted == Weighted   = [BS.Text wStr textFont textSize (Point textPos) BS.AlignCenter (0,0,0,255) 0 (0,0,0,0) Nothing]

                     | weighted == Unweighted = []

                    where

                        wStr = show w

        lineShape = BS.Line (Point lineStart) (Point lineEnd) thickness color Nothing

        thickness = thicknessToFloat thick

        color = colorToRGBAColor col

        -- Margin line vector stuff

        lineVector         = vectorize p1 p2

        lineVector'        = vectorize p2 p1

        lineStart          = posOnVector nodeRadius lineVector p1

        lineEnd            = posOnVector nodeRadius lineVector' p2

        -- Arrow directed vector stuff

        arrowPerpStart     = posOnVector xArrowSize lineVector' lineEnd  

        upPerpLineVector   = upPerpendicularTo p1 p2

        downPerpLineVector = downPerpendicularTo p1 p2

        arrowStart         = lineEnd

        arrow1End          = posOnVector yArrowSize upPerpLineVector arrowPerpStart  

        arrow2End          = posOnVector yArrowSize downPerpLineVector arrowPerpStart

        -- Weight vector stuff

        halfSize          = vectorSize lineVector' / 2

        textPerpStart     = posOnVector halfSize lineVector p1

        textPos           = posOnVector weightHeight upPerpLineVector textPerpStart

        



-- | 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

                                            x        = xStart + fraction * xv

                                            y        = yStart + fraction * yv

                                            fraction = f / size

                                            size     = vectorSize (xv, yv)



-- | Vector from p1 to p2 

vectorize :: Pos -> Pos -> Vector

vectorize (x1, y1) (x2, y2) = (x2 - x1, y2 - y1)





-- | 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

                                          (xv, yv) = vectorize (x1, y1) (x2, y2)

                                          size     = vectorSize (xv, yv)

                                          sign     = case xv of

                                                        0 -> (-1)

                                                        _ -> xv / (abs xv)

                                            

                                            

-- | 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) = downPerpendicularTo p1 p2

                          

-- | Returns the size of the vector                          

vectorSize :: Vector -> Float

vectorSize (x, y) = sqrt (x^2 + y^2)