-----------------------------------------------------------------------------
-- |
-- Module      : Hoodle.Widget.Layer
-- Copyright   : (c) 2013-2015 Ian-Woo Kim
--
-- License     : BSD3
-- Maintainer  : Ian-Woo Kim <ianwookim@gmail.com>
-- Stability   : experimental
-- Portability : GHC
--
-- Layer widget
-- 
-----------------------------------------------------------------------------

module Hoodle.Widget.Layer where

import           Control.Lens (view,set,over,(.~))
import           Control.Monad.State 
import           Data.Functor.Identity (Identity(..))
import           Data.List (delete)
import           Data.Sequence
import           Data.Time
import qualified Graphics.Rendering.Cairo as Cairo
--
import           Data.Hoodle.BBox
import           Data.Hoodle.Simple 
import           Graphics.Hoodle.Render.Util.HitTest
--
import           Hoodle.Accessor
import           Hoodle.Coroutine.Draw
import           Hoodle.Coroutine.Layer
import           Hoodle.Coroutine.Pen
import           Hoodle.Device
import           Hoodle.ModelAction.Select
import           Hoodle.Type.Canvas
import           Hoodle.Type.Coroutine
import           Hoodle.Type.Enum
import           Hoodle.Type.Event
import           Hoodle.Type.HoodleState 
import           Hoodle.Type.PageArrangement
import           Hoodle.Type.Widget
import           Hoodle.View.Coordinate
import           Hoodle.View.Draw

-- |
data LWAction = Close | ToggleShowContent | Move (CanvasCoordinate,CanvasCoordinate)

checkPointerInLayer :: (CanvasId,CanvasInfo a,CanvasGeometry) 
                    -> PointerCoord 
                    -> Maybe LWAction 
checkPointerInLayer (_cid,cinfo,geometry) pcoord 
  | b =  
    let oxy@(CvsCoord (x,y)) = (desktop2Canvas geometry . device2Desktop geometry) pcoord
        owxy@(CvsCoord (x0,y0)) = view (canvasWidgets.layerWidgetConfig.layerWidgetPosition) cinfo
        obbox = BBox (x0,y0) (x0+100,y0+100) 
        closebbox = BBox (x0,y0) (x0+10,y0+10)
        r | isPointInBBox closebbox (x,y) = Just Close
          | hitLassoPoint (fromList [(x0+90,y0+40),(x0+100,y0+50),(x0+90,y0+60)]) (x,y) = Just ToggleShowContent     
        
          | isPointInBBox obbox (x,y)     = Just (Move (oxy,owxy))
          | otherwise                     = Nothing   
    in r
  | otherwise = Nothing 
  where b = view (canvasWidgets.widgetConfig.doesUseLayerWidget) cinfo 

startLayerWidget :: (CanvasId,CanvasInfo a,CanvasGeometry)
                 -> LWAction 
                 -> MainCoroutine () 
startLayerWidget (cid,_cinfo,_geometry) Close = toggleLayer cid 
startLayerWidget (cid,_cinfo,_geometry) ToggleShowContent = do 
    modify $ over (unitHoodles.currentUnit)
             $ over (currentCanvasInfo . unboxLens (canvasWidgets.layerWidgetConfig.layerWidgetShowContent)) not
    invalidate cid 
startLayerWidget (cid,cinfo,geometry) (Move (oxy,owxy)) = do 
    xst <- get 
    cache <- renderCache
    let uhdl = view (unitHoodles.currentUnit) xst
        hdl = getHoodle uhdl
    (srcsfc,Dim wsfc hsfc) <- liftIO (canvasImageSurface cache cid Nothing geometry hdl)
    -- need to draw other widgets here                             
    let otherwidgets = delete LayerWidget allWidgets 
    liftIO $ Cairo.renderWith srcsfc (drawWidgets otherwidgets hdl cinfo Nothing) 
    -- end : need to draw other widgets here ^^^
    tgtsfc <- liftIO $ Cairo.createImageSurface 
                         Cairo.FormatARGB32 (floor wsfc) (floor hsfc)
    ctime <- liftIO getCurrentTime 
    let CvsCoord (x0,y0) = owxy 
        CvsCoord (x,y) = oxy 
        act 
          | hitLassoPoint (fromList [(x0+80,y0),(x0+100,y0),(x0+100,y0+20)]) (x,y) = gotoNextLayer
          | hitLassoPoint (fromList [(x0,y0+80),(x0,y0+100),(x0+20,y0+100)]) (x,y) = gotoPrevLayer 
          | otherwise = manipulateLW cid geometry (srcsfc,tgtsfc) owxy oxy ctime 
    act
    liftIO $ Cairo.surfaceFinish srcsfc 
    liftIO $ Cairo.surfaceFinish tgtsfc
  
-- | main event loop for layer widget
manipulateLW :: CanvasId 
             -> CanvasGeometry 
             -> (Cairo.Surface,Cairo.Surface) 
             -> CanvasCoordinate 
             -> CanvasCoordinate 
             -> UTCTime 
             -> MainCoroutine () 
manipulateLW cid geometry (srcsfc,tgtsfc) owxy oxy otime = do 
    r <- nextevent
    case r of 
      PenMove _ pcoord -> do 
        processWithDefTimeInterval
          (manipulateLW cid geometry (srcsfc,tgtsfc) owxy oxy) 
          (\ctime -> moveLayerWidget cid geometry (srcsfc,tgtsfc) owxy oxy pcoord 
                     >> manipulateLW cid geometry (srcsfc,tgtsfc) owxy oxy ctime)
          otime 
      PenUp _ _pcoord -> invalidate cid 
      _ -> return ()

moveLayerWidget :: CanvasId 
                   -> CanvasGeometry 
                   -> (Cairo.Surface,Cairo.Surface) 
                   -> CanvasCoordinate 
                   -> CanvasCoordinate 
                   -> PointerCoord
                   -> MainCoroutine ()
moveLayerWidget cid geometry (srcsfc,tgtsfc) (CvsCoord (xw,yw)) (CvsCoord (x0,y0)) pcoord = do 
    let CvsCoord (x,y) = (desktop2Canvas geometry . device2Desktop geometry) pcoord 
    get >>= \xst -> do
      let uhdl = view (unitHoodles.currentUnit) xst
          CanvasDimension (Dim cw ch) = canvasDim geometry 
          cinfobox = getCanvasInfo cid uhdl
          nposx | xw+x-x0 < -50 = -50 
                | xw+x-x0 > cw-50 = cw-50 
                | otherwise = xw+x-x0
          nposy | yw+y-y0 < -50 = -50 
                | yw+y-y0 > ch-50 = ch-50 
                | otherwise = yw+y-y0                             
          nwpos = CvsCoord (nposx,nposy) 
          changeact :: CanvasInfo a -> CanvasInfo a 
          changeact cinfo =  
            set (canvasWidgets.layerWidgetConfig.layerWidgetPosition) nwpos $ cinfo
          ncinfobox = (runIdentity . forBoth unboxBiXform (return . changeact)) cinfobox
      put $ (unitHoodles.currentUnit .~ setCanvasInfo (cid,ncinfobox) uhdl) xst
      -- 
      xst2 <- get 
      let uhdl2 = view (unitHoodles.currentUnit) xst2
          hdl2 = getHoodle uhdl2
          cinfobox2 = getCanvasInfo cid uhdl2
      liftIO $ forBoth' unboxBiAct (\cinfo-> virtualDoubleBufferDraw srcsfc tgtsfc (return ()) 
                                      (drawLayerWidget hdl2 cinfo Nothing nwpos) 
                                    >> doubleBufferFlush tgtsfc cinfo) cinfobox2
  
-- | 
toggleLayer :: CanvasId -> MainCoroutine () 
toggleLayer cid = do 
    pureUpdateUhdl $ \uhdl -> 
      let ncinfobox = (over (unboxLens (canvasWidgets.widgetConfig.doesUseLayerWidget)) not 
                      . getCanvasInfo cid ) uhdl
      in setCanvasInfo (cid,ncinfobox) uhdl
    invalidateInBBox Nothing Efficient cid