module Hoodle.Coroutine.ContextMenu where
import Control.Applicative
import Control.Lens (view,set,(%~))
import Control.Monad.State hiding (mapM_,forM_)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Foldable (mapM_,forM_)
import qualified Data.IntMap as IM
import Data.Monoid
import Data.UUID.V4
import qualified Data.Text.Encoding as TE
import Graphics.Rendering.Cairo
import Graphics.UI.Gtk hiding (get,set)
import System.Directory
import System.FilePath
import System.Process
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(..), defaultHoodle)
import Graphics.Hoodle.Render
import Graphics.Hoodle.Render.Item
import Graphics.Hoodle.Render.Type
import Graphics.Hoodle.Render.Type.HitTest
import Text.Hoodle.Builder (builder)
import Hoodle.Accessor
import Hoodle.Coroutine.Commit
import Hoodle.Coroutine.Dialog
import Hoodle.Coroutine.Draw
import Hoodle.Coroutine.File
import Hoodle.Coroutine.Scroll
import Hoodle.Coroutine.Select.Clipboard
import Hoodle.Coroutine.Select.ManipulateImage
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.Enum
import Hoodle.Type.Event
import Hoodle.Type.HoodleState
import Hoodle.Type.PageArrangement
import Hoodle.Util
import Prelude hiding (mapM_)
processContextMenu :: ContextMenuEvent -> MainCoroutine ()
processContextMenu (CMenuSaveSelectionAs ityp) = do
xst <- get
forM_ (getSelectedItmsFromHoodleState xst)
(\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 (CMenuRotate dir imgbbx) = rotateImage dir imgbbx
processContextMenu CMenuAutosavePage = do
xst <- get
pg <- getCurrentPageCurr
mapM_ 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 =
fileChooser FileChooserActionOpen Nothing >>= mapM_ linkSelectionWithFile
processContextMenu CMenuAssocWithNewFile = do
xst <- get
let msuggestedact = view hookSet xst >>= fileNameSuggestionHook
(msuggested :: Maybe String) <- maybe (return Nothing) (liftM Just . liftIO) msuggestedact
fileChooser FileChooserActionSave msuggested >>=
mapM_ (\fp -> do
b <- liftIO (doesFileExist fp)
if b
then okMessageBox "The file already exist!"
else do
let action = mkIOaction $ \_ -> do
nhdl <- liftIO $ defaultHoodle
(L.writeFile fp . builder) nhdl
createProcess (proc "hoodle" [fp])
return (UsrEv ActionOrdered)
modify (tempQueue %~ enqueue action)
waitSomeEvent (\x -> case x of ActionOrdered -> True ; _ -> False)
linkSelectionWithFile fp
return ()
)
processContextMenu (CMenuPangoConvert (x0,y0) txt) = textInput (x0,y0) txt
processContextMenu (CMenuLaTeXConvert (x0,y0) txt) = laTeXInput (x0,y0) txt
processContextMenu (CMenuLaTeXConvertNetwork (x0,y0) txt) = laTeXInputNetwork (x0,y0) txt
processContextMenu (CMenuCropImage imgbbox) = cropImage imgbbox
processContextMenu CMenuCustom = do
either (const (return ())) action . hoodleModeStateEither . view hoodleModeState =<< get
where action thdl = do
xst <- get
forM_ (view gselSelected thdl)
(\(_,tpg) -> do
let hititms = (map rItem2Item . getSelectedItms) tpg
mapM_ liftIO $ do hset <- view hookSet xst
customContextMenuHook hset <*> pure hititms)
linkSelectionWithFile :: FilePath -> MainCoroutine ()
linkSelectionWithFile fname = do
liftM getSelectedItmsFromHoodleState get >>=
mapM_ (\hititms ->
let ulbbox = (unUnion . mconcat . fmap (Union . Middle . getBBox)) hititms
in case ulbbox of
Middle bbox -> 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 () )
exportCurrentSelectionAsSVG :: [RItem] -> BBox -> MainCoroutine ()
exportCurrentSelectionAsSVG hititms bbox@(BBox (ulx,uly) (lrx,lry)) =
fileChooser FileChooserActionSave Nothing >>= maybe (return ()) action
where
action filename =
if takeExtension filename /= ".svg"
then fileExtensionInvalid (".svg","export")
>> exportCurrentSelectionAsSVG hititms bbox
else do
liftIO $ withSVGSurface filename (lrxulx) (lryuly) $ \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 =
if takeExtension filename /= ".pdf"
then fileExtensionInvalid (".svg","export")
>> exportCurrentSelectionAsPDF hititms bbox
else do
liftIO $ withPDFSurface filename (lrxulx) (lryuly) $ \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"
menuitem6 <- menuItemNewWithLabel "New File Linked Here"
menuitem1 `on` menuItemActivate $
evhandler (UsrEv (GotContextMenuSignal (CMenuSaveSelectionAs TypSVG)))
menuitem2 `on` menuItemActivate $
evhandler (UsrEv (GotContextMenuSignal (CMenuSaveSelectionAs TypPDF)))
menuitem3 `on` menuItemActivate $
evhandler (UsrEv (GotContextMenuSignal (CMenuCut)))
menuitem4 `on` menuItemActivate $
evhandler (UsrEv (GotContextMenuSignal (CMenuCopy)))
menuitem5 `on` menuItemActivate $
evhandler (UsrEv (GotContextMenuSignal (CMenuDelete)))
menuitem6 `on` menuItemActivate $
evhandler (UsrEv (GotContextMenuSignal (CMenuAssocWithNewFile)))
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
menuAttach menu menuitem6 1 2 3 4
mapM_ (\mi -> menuAttach menu mi 1 2 5 6) =<< menuCreateALink evhandler sitms
case sitms of
sitm : [] -> do
case sitm of
RItemLink lnkbbx _msfc -> do
let lnk = bbxed_content lnkbbx
forM_ ((urlParse . B.unpack . link_location) lnk)
(\urlpath -> do milnk <- menuOpenALink urlpath
menuAttach menu milnk 0 1 3 4 )
case lnk of
Link _i _typ _lstr _txt _cmd _rdr _pos _dim ->
convertLinkFromSimpleToDocID lnk >>=
mapM_ (\link -> do
let LinkDocID _ uuid _ _ _ _ _ _ = link
menuitemcvt <- menuItemNewWithLabel ("Convert Link With ID" ++ show uuid)
menuitemcvt `on` menuItemActivate $ do
evhandler (UsrEv (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 $
evhandler (UsrEv (GotContextMenuSignal (CMenuLinkConvert link)))
menuAttach menu menuitemcvt 0 1 4 5
RItemSVG svgbbx _msfc -> do
let svg = bbxed_content svgbbx
BBox (x0,y0) _ = getBBox svgbbx
forM_ ((,) <$> svg_text svg <*> svg_command svg) $ \(btxt,cmd) -> do
let txt = TE.decodeUtf8 btxt
case cmd of
"pango" -> do
menuitemedt <- menuItemNewWithLabel ("Edit Text")
menuitemedt `on` menuItemActivate $ do
evhandler (UsrEv (GotContextMenuSignal (CMenuPangoConvert (x0,y0) txt)))
menuAttach menu menuitemedt 0 1 4 5
return ()
"latex" -> do
menuitemedt <- menuItemNewWithLabel ("Edit LaTeX")
menuitemedt `on` menuItemActivate $ do
evhandler (UsrEv (GotContextMenuSignal (CMenuLaTeXConvert (x0,y0) txt)))
menuAttach menu menuitemedt 0 1 4 5
menuitemnet <- menuItemNewWithLabel ("Edit LaTeX Network")
menuitemnet `on` menuItemActivate $ do
evhandler (UsrEv (GotContextMenuSignal (CMenuLaTeXConvertNetwork (x0,y0) txt)))
menuAttach menu menuitemnet 0 1 5 6
return ()
_ -> return ()
RItemImage imgbbx _msfc -> do
let
menuitemcrop <- menuItemNewWithLabel ("Crop Image")
menuitemcrop `on` menuItemActivate $ do
(evhandler . UsrEv . GotContextMenuSignal . CMenuCropImage) imgbbx
menuitemrotcw <- menuItemNewWithLabel ("Rotate Image CW")
menuitemrotcw `on` menuItemActivate $ do
(evhandler . UsrEv . GotContextMenuSignal) (CMenuRotate CW imgbbx)
menuitemrotccw <- menuItemNewWithLabel ("Rotate Image CCW")
menuitemrotccw `on` menuItemActivate $ do
(evhandler . UsrEv . GotContextMenuSignal) (CMenuRotate CCW imgbbx)
menuAttach menu menuitemcrop 0 1 4 5
menuAttach menu menuitemrotcw 0 1 5 6
menuAttach menu menuitemrotccw 0 1 6 7
return ()
_ -> return ()
_ -> return ()
case (customContextMenuTitle =<< view hookSet xstate) of
Nothing -> return ()
Just ttl -> do
custommenu <- menuItemNewWithLabel ttl
custommenu `on` menuItemActivate $
evhandler (UsrEv (GotContextMenuSignal (CMenuCustom)))
menuAttach menu custommenu 0 1 0 1
menuitem8 <- menuItemNewWithLabel "Autosave This Page Image"
menuitem8 `on` menuItemActivate $
evhandler (UsrEv (GotContextMenuSignal (CMenuAutosavePage)))
menuAttach menu menuitem8 1 2 4 5
runStateT (mapM_ (makeMenu evhandler menu cid) cids) 0
widgetShowAll menu
menuPopup menu Nothing
return (UsrEv 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 (UsrEv (GotContextMenuSignal (CMenuCanvasView cid pnum x y)))
liftIO $ menuAttach mn mi 2 3 n (n+1)
put (n+1)