module NetworkView
    ( drawCanvas
    , clickedNode
    , clickedNodePort
    , clickedEdge
    , clickedVia
    , edgeContains
    ) where

import Constants
import CommonIO
import Network
import Document
import Colors
import Common
import Palette
import Ports
import Math
import Graphics.UI.WX as WX hiding (Vector, Selection)
import Graphics.UI.WXCore hiding (Document, screenPPI, Colour, Palette)
import Graphics.UI.WXCore.Draw
import Data.Maybe
import Shape
import DisplayOptions
import InfoKind

import Prelude hiding (catch)
import Control.Exception
import qualified Data.IntMap as IntMap
import Data.List

drawCanvas :: (InfoKind n g, InfoKind e g) =>
              Network g n e -> Palette n -> Selection -> [NodeNr] -- interface nodes mapped
              -> DC () -> DisplayOptions -> IO ()
drawCanvas net palette selec p dc opt =
  do{

    -- Scale if the DC we are drawing to has a different PPI from the screen
    -- Printing, nudge, nudge
    ; dcPPI <- dcGetPPI dc
    ; screenPPI <- getScreenPPI
    ; when (dcPPI /= screenPPI) $
        dcSetUserScale dc
            (fromIntegral (sizeW dcPPI ) / fromIntegral (sizeW screenPPI ))
            (fromIntegral (sizeH dcPPI ) / fromIntegral (sizeH screenPPI ))

    -- Set font
    ; set dc [ fontFamily := FontDefault, fontSize := 10 ]

    ; catch (reallyDrawCanvas net palette selec p screenPPI dc opt)
        (\e -> logicalText dcPPI dc (DoublePoint 50 50)
                           ("Exception while drawing: "++show e)
                           (Justify LeftJ TopJ)  [] )
    }

reallyDrawCanvas :: (InfoKind n g, InfoKind e g) =>
                    Network g n e -> Palette n -> Selection -> [NodeNr]
                    -> Size -> DC () -> DisplayOptions -> IO ()
reallyDrawCanvas network palette theSelection mapp ppi dc opt =
  do{
    -- draw edges, highlight the selected ones (if any)
      ; mapM_ (\edge -> drawEdge edge []) (getEdgeAssocs network)
      ; case theSelection of
        EdgeSelection _ edgeNr -> do
            drawEdge (edgeNr, getEdge edgeNr network) kSELECTED_OPTIONS
        ViaSelection _ edgeNr viaNr -> do
            drawVia (getEdge edgeNr network) viaNr kSELECTED_OPTIONS
        MultipleSelection _ _ _ viaNrs -> do
            mapM_ (\ (e,v)-> drawVia (getEdge e network) v kSELECTED_OPTIONS)
                  viaNrs
        _ -> return ()

    -- draw nodes, highlight the selected ones (if any)
    ; mapM_ (\(nodeNr, _) -> drawNode nodeNr [ ]) (getNodeAssocs network)
    ; case theSelection of
        NodeSelection _ nodeNr mPort ->
           do drawNode nodeNr (kSELECTED_OPTIONS
                            ++ [ penColor := wxcolor activeSelectionColor ])
              case mPort of
                 Nothing       -> return ()
                 Just str      -> drawPort ppi dc
                                           (getPosition $ getNode nodeNr network)
                                           [brushKind  := BrushSolid
                                           , brushColor := kPortSelectedColor]
					   $ snd $ takeJust "inexistent port" $ getPort palette network (nodeNr, str)
        MultipleSelection _ _ nodeNrs _ ->
            mapM_ (\n-> drawNode n (kSELECTED_OPTIONS
                            ++ [ penColor := wxcolor activeSelectionColor ]))
                  nodeNrs
        _ -> return ()

    -- multiple selection drag area rectangle
    ; case theSelection of
        MultipleSelection _ (Just (p,q)) _ _ ->
                logicalRect ppi dc (doublePointX p) (doublePointY p)
                                   (doublePointX q - doublePointX p)
                                   (doublePointY q - doublePointY p)
                                   [ penColor  := wxcolor lightGrey
                                   , brushKind := BrushTransparent]
        _ -> return ()

    -- canvas size rectangle
 -- ; let (width, height) = Network.getCanvasSize (getNetwork doc)
 -- ; logicalRect ppi dc 0 0 width height [brushKind := BrushTransparent]
    }
  where
    drawNode :: Int -> [Prop (DC ())] -> IO ()
    drawNode nodeNr options =
      do{
        -- draw node
        ; logicalDraw ppi dc center shape options
    --  ; logicalCircle ppi dc center kNODE_RADIUS options
        ; drawPorts ppi dc center ports options

	-- draw label
        ; when (NodeLabel `elem` dpShowInfo opt) $
              drawLabel (offset above) False (getName node) center
                        (justif above) [ textColor := wxcolor kNodeLabelColour ] 
	-- draw info
        ; when (NodeInfo `elem` dpShowInfo opt) $
              drawLabel (offset (not above)) False (show (getInfo node))
                        center (justif (not above))
                        [ textColor := wxcolor kNodeInfoColour ]
        
        -- draw mapping numbering when needed
        ; maybe ( return () )
                showInterfaceMap
                $ findIndex (nodeNr ==) mapp

        }
      where
        node   = getNode nodeNr network
        above  = getNameAbove node
        center = getPosition node
        symbol = takeJust "No symbol definition"
			$ getSymbol (getShape node) palette
        shape  = fst3 symbol
        ports  = snd3 symbol

        offset b = (if b then negate else id) kNODE_RADIUS
        justif b = Justify CentreJ (if b then BottomJ else TopJ)
        
        showInterfaceMap n = 
              drawLabel 0.15 True (show $ succ n) center
                        (justif above) [ textColor := wxcolor kNodeMapColour ]

    drawLabel :: Double -> Bool -> String -> DoublePoint -> Justify
                 -> [Prop (DC ())] -> IO ()
    drawLabel voffset boxed text (DoublePoint x y) justify opts =
      do{ -- draw background
          when boxed $ do
            { (textWidth, textHeight) <- logicalGetTextExtent ppi dc text
            ; let horizontalMargin = 0.2 -- centimeters
                  verticalMargin = 0.01 -- centimeters
                  topleftY = y+voffset - case justify of
                                           Justify _ TopJ    -> 0
                                           Justify _ MiddleJ -> textHeight/2
                                           Justify _ BottomJ -> textHeight
                  
            ; logicalRect ppi dc
                (x - textWidth/2 - horizontalMargin) (topleftY)
                (textWidth+2*horizontalMargin) (textHeight+2*verticalMargin)
                (solidFill labelBackgroundColor)
            }
        -- draw text
        ; logicalText ppi dc (DoublePoint x (y+voffset)) text justify opts
        }

    isPrincipalPort' (nodeNr, port) =
         isPrincipalPort palette network nodeNr port && not (isInterfacePort port)
    isPrincipalPort' _ = False

    drawEdge :: InfoKind e g => (EdgeNr, Edge e) -> [Prop (DC ())] -> IO ()
    drawEdge (edgeNr, edge) options  =
      do{ logicalLineSegments ppi dc (pt1:via++[pt2]) options
        -- arrow on the end
        -- ; logicalPoly ppi dc [pt2, tr1, tr2] (options ++ solidFill licorice)
        
        -- arrow(s) on principal ports
        ; when hasPrincipalPorts 
             $ do when (isPrincipalPort' fromPort)
                    $ logicalLine ppi dc [tw1, pw1, tw2] options 
                  when (isPrincipalPort' toPort) 
                    $ logicalLine ppi dc [tw3, pw2, tw4] options
	
	-- draw label
        ; when (EdgeLabel `elem` dpShowInfo opt) $
              drawLabel 0 False (int2name edgeNr) 
                        (translate (DoublePoint 0.2 0.1 )$ middle via)
                        (Justify LeftJ TopJ)
                        [ textColor := wxcolor kEdgeLabelColour ] 

        -- draw info
        ; when (EdgeInfo `elem` dpShowInfo opt) $
           -- logicalTextRotated ppi dc (middle via) (show info) 45
           --           [ textColor := wxcolor kEdgeInfoColour ]
              drawLabel 0 False (show (getEdgeInfo edge)) (middle via)
                        (Justify CentreJ BottomJ)
                        [ textColor := wxcolor kEdgeInfoColour ]
        }
      where
        fromNode   = getNode (getEdgeFrom edge) network
        toNode     = getNode (getEdgeTo   edge) network

        fromPort   = getFullPortFrom edge
        toPort     = getFullPortTo edge
        
        radius = kPortRadius
        fromNodePoint = getPosition fromNode
        toNodePoint   = getPosition toNode

	fromPortPosition = snd . takeJust "Inexistent port" $ getPort palette network fromPort
	toPortPosition   = snd . takeJust "Inexistent port" $ getPort palette network toPort

        fromPoint  = translate fromNodePoint fromPortPosition
        toPoint    = translate toNodePoint   toPortPosition
        via        = getEdgeVia edge

        fstEdgeVector = (head (via++[toPoint]))
                             `subtractDoublePointVector` fromPoint
        fstTotalLen   = vectorLength fstEdgeVector
        fstAngle      = vectorAngle fstEdgeVector

        penultimatePt = head (reverse (fromPoint:via))
        endEdgeVector = toPoint `subtractDoublePointVector` penultimatePt
        endTotalLen   = vectorLength endEdgeVector
        endAngle      = vectorAngle endEdgeVector

        middle []  = DoublePoint ((doublePointX pt1 + doublePointX pt2)/2)
                                 ((doublePointY pt1 + doublePointY pt2)/2)
        middle [p] = p
        middle ps  = middle (tail (reverse ps))

        pt1 = translatePolar fstAngle radius fromPoint
        pt2 = translatePolar endAngle (endTotalLen - radius) penultimatePt

        tr1 = translatePolar (endAngle + pi + pi / 6) kARROW_SIZE pt2
        tr2 = translatePolar (endAngle + pi - pi / 6) kARROW_SIZE pt2

        pw1 = translatePolar fstAngle (radius + kARROW_SIZE) fromPoint
        pw2 = translatePolar endAngle (endTotalLen - radius - kARROW_SIZE) penultimatePt

        tw1 = translatePolar (fstAngle + pi + pi / 6) kARROW_SIZE pw1
        tw2 = translatePolar (fstAngle + pi - pi / 6) kARROW_SIZE pw1

        tw3 = translatePolar (endAngle + pi / 6) kARROW_SIZE pw2
        tw4 = translatePolar (endAngle - pi / 6) kARROW_SIZE pw2

    drawVia :: Edge e -> ViaNr -> [Prop (DC ())] -> IO ()
    drawVia e n options =
        let pt = (getEdgeVia e)!!n in
        do logicalCircle ppi dc pt kEDGE_CLICK_RANGE
                (options ++ solidFill violet)

solidFill :: Colour -> [Prop (DC ())]
solidFill colour = [ brushKind := BrushSolid, brushColor := wxcolor colour ]

-- | Finds which node of the network is clicked by the mouse, if any
clickedNode :: DoublePoint -> Document g n e -> ActiveCanvas -> Maybe Int
clickedNode clickedPoint doc canvas =
    let network = selectNetwork doc canvas 
        nodeAssocs = case getSelection doc of
                        NodeSelection canv nodeNr _ 
                            | canv == canvas -> [(nodeNr, getNode nodeNr network)]
                            | otherwise -> []
                        _ -> []
                  ++ reverse (getNodeAssocs network)
    in case filter (\(_, node) -> node `nodeContains` clickedPoint) nodeAssocs of
        [] -> Nothing
        ((i, _):_) -> Just i

-- | Finds which node and port of the network is clicked by the mouse, if any
clickedNodePort :: DoublePoint -> Document g n e -> ActiveCanvas
                   -> Maybe (NodeNr, Maybe PortName)
clickedNodePort clickedPoint doc canvas =
    let network = selectNetwork doc canvas 
        nodeAssocs = case getSelection doc of
                        NodeSelection canv nodeNr _ 
                            | canv == canvas -> [(nodeNr, getNode nodeNr network)]
                            | otherwise -> []
                        _ -> []
                  ++ reverse (getNodeAssocs network)
    in case filter (\(_, node) -> node `nodeContains` clickedPoint) nodeAssocs of
        [] -> Nothing
        ((i, n):_) -> case getPorts (getPalette doc) network i of
                        Nothing -> Nothing -- no symbol definition. Shouldn't occur
                        Just ps -> 
			    case filter (\p -> portContains n p clickedPoint) ps of
                               [] -> Just (i, Nothing) -- if the mouse is over a node 
                                                       -- with ports but not over any
                                                       -- of its ports the node is selected
                               (port:_) -> Just (i, Just $ fst port)

nodeContains :: Node n -> DoublePoint -> Bool
nodeContains node clickedPoint =
    distancePointPoint (getPosition node) clickedPoint
      < kNODE_RADIUS

portContains :: Node n -> Port -> DoublePoint -> Bool
portContains node (_, portP) clickedPoint = 
 distancePointPoint portCenter clickedPoint
      < kPortSelectionRadius
 where portCenter = translate (getPosition node) portP

-- | Finds which edge of the network is clicked by the mouse, if any
clickedEdge :: DoublePoint -> Network g n e -> Maybe Int
clickedEdge clickedPoint network =
    let assocs = getEdgeAssocs network
    in case filter (\(_, edge) -> isJust (edgeContains edge clickedPoint network)) assocs of
        [] -> Nothing
        ((i, _):_) -> Just i

edgeContains :: Edge e -> DoublePoint -> Network g n e -> Maybe Int
edgeContains edge clickedPoint network =
    let p0 = getNodePosition network (getEdgeFrom edge)
        p1 = getNodePosition network (getEdgeTo   edge)
        via= getEdgeVia edge
        p  = clickedPoint
        numberedDistancesToSegments = zip [0..] $
              zipWith (\p0 p1-> distanceSegmentPoint p0 p1 p)
                      (p0:via) (via++[p1])
    in case [ nr | (nr,dist) <- numberedDistancesToSegments
                 , dist < kEDGE_CLICK_RANGE ] of
         []  -> Nothing
         nrs -> Just (head nrs)

-- | Finds which 'via' control point is clicked by the mouse, if any
clickedVia :: DoublePoint -> Network g n e -> Maybe (Int,Int)
clickedVia clickedPoint network =
    let allVia = concatMap (\ (k,e)-> zipWith (\n v->((k,n),v))
                                              [0..] (getEdgeVia e))
                           (IntMap.toList (networkEdges network))
    in case filter (\ (_,v)-> distancePointPoint v clickedPoint
                              < kEDGE_CLICK_RANGE) allVia of
        [] -> Nothing
        ((kn,_):_) -> Just kn

-- Drawing operations in logical coordinates

logicalCircle :: Size -> DC () -> DoublePoint -> Double -> [Prop (DC ())] -> IO ()
logicalCircle ppi dc center radius options =
    WX.circle dc (logicalToScreenPoint ppi center) (logicalToScreenX ppi radius) options

logicalRect :: Size -> DC () -> Double -> Double -> Double -> Double -> [Prop (DC ())] -> IO ()
logicalRect ppi dc x y width height options =
    drawRect dc
        (rect
            (pt (logicalToScreenX ppi x)     (logicalToScreenY ppi y))
            (sz (logicalToScreenX ppi width) (logicalToScreenY ppi height)))
        options

data Justify    = Justify Horizontal Vertical	deriving Eq
data Horizontal = LeftJ | CentreJ | RightJ	deriving Eq
data Vertical   = TopJ  | MiddleJ | BottomJ	deriving Eq

-- can deal with multi-line text
logicalText :: Size -> DC () -> DoublePoint -> String -> Justify
               -> [Prop (DC ())] -> IO ()
logicalText ppi dc (DoublePoint x y) txt (Justify horiz vert) options =
  do{ (width,height) <- logicalGetTextExtent ppi dc txt
    ; eachLine width (startPos height) (lines txt)
    }
  where
    startPos height = case vert of TopJ    -> (x, y)
                                   MiddleJ -> (x, y-height/2)
                                   BottomJ -> (x, y-height)
    eachLine _ _ [] = return ()
    eachLine maxwidth (x,y) (txt:txts) =
      do{ (w,h) <- logicalGetTextExtent ppi dc txt
        ; let thisX = case horiz of LeftJ   -> x-maxwidth/2
                                    CentreJ -> x-w/2
                                    RightJ  -> x+(maxwidth/2)-w
        ; drawText dc txt (logicalToScreenPoint ppi (DoublePoint thisX y))
                   options
        ; eachLine maxwidth (x,y+h) txts
        }

-- currently assumes only single line of text
logicalTextRotated :: Size -> DC () -> DoublePoint -> String -> Double
                      -> [Prop (DC ())] -> IO ()
logicalTextRotated ppi dc pos txt angle options =
    draw dc txt (logicalToScreenPoint ppi pos) options
  where
    draw = if angle<1 && angle>(-1) then drawText
           else (\a b c e -> rotatedText a b c angle e)


{-
logicalLine :: Size -> DC () -> DoublePoint -> DoublePoint -> [Prop (DC ())] -> IO ()
logicalLine ppi dc fromPoint toPoint options =
    line dc (logicalToScreenPoint ppi fromPoint)
            (logicalToScreenPoint ppi toPoint) options

logicalLineSegments :: Size -> DC () -> [DoublePoint] -> [Prop (DC ())] -> IO ()
logicalLineSegments _   _  [p]                    options = return ()
logicalLineSegments ppi dc (fromPoint:toPoint:ps) options =
  do{ line dc (logicalToScreenPoint ppi fromPoint)
              (logicalToScreenPoint ppi toPoint) options
    ; logicalLineSegments ppi dc (toPoint:ps) options
    }
-}

logicalPoly :: Size -> DC () -> [DoublePoint] -> [Prop (DC ())] -> IO ()
logicalPoly ppi dc points options =
    polygon dc (map (logicalToScreenPoint ppi) points) options

logicalLine :: Size -> DC () -> [DoublePoint] -> [Prop (DC ())] -> IO ()
logicalLine ppi dc points options =
    polyline dc (map (logicalToScreenPoint ppi) points) options

logicalGetTextExtent :: Size -> DC () -> String -> IO (Double, Double)
logicalGetTextExtent ppi dc txt =
  do{ textSizes <- mapM (getTextExtent dc) (lines txt)
    ; return
        ( screenToLogicalX ppi (maximum (map sizeW textSizes))
        , screenToLogicalY ppi (sum (map sizeH textSizes))
        )
    }