{-# OPTIONS_HADDOCK hide #-}

-- | Here we provide several low level operators that we are
-- going to use to build others, user friendly, operators.
-- Operators in this module are all simple capsules over existing
-- @gtk2hs@ functions.

module Basic where
import Control.Monad.State
import Graphics.UI.Gtk
import CanBeCasted
import RPN

-- * Operators with prefix @c@

-- | These are maps of @gtk2hs@ widget creation functions.
-- See 'io2rpn'.

cWID = RPN . pushWidget
cALN = io2rpn . \x -> alignmentNew x 0.5 0 0
cARW = io2rpn . \t -> arrowNew t ShadowNone
cAFR = io2rpn (aspectFrameNew 0.5 0.5 Nothing)
cBTNSTK = io2rpn . buttonNewFromStock
cBTNCLRCL = io2rpn . colorButtonNewWithColor
cEXN = io2rpn . expanderNew
cBTNFLE = io2rpn . fileChooserButtonNew ""
cBTNFONFN = io2rpn . fontButtonNewWithFont
cFRM = io2rpn frameNew
cHBX = io2rpn (hBoxNew False 0)
cVBX = io2rpn (vBoxNew False 0)
cHBXBTN = io2rpn hButtonBoxNew
cVBXBTN = io2rpn vButtonBoxNew
cHPD = io2rpn hPanedNew
cVPD = io2rpn vPanedNew
cHSCRNG = (io2rpn .). \mi ma -> hScaleNewWithRange mi ma ((mi+ma)/2)
cVSCRNG = (io2rpn .). \mi ma -> vScaleNewWithRange mi ma ((mi+ma)/2)
cHSP = io2rpn hSeparatorNew
cVSP = io2rpn vSeparatorNew
cIMGFLE = io2rpn . imageNewFromFile
cLBL = io2rpn . labelNew . Just
cNBK = io2rpn notebookNew
cSRL = io2rpn $ scrolledWindowNew Nothing Nothing
cLAY = io2rpn $ layoutNew Nothing Nothing
cSKT = io2rpn socketNew
cBTNSPIRNG = (io2rpn .). \mi ma -> spinButtonNewWithRange mi ma ((mi+ma)/2)
cTVWBF = io2rpn . textViewNewWithBuffer
cWND = io2rpn windowNew

-- * Operators with prefix @t@

-- | These operators act on a widget. 'tON' and its derivatives
-- connect callbacks to events. 'tSET' and derivatives set
-- attributes. 'tCBK' and derivatives allows callbacks to
-- be called at realize time with the corresponding widget
-- as parameters, we use them to connect to events for those
-- widgets @gtk2hs@ doesn't yet define event names for.

tON s c = RPN $ touchWidget $ \w -> on w s c >> return ()
tONBUTTON = tON :: Signal Button c -> c -> RPN

tSET a = RPN $ touchWidget $ ( $ a ) . set
tSETFRAME = tSET :: [AttrOp Frame] -> RPN
tSETLABEL = tSET :: [AttrOp Label] -> RPN
tSETWINDOW = tSET :: [AttrOp Window] -> RPN

tCBK f = RPN $ touchWidget cb
 where cb w = (after w realize $ f w) >> return ()
tCBKCOLOR = tCBK :: (ColorButton -> IO ()) -> RPN
tCBKFONT = tCBK :: (FontButton -> IO ()) -> RPN
tCBKRANGE = tCBK :: (Range -> IO ()) -> RPN
tCBKSOCKET = tCBK :: (Socket -> IO ()) -> RPN
tCBKSPIN = tCBK :: (SpinButton -> IO ()) -> RPN

-- * Operators with prefix @p@

-- | These are packing operators. They pack a widget into a
-- container, and the widget is removed from the stack.

pCA = RPN $
    let { ca :: Container -> Widget -> IO () ; ca = containerAdd }
        in pullWidget ca
pBPE p = RPN $
    let { bpe :: Box -> Widget -> IO () ; bpe b w = boxPackEnd b w p 0 }
        in pullWidget bpe
pPP1 r = RPN $
    let { pp1 :: Paned -> Widget -> IO () ; pp1 p w = panedPack1 p w r False }
        in pullWidget pp1
pPP2 r = RPN $
    let { pp2 :: Paned -> Widget -> IO () ; pp2 p w = panedPack2 p w r False }
        in pullWidget pp2
pNPP s = RPN $
    let
        npp :: Notebook -> Widget -> IO ()
        npp l w = notebookPrependPage l w s >> return ()
        in pullWidget npp
pLAY = RPN $
    let
        lay :: Layout -> Widget -> IO ()
        lay la w = layoutPut la w 0 0
        in pullWidget lay