{-# LANGUAGE ForeignFunctionInterface #-}

module Graphics.UI.FLTK.Group (begin,end,resizable,newGroup,Group_C(..),Group,
	               Tabs, newTabs) where

import Graphics.UI.FLTK.Widget
import Foreign.Ptr

-- | Group widgets.
newtype Group = Group (Ptr Group)

-- | Class for Groups.
class Group_C a where _group :: a -> Ptr Group
instance Group_C Group where _group  (Group p)   = p
instance Widget_C Group where _widget (Group p)  = castPtr p


foreign import ccall "newGroup" _newGroup
    :: Int -> Int -> Int -> Int -> IO (Ptr Group)
foreign import ccall "fl_Group_resizable" _resizable
    :: Ptr Group -> Ptr Widget -> IO ()
foreign import ccall "fl_Group_begin" _begin :: Ptr Group -> IO ()
foreign import ccall "fl_Group_end" _end :: Ptr Group -> IO ()

-- | Create a new Group widget
newGroup :: Int->Int->Int->Int->[Prop Group]->IO Group
newGroup x y w h l = do p <- _newGroup x y w h
			let w = Group p
			set w l
			return w

-- | Begin a group for layout. FIXME not thread safe.
begin :: Group_C g => g -> IO ()
begin = _begin . _group
-- | End a group for layout. FIXME not thread safe.
end :: Group_C g => g -> IO ()
end   = _end   . _group

-- | Mark a widget resizable in the group. Fixme => accessor?
resizable :: (Group_C g, Widget_C w) => g -> w -> IO ()
resizable g w = _resizable (_group g) (_widget w)


-- Tabs are a subclass of Group

-- | Tabs Group allows one to display several tabs of widgets.
newtype Tabs = Tabs (Ptr Tabs)
instance Group_C Tabs where _group (Tabs p) = castPtr p
instance Widget_C Tabs where _widget (Tabs p) = castPtr p

foreign import ccall "newTabs" _newTabs
    :: Int -> Int -> Int -> Int -> IO (Ptr Tabs)
foreign import ccall "fl_Tabs_value_AG" fl_Tabs_value_AG
    :: Ptr Tabs -> IO Widget
foreign import ccall "fl_Tabs_value_AS" fl_Tabs_value_AS
    :: Ptr Tabs -> Widget -> IO ()

-- | Create a new Tabs widget
newTabs :: Int->Int->Int->Int->[Prop Tabs]->IO Tabs
newTabs x y w h l = do p <- _newTabs x y w h
		       let w = Tabs p
		       set w l
		       return w

instance Value_FC Tabs Widget where
    value = Attr (\(Tabs p) -> fl_Tabs_value_AG p)
	         (\(Tabs p) v -> fl_Tabs_value_AS p v)