module Graphics.UI.Gtk.Layout.Rpn (

    RPN(), widgetsFromRpn, rWID, rCENTER, rLEFT, rRIGHT, rARROW,
    rASPECT, rBUTTON, rEXPANDER, rCOLOR, rFILE, rFONT, rFRAME,
    rHBOX,rVBOX, rHBBOX,rVBBOX, rHPANE,rVPANE, rHSCALE,rVSCALE,
    rHSEPARATOR,rVSEPARATOR, rIMAGE, rLABEL, rNOTEBOOK, rSCROLL,
    rSOCKET, rSPIN, rTEXT, rMAIN

 ) where
import Graphics.UI.Gtk
import System.Glib.Attributes as A (get)
import Control.Monad.State
import Data.Monoid
import Data.List
import RPN
import Basic

-- | Inserts your widget in the stack.  Your widget needs to
-- pass through Gtk.toWidget before applying 'rWID'.

rWID :: Widget -> RPN
rWID = cWID

-- | Insert the last widget inside a container.  When that
-- container grows, the widget keeps its natural size, aligned
-- in the center of the container.

rCENTER :: RPN
rCENTER = mconcat [cALN 0.5, pCA]

-- | Same as 'rCENTER', but aligns to the left.

rLEFT :: RPN
rLEFT = mconcat [cALN 0, pCA]

-- | Same as 'rCENTER', but aligns to the right.

rRIGHT :: RPN
rRIGHT = mconcat [cALN 1, pCA]

-- | Inserts an 'Graphics.UI.Gtk.Misc.Arrow.Arrow' in the stack.

rARROW :: ArrowType -> RPN
rARROW t = cARW t

-- | Sets the last widget to always keep the aspect ratio of
-- its original size requisition.

rASPECT :: RPN
rASPECT = mconcat [cAFR, pCA]

-- | Inserts a button into the stack, after a
-- 'Graphics.UI.Gtk.General.StockItems.StockId' and an @IO ()@
-- to be called when it is clicked.

rBUTTON :: StockId -> IO () -> RPN
rBUTTON id io = mconcat [cBTNSTK id, tONBUTTON buttonPressEvent io']
 where io' = liftIO io >> return True

-- | Packs the last widget in an
-- 'Graphics.UI.Gtk.Layout.Expander.Expander', allowing the
-- user to hide or show that widget under a label.

rEXPANDER :: String -> RPN
rEXPANDER s = mconcat [cEXN s, pCA]

-- | Inserts a color chooser button, after an initial
-- 'Graphics.UI.Gtk.Gdk.GC.Color' and a @Color -> IO ()@ to be
-- called when a new color is choosen.

rCOLOR :: Color -> (Color -> IO ()) -> RPN
rCOLOR c cb = mconcat [cBTNCLRCL c, tCBKCOLOR callback]
 where callback w = onColorSet w (colorButtonGetColor w >>= cb)
        >> return ()

-- | Inserts a
-- 'Graphics.UI.Gtk.Selectors.FileChooserButton.FileChooserButton'
-- after a @'System.IO.FilePath' -> IO ()@ to be called when
-- a file is choosen by the user. (This is not working since
-- @gtk2hs@ do not yet support the @"file-set"@ signal for
-- this widget.)

rFILE :: FileChooserAction -> RPN
rFILE = cBTNFLE

-- | Inserts a font chooser button after a @String -> IO ()@
-- to be called when a new font is choosen.

rFONT :: String -> (String -> IO ()) -> RPN
rFONT c cb = mconcat [cBTNFONFN c, tCBKFONT callback]
 where callback w = onFontSet w (fontButtonGetFontName w >>= cb)
        >> return ()

-- | Frames the last widget, adding a label.

rFRAME :: String -> RPN
rFRAME s = mconcat [cFRM, tSETFRAME [frameLabel := s], pCA]

-- | After a list of 'Graphics.UI.Gtk.Abstract.Box.Packing'
-- styles, 'rHBOX' and 'rVBOX' pack the last widgets respectively
-- in an horizontal or vertical box, as many as there are styles
-- in that list. Do not use them to pack buttons, instead use
-- 'rHBBOX' and 'rVBBOX'.

rHBOX,rVBOX :: [Packing] -> RPN
rHBOX p = mconcat $ cHBX : map pBPE (reverse p)
rVBOX p = mconcat $ cVBX : map pBPE (reverse p)

-- | After a number @n@, 'rHBBOX' and 'rVBBOX' pack the last @n@
-- widgets respectively in an horizontal or vertical box. Widgets
-- are supposed to be buttons.

rHBBOX,rVBBOX :: (Integral n) => n -> RPN
rHBBOX n = mconcat $ cHBXBTN : genericReplicate n (pBPE PackNatural)
rVBBOX n = mconcat $ cVBXBTN : genericReplicate n (pBPE PackNatural)

-- | 'rHPANE' and 'rVPANE' create, respectively, horizontal
-- and vertical 'Graphics.UI.Gtk.Abstract.Paned.Paned's.
-- @Bool@ parameters says whether left and right panes are
-- allowed to expand when the containing @Paned@ widget
-- grows.

rHPANE,rVPANE :: (Bool,Bool) -> RPN
rHPANE (r1,r2) = mconcat [cHPD, pPP2 r2, pPP1 r1]
rVPANE (r1,r2) = mconcat [cVPD, pPP2 r2, pPP1 r1]

-- | 'rHSCALE' and 'rVSCALE' create, respectively, horizontal
-- and vertical 'Graphics.UI.Gtk.Abstract.Scale.Scale's, after
-- a @(Double,Double)@ interval and a @Double -> IO ()@ to be
-- called when the value in the @Scale@ changes.

rHSCALE,rVSCALE :: (Double,Double) -> (Double -> IO ()) -> RPN
rHSCALE (v1,v2) io = mconcat [cHSCRNG v1 v2,
 tCBKRANGE $ configScale io]
rVSCALE (v1,v2) io = mconcat [cVSCRNG v1 v2,
 tCBKRANGE $ configScale io]

configScale io w = do
  set w [rangeUpdatePolicy := UpdateDelayed]
  (adj::Adjustment) <- A.get w rangeAdjustment
  v1 <- A.get adj adjustmentLower
  v2 <- A.get adj adjustmentUpper
  set w [rangeValue := (v2+v1)/2]
  onRangeValueChanged w $ A.get w rangeValue >>= io
  return ()

-- | 'rHSEPARATOR' and 'rVSEPARATOR' insert, respectively,
-- horizontal and vertical 'Graphics.UI.Gtk.Abstract.Separator's
-- in the stack.

rHSEPARATOR,rVSEPARATOR :: RPN
rHSEPARATOR = cHSP
rVSEPARATOR = cVSP

-- | 'rIMAGE' takes a 'System.IO.FilePath' to
-- an image and inserts a widget showing that
-- image in the stack.

rIMAGE :: FilePath -> RPN
rIMAGE = cIMGFLE

-- | 'rLABEL' inserts a 'Graphics.UI.Gtk.Display.Label.Label'
-- in the stack, after a @String@. This @String@
-- is supposed to be @Pango@ "Graphics.UI.Gtk.Pango.Markup".

rLABEL :: String -> RPN
rLABEL s = mconcat [cLBL s, tSETLABEL [labelUseMarkup := True]]

-- | 'rNOTEBOOK' takes a list of @String@
-- labels and add widgets from the stack to a
-- 'Graphics.UI.Gtk.Layout.Notebook.Notebook', as many as the
-- labels provided.

rNOTEBOOK :: [String] -> RPN
rNOTEBOOK lb = mconcat $ cNBK : map pNPP (reverse lb)

-- | 'rSCROLL' packs the last widget in a container
-- with horizontal and vertical scroll bars.

rSCROLL :: RPN
rSCROLL = mconcat [cLAY, pLAY, cSRL, pCA]

-- | 'rSOCKET' allows inserting a foreign (from
-- other program) widget inside the stack, given its
-- 'Graphics.UI.Gtk.Embedding.Socket.NativeWindowId'.

rSOCKET :: NativeWindowId -> RPN
rSOCKET id = mconcat [cSKT, tCBKSOCKET (flip socketAddId id)]

-- | 'rSPIN' creates a
-- 'Graphics.UI.Gtk.Entry.SpinButton.SpinButton' after a
-- @(Double,Double)@ interval and a @Double -> IO ()@ to be
-- called when the value in the @SpinButton@ changes.

rSPIN :: (Double,Double) -> (Double -> IO ()) -> RPN
rSPIN (v1,v2) io = mconcat [cBTNSPIRNG v1 v2,
 tCBKSPIN $ configSpin io]

configSpin io w = do
  (adj::Adjustment) <- A.get w spinButtonAdjustment
  v1 <- A.get adj adjustmentLower
  v2 <- A.get adj adjustmentUpper
  set w [spinButtonValue := (v2+v1)/2]
  onValueSpinned w $ A.get w spinButtonValue >>= io
  return ()

-- | 'rTEXT' creates a text view after a
-- given buffer, which shall be an instance of
-- 'Graphics.UI.Gtk.Multiline.TextBuffer.TextBufferClass'.

rTEXT :: (TextBufferClass b) => b -> RPN
rTEXT = cTVWBF

-- | 'rMAIN' packs the last widget in a main window, given
-- its title.

rMAIN :: String -> RPN
rMAIN t = mconcat [cWND, tSETWINDOW [windowTitle := t], pCA]