---------------------------------------------------------
--
-- Module        : GUI.WtkGtkBp
-- Copyright     : Bartosz Wójcik (2012)
-- License       : BSD3
--
-- Maintainer    : bartek@sudety.it
-- Stability     : Unstable
-- Portability   : portable
--
-- | Gtk boilerplating useful for certain solutions.
---------------------------------------------------------
module Graphics.UI.Gtk.WtkGtkBp

where

import Control.Monad
import Data.Lenses
import Graphics.UI.Gtk
import Graphics.UI.Gtk.WtkGui

-- | Attaches horizontal rule into table from (0,up) to (right,up+1).
hlineToTable :: TableClass t => Int -> Int -> t -> IO ()
hlineToTable up right t = hSeparatorNew >>= \hl ->
                          tableAttach t hl 0 right up (up+1) [Fill] [Shrink] 0 0

-- | Attaches markup text into cell (left,up)(left+1,up+1) of given table.
--   Text is left adejusted.
textToTableCellL :: TableClass t => String -> Int -> Int -> t -> IO Label
textToTableCellL txt left up t = textToTableLineL txt left (left+1) up t

-- | Attaches markup text into cells (left,up)(right,up+1) of given table.
--   Text is left adejusted.
textToTableLineL :: TableClass t => String -> Int -> Int -> Int -> t -> IO Label
textToTableLineL txt left right up t = labelNew Nothing >>= \ll ->
                                       labelSetMarkup ll txt >>
                                       labelToTable ll 0.02 left right up t >>
                                       return ll

-- | Attaches markup text into cell (left,up)(left+1,up+1) of given table.
--   Text is right adejusted.
textToTableCellR :: TableClass t => String -> Int -> Int -> t -> IO Label
textToTableCellR txt left up t = textToTableLineR txt left (left+1) up t

-- | Attaches markup text into cells (left,up)(right,up+1) of given table.
--   Text is right adejusted.
textToTableLineR :: TableClass t => String -> Int -> Int -> Int -> t -> IO Label
textToTableLineR txt left right up t = labelNew Nothing >>= \ll ->
                                       labelSetMarkup ll txt >>
                                       labelToTable ll 0.98 left right up t >>
                                       return ll

labelToTable l n left right up t =  miscSetAlignment l n 0 >>
                                    tableAttach t l left right up (up+1) [Fill] [Shrink] 5 5

-- | Steering information for text formating while attaching to table's cell.
type CellInfo t = (String -> Int -> Int -> t -> IO Label -- Function attaching
                  ,String                                -- Markup
                  )

-- | Attaches list of Strings into given table so that each string is in separate cosecutive
--   cell of given line of table. Each cell can be attached in own way according to @CellInfo@.
lineToTable :: TableClass t => t          -- ^ Given table
                           -> Int         -- ^ Horizontal begining cell
                           -> Int         -- ^ Vertical cell
                           -> (Bool       --   Condition -- attach whole line or not.
                            , [CellInfo t]--   Must be not shorter than next argument. Contains
                                          --   Formating information for each cell.
                            , [String])   --   Text to be attached.
                           -> IO Int      -- ^ Returns number of next line to attach.
lineToTable t x y (cond, cellSteering, cellTexts)
    | cond      = foldM_ (cellToTable t y) x (zip cellSteering cellTexts) >>
                  return (y+1)
    | otherwise = return y
    where -- Attaches one cell into a given table.
          -- Returns next position for next cell.

-- | Attaches given text to give table at given position in given way.
cellToTable :: TableClass t => t          -- ^ Given table
                           -> Int         -- ^ Vertical cell
                           -> Int         -- ^ Horizontal begining cell
                           -> (CellInfo t --     Attchment attributes
                              ,String)    -- ^ Text to attach
                           -> IO Int
cellToTable t y x ((f,markup),cT) = f (markup ++ cT ++ markUpEnd markup) x y t >>
                                    return (x + 1)

-- | Like @cellToTable@ just tailored for usage in vertical collections.
cellToTableV t x y body = cellToTable t y x body

-- Creates end pair for given start markup.
-- TODO: improve.
markUpEnd [] = []
markUpEnd ('<':xs) = '<' : '/' : markUpEnd xs
markUpEnd (x:xs) = x : markUpEnd xs

{-
putInput t x y (ll,lr,val,cond) | cond = leftLabel ll x y t >>
                                         rightLabel ("<b>" ++ val ++ "</b>") (x+1) y t >>
                                         leftLabel lr (x+2) y t >>
                                         return (y + 1)
                                | otherwise = return y
-}                               

-- | Creates new combo box with list of texts.
comboBoxWithText :: [String] -> IO ComboBox
comboBoxWithText txts = comboBoxNewText >>= \cb ->
                        mapM_ (comboBoxAppendText cb) txts >>
                        comboBoxSetActive cb 0 >>
                        return cb

-- | Creates a text combo box and puts it into given table at given position.
--   Combo box contains lines given as input.
comboBoxToTable :: Int -> Int -> [String] -> Table -> IO ComboBox
comboBoxToTable left up txts t = comboBoxWithText txts >>= \cb ->
                                 tableAttach t cb left (left+1) up (up+1) [Fill] [Shrink] 5 5 >>
                                 return cb

-- | Attaches given button into given table at given position. Button is linked with given action.
buttonToTable left up bt action t = onClicked bt action >>
                                    tableAttach t bt left (left+1) up (up+1) [Fill] [Shrink] 5 5
                                      
-- | Creates a new table, packs it into a new frame, the frame into given box and returns table.
--   Gets label for the frame, box and size of the new table.
myNewTable label box x y = frameNew >>= \fr ->
                           frameSetLabel fr label >>
                           boxPackStart box fr PackNatural 5 >>
                           tableNew x y False >>= \tb ->
                           containerAdd fr tb >>
                           return tb                                      
                           
-- | Attacges error message to the table.
--errShow att left up t | isError att = textToTableCellL txt left up t
errMsgToTable field left up t | field `fetch` att_isError = textToTableCellL txt left up t >>
                                                            return ()
                              | otherwise                 = return ()
    where txt = "<span foreground=\"red\">" ++ field `fetch` att_errMssg ++ "</span>"
      {-case isError att of
                              True -> do
                                 lb <- labelNew Nothing
                                 labelSetMarkup lb $ "<span foreground=\"red\">" ++
                                                errMssg  att ++ "</span>"
                                 tableAttach t lb left (left+1) up (up+1) [Fill] [Shrink] 0 5
                              False -> return ()-}