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)