Panes.hs

{-# Language
    ExistentialQuantification,
    MultiParamTypeClasses,
    FunctionalDependencies,
    CPP,
    DeriveDataTypeable,
    EmptyDataDecls,
    StandaloneDeriving,
    TypeFamilies,
    FlexibleContexts,
    ScopedTypeVariables,
    RankNTypes,
    FlexibleInstances,
    TypeSynonymInstances #-}
   -- TypeFamilies
-----------------------------------------------------------------------------
--
-- Module      :  Graphics.Panes
-- Copyright   :  Juergen Nicklisch-Franken
-- License     :  LGPL
--
-- Maintainer  :  maintainer@leksah.org
-- Stability   :  provisional
-- Portability :  portabel
--
-- | The basic definitions for all panes
--
-------------------------------------------------------------------------------

module Graphics.Panes (

-- * Panes and pane layout
    Direction(..)
,   PaneDirection(..)
,   PanePathElement(..)
,   PanePath
,   PaneLayout(..)
,   PaneName
,   Connection
,   Connections
,   castCID
,   PaneInterface(..)

,   PanePrefs(..)

-- * Other
,   signalDisconnectAll

,   panePathForGroup
,   initialLayout

,   postSyncState
,   postAsyncState

) where

import Base
import Graphics.FrameTypes

import Graphics.UI.Gtk hiding (get)
import System.Glib.GObject
import System.Glib.Signals
import Data.Maybe
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Typeable
import Control.Monad.Trans
import Data.List (isPrefixOf, stripPrefix, findIndex)
import Control.Monad (liftM, when)
import qualified Data.Set as Set (member)
import Data.IORef (newIORef)
import Data.Version (Version(..))
import Foreign.C (CULong)


-- ---------------------------------------------------------------------
-- * Panes and pane layout
--

type PaneName = String

--
-- | The direction of a split
--
data Direction      =   Horizontal | Vertical
    deriving (Eq,Show)

--
-- | A path to a pane
--
type PanePath       =   [PanePathElement]

--
-- | An element of a path to a pane
--
data PanePathElement = SplitP PaneDirection | GroupP String
    deriving (Eq,Show,Read)

--
-- | The relative direction to a pane from the parent
--
data PaneDirection  =   TopP | BottomP | LeftP | RightP
    deriving (Eq,Show,Read)

--
-- | Description of a window layout
-- Horizontal: top bottom Vertical: left right
--
data PaneLayout =       HorizontalP PaneLayout PaneLayout Int
                    |   VerticalP PaneLayout PaneLayout Int
                    |   TerminalP {
                                paneGroups   :: Map String PaneLayout
                            ,   paneTabs     :: Maybe PaneDirection
                            ,   currentPage  :: Int
                            ,   detachedId   :: Maybe String
                            ,   detachedSize :: Maybe (Int, Int) }
    deriving (Eq,Show,Read)

--
-- | Empty initial layout
--
initialLayout = TerminalP {
    paneGroups   =  Map.empty
,   paneTabs     =  Nothing
,   currentPage  =  (-1)
,   detachedId   = Nothing
,   detachedSize = Nothing}


data PanePrefs = PanePrefs {
    ppCategoryForPane :: [(String,String)],
    ppPathForCategory :: [(String,PanePath)],
    ppDefaultPath :: PanePath}
    deriving (Eq,Typeable)



--
-- | The class which describes the minimal implementation
--
class (Typeable alpha, Show (PaneState alpha), Read (PaneState alpha)) => PaneInterface alpha where

    data PaneState alpha :: *
    type PaneArgs  alpha :: *

    primPaneName    ::   alpha -> String
    -- ^ gets a string which names this pane


    paneType          :: alpha -> String
    -- ^ gets a unique id for this type of pane

    builder         ::   PaneArgs alpha -> PanePath -> Notebook -> Window -> StateM (Maybe alpha,Connections)
    -- ^ A function, which builds this pane

    getTopWidget    ::   alpha -> Widget
    -- ^ gets the top Widget of this pane

    saveState       ::   alpha -> StateM (Maybe (PaneState alpha))
    -- ^ Returns the state of this pane

    recoverState    ::   PanePath -> PaneState alpha -> StateM (Maybe alpha)
    -- ^ Sets the state for this pane





--
-- | Signal handlers for the different pane types
--
type Connection =  ConnectId Widget

type Connections = [Connection]

castCID :: GObjectClass alpha  => ConnectId alpha -> ConnectId Widget
castCID (ConnectId ui o) = (ConnectId ui (castToWidget o))

-- TODO recover somewhere, needs prefs

panePathForGroup::  String -> delta PanePath
panePathForGroup groupName = undefined

signalDisconnectAll :: Connections -> IO ()
signalDisconnectAll = mapM_ (\ s -> signalDisconnect s)

instance Show Window where
    show _ = "a Window"

instance Show UIManager where
    show _ = "a UIManager"

instance Show Connection where
    show _ = "a Connection"

instance Show Notebook where
    show _ = "a Notebook"

deriving instance Typeable UIManager

--
postSyncState :: StateM a -> StateM a
postSyncState f = reifyState (\ideR -> postGUISync (reflectState f ideR))

--
postAsyncState :: StateM () -> StateM ()
postAsyncState f = reifyState (\ideR -> postGUIAsync (reflectState f ideR))



--  ----------------------------------------
-- * Necessary with pre 10.1 verion of gtk2hs
--

#ifdef MIN_VERSION_gtk
#if MIN_VERSION_gtk(0,10,1)
#else
instance Eq Notebook
    where (==) a b = let (GObject pa, GObject pb) = (toGObject a, toGObject b)
                    in pa == pb
instance Ord Notebook
    where (<=) a b = let (GObject pa, GObject pb) = (toGObject a, toGObject b)
                    in pa <= pb
instance Eq Window
    where (==) a b = let (GObject pa, GObject pb) = (toGObject a, toGObject b)
                    in pa == pb
instance Eq Widget
    where (==) a b = let (GObject pa, GObject pb) = (toGObject a, toGObject b)
                    in pa == pb
#endif
#endif