{-# LANGUAGE ForeignFunctionInterface #-}

module Graphics.UI.FLTK.Menu (MenuBar, newMenuBar,
                  addM, addL, addC,
                  MenuType, mDefault, mInactive,
                  mToggle, mValue, mRadio, mInvisible,
                  mDivider) where

import Foreign.C.String
import Foreign

import Graphics.UI.FLTK.Widget

newtype MenuBar = MenuBar (Ptr MenuBar)

foreign import ccall "hs_Fl_Menu_Bar_new" _newMenuBar :: Int -> Int -> Int -> Int -> IO MenuBar
-- | Create a new menu bar.
newMenuBar :: Int->Int->Int->Int->[Prop MenuBar]->IO MenuBar
newMenuBar x y w h l = do { w <- _newMenuBar x y w h; set w l; return w }

-- void hs_Fl_Menu_Bar_clear(Hs_Fl_Menu_Bar* m) { m->clear(); }
--  int hs_Fl_Menu_Bar_size(Hs_Fl_Menu_Bar* m) { m->size(); }

foreign import ccall "hs_Fl_Menu_Bar_add" _add :: MenuBar -> CString -> CString -> StablePtr a -> MenuType -> IO ()

addM :: MenuBar -> String -> Act MenuBar -> IO ()
addM mb s a = do sp <- newStablePtr a
                 withCString s $ \cs -> _add mb cs nullPtr sp mDefault

addL :: MenuBar -> [(String,Act MenuBar)] -> IO ()
addL mb []         = return ()
addL mb ((s,a):xs) = addM mb s a >> addL mb xs

addC :: MenuBar -> String -> String -> Act MenuBar -> MenuType -> IO ()
addC mb label scut act mtype =
    do sp <- newStablePtr act
       withCString label (\cl -> withCString scut $ \csc -> _add mb cl csc sp mtype)

newtype MenuType = MenuType Int

mDefault    = MenuType 0
mInactive   = MenuType 1
mToggle     = MenuType 2
mValue      = MenuType 4
mRadio      = MenuType 8
mInvisible  = MenuType 16
mDivider    = MenuType 128