module FPPrac.Graphs 
        ( Label
        , Weight
        , Node
        , Edge
        , Graph(..)
        , ColorG(..)
        , Thickness(..)
        , Directed(..)
        , Weighted(..)
        , GraphOutput(..)
        , GraphInput(..)
        , Pos
        , MouseButton(..)
        , KeyboardButton
        , onNode
        , preEventloop
        ) where

import Prelude
import EventLoop        
import EventLoop.Input as EI
import EventLoop.Output

type Vector = (Float, Float)
        
----- Graph -----

type Label   = Char
type Weight  = Float

type Node = (Label, Pos, ColorG)
type Edge = (Label, Label, ColorG, Weight)

data Graph = Graph
            { nodes    :: [Node]
            , edges    :: [Edge]
            , directed :: Directed
            , weighted :: Weighted
            } deriving (Eq, Show)


----- Graph Graphical -----            
            
data ColorG = Red
            | Blue
            | Green
            | Purple
            | Grey
            | Yellow
            | Orange
            | Black
            | White
            deriving (Eq, Show)

data Thickness = Thin
               | Thick
               deriving (Eq, Show)

data Directed  = Directed
               | Undirected
                deriving (Eq, Show)
               
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
                 deriving (Eq, Show)

nodeRadius   = 20 :: Float                 
textSize     = 16 :: Float
textFont     = "Courier"
xArrowSize   = 6 :: Float
yArrowSize   = 6 :: Float
weightHeight = 10 :: Float

topInstructions = 440
dimCanvas = (840,840)
canvasWidth = fst dimCanvas
canvasHeight = snd dimCanvas
                      

-- | 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
                                     | otherwise                = onNode ns (x,y)
                                    where
                                        dx         = nx - x
                                        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')
                                where
                                    inputE'            = inputEventToGraphIn inputE
                                    (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
                                            col   = colorGToColor colG
                                            nodeG = GObject [l] (Arc black 1 col pos nodeRadius 0 360) []
                                            textG = GObject [l] (Text white 1 white pos textSize textFont [l] True) []

graphOutputToGraphical (LineG (l1, pos1, _) (l2, pos2, _) colG thick direct) | direct == Directed   = [Draw (Container [line, arrow1, arrow2]) name]
                                                                             | direct == Undirected = [Draw line name]
                                                                            where
                                                                                name   = lineName l1 l2
                                                                                col    = colorGToColor colG
                                                                                thick' = thicknessToFloat thick
                                                                                line   = GObject name (Line col thick' [lineStart, lineEnd]) []
                                                                                arrow1 = GObject name (Line col thick' [arrowStart, arrow1End]) []
                                                                                arrow2 = GObject name (Line col thick' [arrowStart, arrow2End]) []
                                                                                --Vector stuff
                                                                                lineVector         = vectorize pos1 pos2
                                                                                lineVector'        = vectorize pos2 pos1
                                                                                lineStart          = posOnVector nodeRadius lineVector pos1
                                                                                lineEnd            = posOnVector nodeRadius lineVector' pos2
                                                                                arrowPerpStart     = posOnVector xArrowSize lineVector' lineEnd  
                                                                                upPerpLineVector   = upPerpendicularTo pos1 pos2
                                                                                downPerpLineVector = downPerpendicularTo pos1 pos2
                                                                                arrowStart         = lineEnd
                                                                                arrow1End          = posOnVector yArrowSize upPerpLineVector arrowPerpStart  
                                                                                arrow2End          = posOnVector yArrowSize downPerpLineVector arrowPerpStart 

graphOutputToGraphical (WeightedLineG n1@(l1, pos1, _) n2@(l2, pos2, _) w colG thick direct) = lineGraphical ++ [Draw text name]
                                                                where
                                                                    name          = lineName l1 l2
                                                                    col           = colorGToColor colG
                                                                    lineGraphical = graphOutputToGraphical (LineG n1 n2 colG thick direct)
                                                                    text          = GObject name (Text col 1 col textPos textSize textFont (show w) True) []
                                                                    --Vector stuff
                                                                    lineVector'       = vectorize pos2 pos1
                                                                    halfSize          = vectorSize lineVector' / 2
                                                                    upPerpLineVector  = upPerpendicularTo pos2 pos1
                                                                    textPerpStart     = posOnVector halfSize lineVector' pos2
                                                                    textPos           = posOnVector weightHeight upPerpLineVector textPerpStart

graphOutputToGraphical (Instructions is) = [RemoveGroup "instructions", Draw isG' "instructions"]
                                        where
                                            lineG       = GObject "instructions" (Line black lineHeight [(0,topInstructions), (canvasWidth, topInstructions)]) []
                                            defaultText = (\str pos -> GObject "instructions" (Text black 1 black pos textSize textFont str False) [])
                                            lineHeight  = 2
                                            textMargin  = 2
                                            positions   = iterate ((+) (textSize + textMargin)) (topInstructions + lineHeight)
                                            isWithPos   = zip is positions
                                            isG         = map (\(str, top) -> defaultText str (0, top)) isWithPos
                                            isG'        = Container (lineG:isG)

graphOutputToGraphical (RemoveNodeG l)     = [RemoveGroup [l]]
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)
colorGToColor Green  = (0, 255, 0)
colorGToColor Purple = (255, 0, 255)
colorGToColor Grey   = (125, 125, 125)
colorGToColor Yellow = (255, 255, 0)
colorGToColor Orange = (255, 125, 0)
colorGToColor Black  = (0, 0, 0)
colorGToColor White  = (255, 255, 255)

black = colorGToColor Black                                    
white = colorGToColor White


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