{-# LANGUAGE ForeignFunctionInterface #-}

module Graphics.UI.FLTK.Button (Button,newButton,newCheckButton,
                    newLightButton,newRepeatButton,
	                newReturnButton, newRoundButton) where

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

-- | The Button type is used for all buttons.
newtype Button = Button (Ptr Button)
instance Widget_C Button where _widget (Button p) = castPtr p

foreign import ccall "Fl_Button_new" _newButton :: Int -> Int -> Int -> Int -> IO Button
foreign import ccall "Fl_Check_Button_new" _newCheckButton :: Int -> Int -> Int -> Int -> IO Button
foreign import ccall "Fl_Light_Button_new" _newLightButton :: Int -> Int -> Int -> Int -> IO Button
foreign import ccall "Fl_Repeat_Button_new" _newRepeatButton :: Int -> Int -> Int -> Int -> IO Button
foreign import ccall "Fl_Return_Button_new" _newReturnButton :: Int -> Int -> Int -> Int -> IO Button
foreign import ccall "Fl_Round_Button_new" _newRoundButton :: Int -> Int -> Int -> Int -> IO Button

-- | Create a new normal button.
newButton :: Int -> Int -> Int -> Int -> [Prop Button] -> IO Button
newButton       x y w h l = _newButton       x y w h >>= b2 l
-- | Create a new checkbox
newCheckButton :: Int -> Int -> Int -> Int -> [Prop Button] -> IO Button
newCheckButton  x y w h l = _newCheckButton  x y w h >>= b2 l
-- | Create a new button with a light showing the current state.
newLightButton :: Int -> Int -> Int -> Int -> [Prop Button] -> IO Button
newLightButton  x y w h l = _newLightButton  x y w h >>= b2 l
-- | Create a button that sends the callback in a repeated fashion.
newRepeatButton :: Int -> Int -> Int -> Int -> [Prop Button] -> IO Button
newRepeatButton x y w h l = _newRepeatButton x y w h >>= b2 l
-- | Create a new button with a \"Return\" symbol on it (for Ok buttons).
newReturnButton :: Int -> Int -> Int -> Int -> [Prop Button] -> IO Button
newReturnButton x y w h l = _newReturnButton x y w h >>= b2 l
-- | Create a new radiobutton.
newRoundButton :: Int -> Int -> Int -> Int -> [Prop Button] -> IO Button
newRoundButton  x y w h l = _newRoundButton  x y w h >>= b2 l

b2 l b = set b l >> return b