GUI.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}

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

module Hoodle.GUI where

import           Control.Concurrent (threadDelay, forkIO)
import           Control.Exception (SomeException(..),catch)
import           Control.Lens
import           Control.Monad hiding (mapM_,forM_)
import           Control.Monad.Trans 
import           Data.Foldable (mapM_,forM_)
import qualified Data.IntMap as M
import           Data.IORef
import           Data.Maybe
import qualified Graphics.UI.Gtk as Gtk
import           System.Directory
import           System.Environment
import           System.FilePath
import           System.IO
-- from this package
import           Hoodle.Accessor 
import           Hoodle.Config 
import           Hoodle.Coroutine.Callback
import           Hoodle.Coroutine.Default
import           Hoodle.Device
import           Hoodle.ModelAction.Window
import           Hoodle.Script.Hook
import           Hoodle.Type.Canvas
import           Hoodle.Type.Event
import           Hoodle.Type.HoodleState 
--
import           Prelude ((.),($),String,Bool(..),error,flip,id,map) 

-- |
startGUI :: Maybe FilePath -> Maybe Hook -> IO () 
startGUI mfname mhook = do 
    Gtk.initGUI
    window <- Gtk.windowNew   
    Gtk.windowSetDefaultSize window 800 400
    cfg <- loadConfigFile   
    devlst <- initDevice cfg 
    maxundo <- getMaxUndo cfg >>= maybe (return 50) (return . id)
    xinputbool <- getXInputConfig cfg 
    varcsr <- getPenConfig cfg
    (usepz,uselyr) <- getWidgetConfig cfg 
    (tref,st0,ui,vbox) <- initCoroutine devlst window mhook maxundo (xinputbool,usepz,uselyr,varcsr) 
    setTitleFromFileName st0
    -- need for refactoring
    mapM_ (\(x,y :: Simple Lens Settings Bool) -> lensSetToggleUIForFlag x (settings.y) st0 )
      [ ("UXINPUTA", doesUseXInput) 
      , ("HANDA"   , doesUseTouch)
      , ("POPMENUA", doesUsePopUpMenu)
      , ("EBDIMGA" , doesEmbedImage)
      , ("EBDPDFA" , doesEmbedPDF)
      ] 
    setToggleUIForFlag "TOGGLENETSRCA" False st0
    -- 
    let canvases = map (getDrawAreaFromBox) . M.elems . view (unitHoodles.currentUnit.cvsInfoMap) $ st0
#ifndef GTK3      
    if xinputbool
        then mapM_ (flip Gtk.widgetSetExtensionEvents [Gtk.ExtensionEventsAll]) canvases
        else mapM_ (flip Gtk.widgetSetExtensionEvents [Gtk.ExtensionEventsNone]) canvases
#endif
    --
    outerLayout ui vbox st0 
    window `Gtk.on` Gtk.deleteEvent $ do
      liftIO $ eventHandler tref (UsrEv (Menu MenuQuit))
      return True
    Gtk.widgetShowAll window

    forkIO $ clock (eventHandler tref)
    let mainaction = eventHandler tref (UsrEv (Initialized mfname)) >> Gtk.mainGUI 
    mainaction `catch` \(_e :: SomeException) -> do 
      homepath <- getEnv "HOME"
      let dir = homepath </> ".hoodle.d"
      createDirectoryIfMissing False dir
      outh <- openFile (dir </> "error.log") WriteMode 
      hPutStrLn outh "error occured"
      hClose outh 
    return ()


clock :: (AllEvent -> IO ()) -> IO ()
clock evhandler = forever $ do 
    threadDelay 1000000
    Gtk.postGUIAsync (evhandler (SysEv ClockUpdateEvent))



outerLayout :: Gtk.UIManager -> Gtk.VBox -> HoodleState -> IO ()
outerLayout ui vbox xst = do 
    let notebook = view rootNotebook xst
        mstatusbar = view statusBar xst
    menubar <- Gtk.uiManagerGetWidget ui "/ui/menubar" 
               >>= maybe (error "GUI.hs:no menubar") return 
    toolbar1 <- Gtk.uiManagerGetWidget ui "/ui/toolbar1" 
                >>= maybe (error "GUI.hs:no toolbar1") return 
    toolbar2 <- Gtk.uiManagerGetWidget ui "/ui/toolbar2"
                >>= maybe (error "GUI.hs:no toolbar2") return 
    -- 
    ebox <- Gtk.eventBoxNew
    label <- Gtk.labelNew (Just "drag me")
    Gtk.containerAdd ebox label 
    Gtk.dragSourceSet ebox [Gtk.Button1] [Gtk.ActionCopy]
    Gtk.dragSourceSetIconStock ebox Gtk.stockIndex
    Gtk.dragSourceAddTextTargets ebox
    -- ebox `on` dragBegin $ \_dc -> do 
    --   liftIO $ putStrLn "dragging"
    ebox `Gtk.on` Gtk.dragDataGet $ \_dc _iid _ts -> do 
      -- very dirty solution but.. 
      minfo <- liftIO $ do 
        ref <- newIORef (Nothing :: Maybe String)
        view callBack xst (UsrEv (GetHoodleFileInfo ref))
        readIORef ref
      traverse Gtk.selectionDataSetText minfo >> return ()

    -- 
    hbox <- Gtk.hBoxNew False 0 
    Gtk.boxPackStart hbox toolbar1 Gtk.PackGrow 0
    Gtk.boxPackStart hbox ebox Gtk.PackNatural 0
    Gtk.boxPackStart vbox menubar Gtk.PackNatural 0 
    Gtk.boxPackStart vbox hbox Gtk.PackNatural 0
    Gtk.boxPackStart vbox toolbar2 Gtk.PackNatural 0  
    forM_ mstatusbar $ \statusbar-> Gtk.boxPackEnd vbox statusbar Gtk.PackNatural 0
    --
    Gtk.boxPackStart vbox notebook Gtk.PackGrow 0