{-# LANGUAGE OverloadedStrings #-}

-----------------------------------------------------------------------------
-- |
-- Module      : Hoodle.Coroutine.ContextMenu
-- Copyright   : (c) 2011-2013 Ian-Woo Kim
--
-- License     : BSD3
-- Maintainer  : Ian-Woo Kim <ianwookim@gmail.com>
-- Stability   : experimental
-- Portability : GHC
--
-----------------------------------------------------------------------------

module Hoodle.Coroutine.ContextMenu where

-- from other packages
import           Control.Applicative
import           Control.Category
import           Control.Lens (view,set,(%~))
import           Control.Monad.State
import           Data.Attoparsec 
import qualified Data.ByteString.Char8 as B
import qualified Data.IntMap as IM
import           Data.Monoid
import           Data.UUID.V4 
import           Graphics.Rendering.Cairo
import           Graphics.UI.Gtk hiding (get,set)
import           System.Directory 
import           System.FilePath
import           System.Process
-- from hoodle-platform
import           Control.Monad.Trans.Crtn.Event
import           Control.Monad.Trans.Crtn.Queue 
import           Data.Hoodle.BBox
import           Data.Hoodle.Generic
import           Data.Hoodle.Select
import           Data.Hoodle.Simple (SVG(..),Item(..),Link(..),hoodleID)
import           Graphics.Hoodle.Render
import           Graphics.Hoodle.Render.Item
import           Graphics.Hoodle.Render.Type
import           Graphics.Hoodle.Render.Type.HitTest
import qualified Text.Hoodle.Parse.Attoparsec as PA
-- from this package 
import           Hoodle.Accessor
import           Hoodle.Coroutine.Commit 
import           Hoodle.Coroutine.Draw
import           Hoodle.Coroutine.File
import           Hoodle.Coroutine.Scroll
import           Hoodle.Coroutine.Select.Clipboard 
import           Hoodle.Coroutine.TextInput 
import           Hoodle.ModelAction.ContextMenu
import           Hoodle.ModelAction.Page 
import           Hoodle.ModelAction.Select
import           Hoodle.ModelAction.Select.Transform
import           Hoodle.Script.Hook
import           Hoodle.Type.Coroutine
import           Hoodle.Type.Event
import           Hoodle.Type.HoodleState
import           Hoodle.Type.PageArrangement 
import           Hoodle.Util
--
import Prelude hiding ((.),id)

processContextMenu :: ContextMenuEvent -> MainCoroutine () 
processContextMenu (CMenuSaveSelectionAs ityp) = do 
  xst <- get
  case getSelectedItmsFromHoodleState xst of
    Nothing -> return ()
    Just hititms ->
      let ulbbox = (unUnion . mconcat . fmap (Union . Middle . getBBox)) hititms 
      in case ulbbox of 
           Middle bbox -> 
             case ityp of 
               TypSVG -> exportCurrentSelectionAsSVG hititms bbox
               TypPDF -> exportCurrentSelectionAsPDF hititms bbox
           _ -> return () 
processContextMenu CMenuCut = cutSelection
processContextMenu CMenuCopy = copySelection
processContextMenu CMenuDelete = deleteSelection
processContextMenu (CMenuCanvasView cid pnum _x _y) = do 
    xstate <- get 
    let cmap = view cvsInfoMap xstate 
    let mcinfobox = IM.lookup cid cmap 
    case mcinfobox of 
      Nothing -> liftIO $ putStrLn "error in processContextMenu"
      Just _cinfobox -> do 
        cinfobox' <- liftIO (setPage xstate pnum cid)
        put $ set cvsInfoMap (IM.adjust (const cinfobox') cid cmap) xstate 
        adjustScrollbarWithGeometryCvsId cid 
        invalidateAll 
processContextMenu CMenuRotateCW = return () -- rotateSelection CW
processContextMenu CMenuRotateCCW = return () --  rotateSelection CCW
processContextMenu CMenuAutosavePage = do 
    xst <- get 
    pg <- getCurrentPageCurr 
    maybe (return ()) liftIO $ do 
      hset <- view hookSet xst
      customAutosavePage hset <*> pure pg 
processContextMenu (CMenuLinkConvert nlnk) = 
    either (const (return ())) action 
      . hoodleModeStateEither 
      . view hoodleModeState =<< get 
  where action thdl = do 
          xst <- get 
          case view gselSelected thdl of 
            Nothing -> return () 
            Just (n,tpg) -> do 
              let activelayer = rItmsInActiveLyr tpg
                  buf = view (glayers.selectedLayer.gbuffer) tpg
              ntpg <- case activelayer of 
                Left _ -> return tpg 
                Right (a :- _b :- as ) -> liftIO $ do
                  let nitm = ItemLink nlnk
                  nritm <- cnstrctRItem nitm
                  let alist' = (a :- Hitted [nritm] :- as )
                      layer' = GLayer buf . TEitherAlterHitted . Right $ alist'
                  return (set (glayers.selectedLayer) layer' tpg)
                Right _ -> error "processContextMenu: activelayer"
              nthdl <- liftIO $ updateTempHoodleSelectIO thdl ntpg n
              commit . set hoodleModeState (SelectState nthdl)
                =<< (liftIO (updatePageAll (SelectState nthdl) xst))
              invalidateAll 
processContextMenu CMenuCreateALink = do 
  liftIO $ putStrLn "create a link called"
  mfilename <- fileChooser FileChooserActionOpen Nothing
  case mfilename of 
    Nothing -> return () 
    Just fname -> do 
      xst <- get 
      case getSelectedItmsFromHoodleState xst of 
        Nothing -> return () 
        Just hititms -> 
          let ulbbox = (unUnion . mconcat . fmap (Union . Middle . getBBox)) hititms 
          in case ulbbox of 
               Middle bbox@(BBox (ulx,uly) (lrx,lry)) -> do 
                 svg <- liftIO $ makeSVGFromSelection hititms bbox
                 uuid <- liftIO $ nextRandom
                 let uuidbstr = B.pack (show uuid) 
                 deleteSelection 
                 linkInsert "simple" (uuidbstr,fname) fname (svg_render svg,bbox)  
               _ -> return () 
processContextMenu CMenuCustom =  
    either (const (return ())) action . hoodleModeStateEither . view hoodleModeState =<< get 
  where action thdl = do    
          xst <- get 
          case view gselSelected thdl of 
            Nothing -> return () 
            Just (_,tpg) -> do 
              let hititms = (map rItem2Item . getSelectedItms) tpg  
              maybe (return ()) liftIO $ do 
                hset <- view hookSet xst    
                customContextMenuHook hset <*> pure hititms
          
-- | 
exportCurrentSelectionAsSVG :: [RItem] -> BBox -> MainCoroutine () 
exportCurrentSelectionAsSVG hititms bbox@(BBox (ulx,uly) (lrx,lry)) = 
    fileChooser FileChooserActionSave Nothing >>= maybe (return ()) action 
  where 
    action filename =
      -- this is rather temporary not to make mistake 
      if takeExtension filename /= ".svg" 
      then fileExtensionInvalid (".svg","export") 
           >> exportCurrentSelectionAsSVG hititms bbox
      else do      
        liftIO $ withSVGSurface filename (lrx-ulx) (lry-uly) $ \s -> renderWith s $ do 
          translate (-ulx) (-uly)
          mapM_ renderRItem  hititms


exportCurrentSelectionAsPDF :: [RItem] -> BBox -> MainCoroutine () 
exportCurrentSelectionAsPDF hititms bbox@(BBox (ulx,uly) (lrx,lry)) = 
    fileChooser FileChooserActionSave Nothing >>= maybe (return ()) action 
  where 
    action filename =
      -- this is rather temporary not to make mistake 
      if takeExtension filename /= ".pdf" 
      then fileExtensionInvalid (".svg","export") 
           >> exportCurrentSelectionAsPDF hititms bbox
      else do      
        liftIO $ withPDFSurface filename (lrx-ulx) (lry-uly) $ \s -> renderWith s $ do 
          translate (-ulx) (-uly)
          mapM_ renderRItem  hititms


showContextMenu :: (PageNum,(Double,Double)) -> MainCoroutine () 
showContextMenu (pnum,(x,y)) = do 
    xstate <- get
    when (view (settings.doesUsePopUpMenu) xstate) $ do 
      let cids = IM.keys . view cvsInfoMap $ xstate
          cid = fst . view currentCanvas $ xstate 
          mselitms = do lst <- getSelectedItmsFromHoodleState xstate
                        if null lst then Nothing else Just lst 
      modify (tempQueue %~ enqueue (action xstate mselitms cid cids)) 
      >> waitSomeEvent (\e->case e of ContextMenuCreated -> True ; _ -> False) 
      >> return () 
  where action xstate msitms cid cids  
          = Left . ActionOrder $ 
              \evhandler -> do 
                menu <- menuNew 
                menuSetTitle menu "MyMenu"
                case msitms of 
                  Nothing -> return ()
                  Just sitms -> do 
                    menuitem1 <- menuItemNewWithLabel "Make SVG"
                    menuitem2 <- menuItemNewWithLabel "Make PDF"
                    menuitem3 <- menuItemNewWithLabel "Cut"
                    menuitem4 <- menuItemNewWithLabel "Copy"
                    menuitem5 <- menuItemNewWithLabel "Delete"
                    menuitem1 `on` menuItemActivate $   
                      evhandler (GotContextMenuSignal (CMenuSaveSelectionAs TypSVG))
                    menuitem2 `on` menuItemActivate $ 
                      evhandler (GotContextMenuSignal (CMenuSaveSelectionAs TypPDF))
                    menuitem3 `on` menuItemActivate $ 
                      evhandler (GotContextMenuSignal (CMenuCut))     
                    menuitem4 `on` menuItemActivate $    
                      evhandler (GotContextMenuSignal (CMenuCopy))
                    menuitem5 `on` menuItemActivate $    
                      evhandler (GotContextMenuSignal (CMenuDelete))     
                    menuAttach menu menuitem1 0 1 1 2 
                    menuAttach menu menuitem2 0 1 2 3
                    menuAttach menu menuitem3 1 2 0 1                     
                    menuAttach menu menuitem4 1 2 1 2                     
                    menuAttach menu menuitem5 1 2 2 3    
                    
                    maybe (return ()) (\mi -> menuAttach menu mi 1 2 4 5) =<< menuCreateALink evhandler sitms 
                    
                    case sitms of 
                      sitm : [] -> do 
                        case sitm of 
                          RItemLink lnkbbx _msfc -> do 
                            let lnk = bbxed_content lnkbbx
                            maybe (return ()) 
                                  (\urlpath -> do 
                                    milnk <- menuOpenALink evhandler urlpath
                                    menuAttach menu milnk 0 1 3 4    
                                  )
                                  (urlParse ((B.unpack . link_location) lnk))
                            case lnk of 
                              Link i _typ lstr txt cmd rdr pos dim -> do 
                                case urlParse (B.unpack lstr) of 
                                  Nothing -> return ()
                                  Just (HttpUrl url) -> return ()
                                  Just (FileUrl file) -> do 
                                    b <- doesFileExist file
                                    when b $ do 
                                      bstr <- B.readFile file
                                      case parseOnly PA.hoodle bstr of 
                                        Left str -> print str 
                                        Right hdl -> do 
                                          let uuid = view hoodleID hdl
                                              link = LinkDocID i uuid (B.pack file) txt cmd rdr pos dim

                                          menuitemcvt <- menuItemNewWithLabel ("Convert Link With ID" ++ show uuid) 
                                          menuitemcvt `on` menuItemActivate $ do
                                            evhandler (GotContextMenuSignal (CMenuLinkConvert link))
                                          menuAttach menu menuitemcvt 0 1 4 5 
                              LinkDocID i lid file txt cmd rdr pos dim -> do 
                                case (lookupPathFromId =<< view hookSet xstate) of
                                  Nothing -> return () 
                                  Just f -> do 
                                    rp <- f (B.unpack lid)
                                    case rp of 
                                      Nothing -> return ()
                                      Just file' -> 
                                        if (B.unpack file) == file' 
                                        then return ()
                                          else do 
                                            let link = LinkDocID i lid (B.pack file') txt cmd rdr pos dim
                                            menuitemcvt <- menuItemNewWithLabel ("Correct Path to " ++ show file') 
                                            menuitemcvt `on` menuItemActivate $ do
                                              evhandler (GotContextMenuSignal (CMenuLinkConvert link))
                                            menuAttach menu menuitemcvt 0 1 4 5 
                          _ -> return () 
                      
                      _ -> return () 
                case (customContextMenuTitle =<< view hookSet xstate) of 
                  Nothing -> return () 
                  Just ttl -> do 
                    custommenu <- menuItemNewWithLabel ttl  
                    custommenu `on` menuItemActivate $ 
                      evhandler (GotContextMenuSignal (CMenuCustom))
                    menuAttach menu custommenu 0 1 0 1 
                
                menuitem8 <- menuItemNewWithLabel "Autosave This Page Image"
                menuitem8 `on` menuItemActivate $ 
                  evhandler (GotContextMenuSignal (CMenuAutosavePage))
                menuAttach menu menuitem8 1 2 3 4 
                    
                runStateT (mapM_ (makeMenu evhandler menu cid) cids) 0 
                widgetShowAll menu 
                menuPopup menu Nothing 
                return ContextMenuCreated 

        makeMenu evhdlr mn currcid cid 
          = when (currcid /= cid) $ do 
              n <- get
              mi <- liftIO $ menuItemNewWithLabel ("Show here in cvs" ++ show cid)
              liftIO $ mi `on` menuItemActivate $ 
                evhdlr (GotContextMenuSignal (CMenuCanvasView cid pnum x y)) 
              liftIO $ menuAttach mn mi 2 3 n (n+1) 
              put (n+1)