module Graphics.Rendering.Sifflet.Draw
    (    
     Draw(..), DrawMode(..)
    , drawBox
    , drawTextBox
    , modeTextCol, modeEdgeCol, modeFillCol
    , setColor

    )

where

import Control.Monad
import Graphics.Rendering.Cairo hiding (translate)

import Data.Sifflet.Functoid
import Data.Sifflet.Geometry
import Data.Sifflet.Tree
import Data.Sifflet.TreeLayout

setColor :: VColor -> Render ()

setColor (ColorRGB red green blue) =
    setSourceRGB red green blue 

setColor (ColorRGBA red green blue alpha) =
    setSourceRGBA red green blue alpha

-- Drawing things
-- THINK: is this class well conceived?
-- A lot of things could be done with draw and translate
-- if it were not tied to Style and DrawMode

class Draw a where
    draw :: Style -> DrawMode -> a -> Render ()

-- VV DrawMode is now very awkward, since 
-- a node needs to know not only if it is selected,
-- but which port(s) are selected

data DrawMode = DrawNormal | DrawActive 
              | DrawSelectedNode 
              | DrawSelectedInlet Int 
              | DrawSelectedOutlet Int
                deriving (Eq)

instance Draw FunctoidLayout where
    draw style mode (FLayoutTree t) = draw style mode t
    draw style mode (FLayoutForest f _) = draw style mode f

instance (Draw e) => Draw [e] where
    draw style mode = mapM_ (draw style mode)

instance (Draw e) => Draw (Tree e) where
    draw style mode t = do
      draw style mode (rootLabel t)
      draw style mode (subForest t)

instance Draw (LayoutNode e) where
    draw style mode (LayoutNode gnode _treeBB) = draw style mode gnode

instance Draw (GNode e) where

    draw style mode (GNode _value textboxes nodeBB inlets outlets) = 
        do
          -- draw node box
          let (nodeTextCol, nodeEdgeCol, nodeFillCol) = 
                  case mode of
                    DrawActive -> 
                            (styleActiveTextColor, 
                             styleActiveEdgeColor,
                             styleActiveFillColor)
                    DrawSelectedNode -> 
                            (styleSelectedTextColor, 
                             styleSelectedEdgeColor,
                             styleSelectedFillColor)
                    _ -> (styleNormalTextColor, 
                          styleNormalEdgeColor, 
                          styleNormalFillColor)
                     
          -- (overall box for the node)
          when (styleShowNodeBoxes style) $
                drawBox (Just (nodeFillCol style))
                        (Just (nodeEdgeCol style)) nodeBB
          

          -- assert textboxes has one or two elements
          -- draw the first text box
          drawTextBox (Just (styleFont style))
                      (Just (nodeFillCol style)) -- background
                      Nothing -- frame color
                      (nodeTextCol style) -- text color
                      (head textboxes)

          -- draw the second textbox, if any, using "aux" style
          case (tail textboxes) of
            [tbAux] -> 
                drawTextBox (Just (styleAuxFont style))
                            Nothing
                            Nothing
                            (styleAuxColor style)
                            tbAux
            _ -> return ()


          -- Draw the iolets
          when (styleShowNodePorts style) $ do
             drawInlets style mode inlets
             drawOutlets style mode outlets
          

instance Draw TextBox where
    draw style mode =
        drawTextBox (Just (styleFont style))
                    (Just (modeFillCol mode style)) 
                    Nothing
                    (modeTextCol mode style) 

drawTextBox :: Maybe VFont -> Maybe VColor -> Maybe VColor -> VColor ->
               TextBox -> Render ()
drawTextBox mfont mbgcolor mframecolor textcolor 
            (TextBox text textBB boxBB) = do
  let BBox textX textY _textW _textH = textBB
  drawBox mbgcolor mframecolor boxBB
  setColor textcolor
  case mfont of 
    (Just font) -> setFont font
    _ -> return ()
  moveTo textX textY
  showText text

instance Draw BBox where
  draw style mode = 
      drawBox (Just (modeFillCol mode style)) 
              (Just (modeEdgeCol mode style)) 

drawBox :: Maybe VColor -> Maybe VColor -> BBox -> Render ()
drawBox mBgColor mFgColor (BBox x y w h) = 
    -- draw the BBox, in the specified colors, irrespective of style
    let setup color = 
            do
              rectangle x y w h
              setColor color
    in case (mBgColor, mFgColor) of
         (Just bgColor, Just fgColor) ->
             do
               setup bgColor
               fillPreserve
               setColor fgColor
               stroke
         (Just bgColor, Nothing) -> 
             do
               setup bgColor
               fill
         (Nothing, Just fgColor) -> 
             do
               setup fgColor
               stroke
         _ -> return ()

instance Draw Position where
    draw _style _mode _pos = return () -- bare points are invisible ??? ******

instance Draw Iolet where
    draw style mode (Iolet circle) = draw style mode circle

drawIolet :: Iolet -> VColor -> VColor -> Render ()
drawIolet (Iolet circle) = drawCircle circle

drawInlets :: Style -> DrawMode -> [Iolet] -> Render ()
drawInlets style mode inlets =
    let selected i = mode == DrawSelectedInlet i
    in drawIolets selected style inlets

drawOutlets :: Style -> DrawMode -> [Iolet] -> Render ()
drawOutlets style mode outlets =
    let selected o = mode == DrawSelectedOutlet o
    in drawIolets selected style outlets

drawIolets :: (Int -> Bool) -> Style -> [Iolet] -> Render ()
drawIolets selected style iolets =
  -- (selected n) should be true iff n is the selected iolet
    let loop _ [] = return ()
        loop n (p:ps) = 
          uncurry (drawIolet p)
            (if selected n 
             then (styleSelectedFillColor style, 
                   styleSelectedEdgeColor style)
             else (styleNormalFillColor style, 
                   styleNormalEdgeColor style)) >>
          loop (n + 1) ps
    in loop 0 iolets
                      
instance Draw Circle where
    draw style mode circle = 
        drawCircle circle (modeFillCol mode style) (modeEdgeCol mode style) 

drawCircle :: Circle -> VColor -> VColor -> Render ()
drawCircle (Circle (Position x y) r) bgColor fgColor = do
  newPath -- otherwise we get a line to the arc
  arc x y r 0 (2 * pi)
  setColor bgColor
  fillPreserve
  setColor fgColor
  stroke

-- Helper functions to find the background and foreground colors for a mode

modeFillCol :: DrawMode -> (Style -> VColor)
modeFillCol DrawNormal = styleNormalFillColor
modeFillCol DrawActive = styleActiveFillColor
modeFillCol _ = styleSelectedFillColor

modeTextCol :: DrawMode -> (Style -> VColor)
modeTextCol DrawNormal = styleNormalTextColor
modeTextCol DrawActive = styleActiveTextColor
modeTextCol _ = styleSelectedTextColor

modeEdgeCol :: DrawMode -> (Style -> VColor)
modeEdgeCol DrawNormal = styleNormalEdgeColor
modeEdgeCol DrawActive = styleActiveEdgeColor
modeEdgeCol _ = styleSelectedEdgeColor