diff --git a/Graphics/UI/Gtk/WtkGtk.hs b/Graphics/UI/Gtk/WtkGtk.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/UI/Gtk/WtkGtk.hs
@@ -0,0 +1,402 @@
+---------------------------------------------------------
+--
+-- Module : GUI.WtkGtk
+-- Copyright : Bartosz Wójcik (2010)
+-- License : BSD3
+--
+-- Maintainer : bartek@sudety.it
+-- Stability : Unstable
+-- Portability : portable
+--
+-- | Gtk instantiation of interface between application and GUI.
+---------------------------------------------------------
+module Graphics.UI.Gtk.WtkGtk
+(module Graphics.UI.Gtk.WtkGtkBp
+,State (..)
+,WidgetsCollection (..)
+,initState
+,logSt
+,newTable
+,newOutputPage
+,newOutputText
+,showSelection
+,showEntry
+,showButton
+,showCheckBox
+,reShowPage
+)
+where
+
+import Graphics.UI.Gtk.WtkGui
+import Graphics.UI.Gtk.WtkGtkBp
+import Graphics.UI.Gtk
+import Control.Monad
+--import Control.Monad.Error
+import Data.IORef
+import Data.Lenses
+import Data.Maybe
+
+-- | The State.
+-- It contains all details that have to passed around to manage properly
+-- Gtk UI and of course users state.
+data State a = St { ntbk :: Notebook -- ^ Notebook. All the GUI is embeded in a notebook.
+ , usrSt :: a -- ^ User's state
+ , bs :: [(Int,Button,ConnectId Button)] -- ^ Page number and its closing button and closing signal
+ , inputPg :: Int -- id of widget with focus
+ -> IORef (State a) -- state living in IO
+ -> IO (VBox, [WidgetsCollection]) -- ^ Function showing input page. Id of widget with focus,
+ -- state are input. vbox to be shown and
+ -- list of widgets to set focus are output.
+ , newUsrSt :: String -- Raw entry from widget
+ -> Int -- Id of widget
+ -> a -- Previous state
+ -> a -- ^ Gives new, user defined state, having new entry of a widget.
+ , idFocus :: Int -- ^ id of widget with focus
+ , debug :: Bool -- ^ set, displays lots of debug info
+ }
+
+-- | Serialization of inputable widgets for focus purposes. To be used in the function showing input page for
+-- producing proper output.
+data WidgetsCollection = CSL (Int, ComboBox)
+ | CEn (Int, Entry)
+ | CBu (Int, Button)
+ | CCB (Int, CheckButton)
+ | Dummy
+
+-- | Finds requested widget in the collection.
+findI :: Int -> [WidgetsCollection] -> WidgetsCollection
+findI _ [] = Dummy
+findI i (x:xs) = case x of
+ CSL (n,_) -> if n == i then x else findI i xs
+ CEn (n,_) -> if n == i then x else findI i xs
+ CBu (n,_) -> if n == i then x else findI i xs
+ CCB (n,_) -> if n == i then x else findI i xs
+ _ -> findI i xs
+
+-- | State initializaion
+initState :: Notebook -- ^ Gtk's 'Notebook
+ -> a -- ^ Initialized user's state
+ -> (Int -> IORef (State a) -> IO (VBox, [WidgetsCollection])) -- ^ Input page creation
+ -> (String -> Int -> a -> a) -- ^ User state change
+ -> Bool -- ^ Debug on/off
+ -> IO (IORef (State a))
+initState ntbk iniUsrState inputPg newUstSt debug = newIORef $ St ntbk iniUsrState [] inputPg newUstSt 0 debug
+
+-- | Displays debuging detail if switched on
+logSt :: Bool -> String -> IO ()
+logSt True txt = putStrLn txt
+logSt _ _ = return ()
+
+
+-- | Renders text output page on the notebook with closing button on the tab.
+newOutputPage :: String -- ^ Title of page
+ -> VBox -- ^ Content
+ -> IORef (State a) -- ^ State
+ -> IO ()
+newOutputPage txt vbox state = do
+ -- adds new page to the notebook and displays it
+ win <- scrolledWindowNew Nothing Nothing
+ scrolledWindowSetPolicy win PolicyNever PolicyAutomatic
+ scrolledWindowAddWithViewport win vbox
+
+ -- Page label consists of text label and close button
+ img <- imageNewFromStock stockClose (IconSizeUser 1)
+ button <- buttonNew
+ containerAdd button img
+
+ st <- readIORef state
+ newPg <- notebookGetNPages $ ntbk st
+ clSig <- onClicked button $ myNotebookRemovePage state newPg
+
+ lb <- labelNew $ Just $ show newPg ++ ". " ++ txt
+ hb <- hBoxNew False 0
+ boxPackStart hb lb PackNatural 0
+ boxPackStart hb button PackNatural 0
+
+ logSt (debug st) $ "New page " ++ show newPg
+
+ writeIORef state (st { bs = ((newPg, button, clSig) : bs st)})
+
+ logSt (debug st) $ "pages " ++ show ( map (\(i,_,_) -> i) (bs st))
+
+ -- Widget has to be shown before put to notebook's page
+ -- otherwise its content won't be rendered properly.
+ widgetShowAll hb
+
+ notebookAppendPageMenu (ntbk st) win hb lb
+ widgetShowAll $ ntbk st
+
+
+-- | Renders text output page on the notebook with closing button on the tab.
+newOutputText :: String -- ^ Title of page
+ -> String -- ^ Content
+ -> IORef (State a) -- ^ State
+ -> IO ()
+newOutputText txt content state = do
+ -- adds new page to the notebook and displays it
+ win <- scrolledWindowNew Nothing Nothing
+ scrolledWindowSetPolicy win PolicyNever PolicyAutomatic
+ mb <- vBoxNew False 0
+ scrolledWindowAddWithViewport win mb
+ info <- labelNew (Just content)
+ labelSetSelectable info True
+ boxPackStart mb info PackNatural 7
+
+ -- Monospace font for the window
+ f <- fontDescriptionNew
+ fontDescriptionSetFamily f "Monospace"
+ widgetModifyFont info (Just f)
+ set info [ miscXalign := 0.01 ] -- so the text is left-justified.
+
+ -- Page label consists of text label and close button
+ img <- imageNewFromStock stockClose (IconSizeUser 1)
+ button <- buttonNew
+ containerAdd button img
+ lb <- labelNew $ Just txt
+ hb <- hBoxNew False 0
+ boxPackStart hb lb PackNatural 0
+ boxPackStart hb button PackNatural 0
+
+ st <- readIORef state
+ newPg <- notebookGetNPages $ ntbk st
+ clSig <- onClicked button $ myNotebookRemovePage state newPg
+
+ logSt (debug st) $ "New page " ++ show newPg
+
+ writeIORef state (st { bs = ((newPg, button, clSig) : bs st)})
+
+ logSt (debug st) $ "pages " ++ show ( map (\(i,_,_) -> i) (bs st))
+
+ -- Widget has to be shown before put to notebook's page
+ -- otherwise its content won't be rendered properly.
+ widgetShowAll hb
+ notebookAppendPageMenu (ntbk st) win hb lb
+ widgetShowAll $ ntbk st
+
+-- Removes page and redefined closing signals of other output pages.
+myNotebookRemovePage :: IORef (State a) -> Int -> IO ()
+myNotebookRemovePage state newPg = do
+ st <- readIORef state
+ k <- notebookGetCurrentPage $ ntbk st
+ logSt (debug st) $ "removedPage " ++ show newPg ++ " " ++ show ( map (\(i,_,_) -> i) (bs st) )
+ notebookRemovePage (ntbk st) newPg
+
+ -- New signals attached to the closing buttons.
+ newSignals <- mapM (newSignal st) $ filter (\(i,_,_) -> i /= newPg) (bs st)
+ writeIORef state $ st { bs = newSignals}
+
+ -- Input page has to be re-rendered in order to get new state
+ -- on the action widget. Otherwise next same action won't have
+ -- new signals attached to buttons.
+ -- It is re-rendered only if either
+ -- - it is current page
+ -- - it becomes current page, beacuse the last other page has been removed
+ when (k == 0 || null newSignals) $ reShowPageVoid (idFocus st) state
+ where newSignal st (i,bt,sg) | i > newPg = do
+ signalDisconnect sg
+ newSignal <- onClicked bt (myNotebookRemovePage state (i-1))
+ logSt (debug st) $ "newSignal " ++ show (i-1)
+ return (i-1,bt,newSignal)
+ | otherwise = return $ (i,bt,sg)
+
+-- ============ Re-showing input page ================
+reShowPageVoid nr state = reShowPage nr state >> return ()
+reShowPageVoid' nr state _ = reShowPage nr state >> return ()
+reShowPage'' nr state _ = reShowPage nr state
+reShowPage' nr state _ = reShowPage nr state
+
+-- | Re-shows the page.
+reShowPage :: Int -> IORef (State a) -> IO Bool
+reShowPage nr state = do
+ st <- readIORef state
+
+ i <- notebookGetCurrentPage $ ntbk st
+ (vb,collection) <- (inputPg st) nr state
+
+ --case head $ drop nr collection of
+ case findI nr collection of
+ CSL (_,cb) -> widgetGrabFocus cb >> logSt (debug st) ("focus " ++ show nr)
+ CEn (_,en) -> widgetGrabFocus en >> logSt (debug st) ("focus " ++ show nr)
+ CBu (_,bt) -> widgetGrabFocus bt >> logSt (debug st) ("focus " ++ show nr)
+ CCB (_,cb) -> widgetGrabFocus cb >> logSt (debug st) ("focus " ++ show nr)
+ _ -> logSt (debug st) $ "reShowPage Dummy with focus: " ++ show nr
+
+ widgetShowAll vb
+
+ -- Old page is removed after the new one is shown. New one is inserted under
+ -- the number of the old one, therefore the old one is moved to next number.
+ -- This works according to experience and is not confirmed by any API docu.
+ notebookInsertPage (ntbk st) vb "Input" i
+ notebookRemovePage (ntbk st) (i + 1)
+ notebookSetCurrentPage (ntbk st) i
+
+ widgetShowAll (ntbk st)
+
+ logSt (debug st) $ "reShow " ++ show nr ++ " " ++ show i
+
+ return False
+
+-- ================= Combo Box ====================
+
+-- | Shows combo box and sets its attributes according to input.
+-- Attaches new selection list to the given table.
+showSelection
+ :: TableClass self =>
+ InputField -- ^ @Selection@ constructor
+ -> Int -- ^ left coordinate
+ -> Int -- ^ up coordinate
+ -> Int -- ^ id of active widget
+ -> self -- ^ table to attach
+ -> IORef (State a) -- ^ user state
+ -> IO ComboBox
+showSelection field left up nr t state = do
+
+ cb <- comboBoxWithText (field `fetch` val_selString)
+
+ -- Set active entry to one from state
+ comboBoxSetActive cb (nbr $ field `fetch` val_selValue)
+
+ -- Set sensitivity depending on editability
+ widgetSetSensitivity cb (field `fetch` att_editable)
+
+ -- On changed entry signal render new UI
+ on cb changed $ showNewSel cb (field `fetch` idOf) state
+ st <- readIORef state
+ when (field `fetch` idOf /= nr) $ widgetSetCanFocus cb True >>
+ (afterGrabFocus cb $ reShowPageVoid (field `fetch` idOf) state) >>
+ logSt (debug st) ("comboBoxWithInputField " ++
+ show nr)
+
+ widgetGetCanFocus cb >>= logSt (debug st) . show
+
+ tableAttach t cb left (left+1) up (up+1) [Fill] [Shrink] 0 5
+
+ return cb
+
+ where nbr (Just x) = x
+ nbr Nothing = (-1)
+
+ -- | Renders new UI after user action
+ showNewSel self nr state = do
+
+ -- currently active item of the list
+ k <- comboBoxGetActive self
+
+ -- new state of whole UI
+ st <- readIORef state
+ writeIORef state $ st { usrSt = (newUsrSt st) (show k) nr (usrSt st) }
+
+ reShowPage nr state
+
+ return ()
+
+
+-- ================= Entry ====================
+
+-- | Entry field is rendered and attached to the given table.
+showEntry
+ :: TableClass self =>
+ InputField -- ^ Data and attributes
+ -> Int -- ^ Left coordinate
+ -> Int -- ^ Top coordinate
+ -> Int -- ^ Id of active widget
+ -> self -- ^ Table to attach to
+ -> IORef (State a) -- ^ The state
+ -> IO Entry
+showEntry field left up nr t state = do
+
+ st <- readIORef state
+ en <- entryNew
+ widgetSetSensitivity en (field `fetch` att_editable)
+ afterFocusOut en (outEntry en (field `fetch` idOf) state)
+ when (field `fetch` idOf /= nr) $ liftM (\ _ -> ()) $
+ afterFocusIn en $
+ reShowPage' (field `fetch` idOf) state
+
+ -- Text is the invalid value in case of error flag raised
+ -- or the value otherwise.
+ entrySetText en $ field `fetch` att_rawValue
+
+ tableAttach t en left (left+1) up (up+1) [Fill] [Shrink] 0 5
+
+ return en
+
+ where outEntry self nr state _ = do
+ st <- readIORef state
+
+ -- Retrieve text from the entry field.
+ txt <- entryGetText self
+ writeIORef state $ st { usrSt = (newUsrSt st) txt nr $ usrSt st }
+
+ return False
+
+-- ================= Button ====================
+-- | Attaches given buttun to the given table with action and attributes.
+showButton
+ :: (TableClass self, ButtonClass b) =>
+ InputField -- ^ Attributes
+ -> Int -- ^ Left coordinate
+ -> Int -- ^ Top coordinate
+ -> Int -- ^ Id of active widget
+ -> self -- ^ Table to attach to
+ -> IORef (State a1) -- ^ The state
+ -> b -- ^ Button to attach
+ -> (IORef (State a1) -> IO a) -- ^ Action attached to the button
+ -> IO b
+showButton field left up nr t state bt action = do
+ st <- readIORef state
+ widgetSetSensitivity bt $ field `fetch` att_editable --editable att
+ let id = field `fetch` idOf
+ when (id /= nr) $ liftM (\ _ -> ()) $ afterFocusIn bt $ reShowPage' id state
+ -- On button click there are 3 actions in sequence: new state stored, the @action@ and page refresh.
+ onClicked bt $ writeIORef state (st { usrSt = (newUsrSt st) "" nr $ usrSt st
+ , idFocus = id }) >>
+ action state >>
+ reShowPageVoid id state
+
+ tableAttach t bt left (left+1) up (up+1) [Fill] [Shrink] 0 5
+
+ return bt
+
+-- ================= Check Box ====================
+-- | Renders and attaches new check button to the given table.
+showCheckBox
+ :: TableClass self =>
+ InputField -- ^ @CheckBox@ constructor
+ -> Int -- ^ Left coordinate
+ -> Int -- ^ top coordinate
+ -> Int -- ^ id of active widget
+ -> self -- ^ table to attach to
+ -> IORef (State a) -- ^ The state
+ -> IO CheckButton
+showCheckBox field left up nr t state = do
+ box <- checkButtonNew
+ toggleButtonSetActive box $ field `fetch` val_cbValue --api
+ onToggled box (aferCheckBox field nr state)
+ st <- readIORef state
+
+ widgetSetSensitivity box $ field `fetch` att_editable --att
+
+ -- On focus in (only if grabbed from another widget) redraw page of notebook
+ let id = field `fetch` idOf
+ when (id /= nr) $ liftM (\ _ -> ()) $ onFocusIn box $ reShowPage' id state
+ -- Use (aferCheckBox' state b widget) for single click needed to change the value
+ -- Use (reShowPage state i) for double click needed to change the value
+ tableAttach t box left (left+1) up (up+1) [Fill] [Shrink] 0 5
+ return box
+
+ where aferCheckBox field nr state = do
+ st <- readIORef state
+ writeIORef state $ st { usrSt = (newUsrSt st) "" nr $ usrSt st }
+ reShowPageVoid (field `fetch` idOf) state
+
+-- ====================== New Table ==========================
+-- | Packs a new table into a new frame, the frame into given box and returns table.
+-- Gets label for the frame, box and size of the new table.
+newTable :: BoxClass self => String -> self -> Int -> Int -> IO Table
+newTable label box x y = frameNew >>= \fr ->
+ frameSetLabel fr label >>
+ boxPackStart box fr PackNatural 5 >>
+ tableNew x y False >>= \tb ->
+ containerAdd fr tb >>
+ return tb
diff --git a/Graphics/UI/Gtk/WtkGtkBp.hs b/Graphics/UI/Gtk/WtkGtkBp.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/UI/Gtk/WtkGtkBp.hs
@@ -0,0 +1,146 @@
+---------------------------------------------------------
+--
+-- 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 ("" ++ val ++ "") (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 = "" ++ field `fetch` att_errMssg ++ ""
+ {-case isError att of
+ True -> do
+ lb <- labelNew Nothing
+ labelSetMarkup lb $ "" ++
+ errMssg att ++ ""
+ tableAttach t lb left (left+1) up (up+1) [Fill] [Shrink] 0 5
+ False -> return ()-}
+
+
diff --git a/Graphics/UI/Gtk/WtkGui.hs b/Graphics/UI/Gtk/WtkGui.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/UI/Gtk/WtkGui.hs
@@ -0,0 +1,127 @@
+---------------------------------------------------------
+--
+-- Module : GUI.wtk-gui
+-- Copyright : Bartosz Wójcik (2010)
+-- License : BSD3
+--
+-- Maintainer : bartek@sudety.it
+-- Stability : Unstable
+-- Portability : portable
+--
+-- | Data types being standard interface between any GUI and
+-- underlying application.
+-- Heavy usage of lenses, which has disadvantage of huge amount
+-- of API documentation without proper comments.
+---------------------------------------------------------
+{-# LANGUAGE ExistentialQuantification
+, TemplateHaskell
+, FlexibleContexts
+, NoMonomorphismRestriction #-}
+module Graphics.UI.Gtk.WtkGui
+
+where
+
+import Data.Time
+import Data.IORef (IORef)
+import Data.Lenses
+import Data.Lenses.Template
+
+-- | Abstract input types. Denote UI fields.
+data InputFieldType =
+ -- | Float value
+ Fl { flValue_ :: Maybe Double -- ^ parsed value
+ }
+
+ -- | Integer value
+ | In { inValue_ :: Maybe Int }
+
+ -- | String value
+ | Str { stValue_ :: String }
+
+ -- | Date value
+ | Da { daValue_ :: Maybe Day }
+
+ -- | Selection list (no syntax validation)
+ | Selection { selValue_ :: Maybe Int -- ^ selected item
+ , selString_ :: [String] -- ^ list of avaliable values
+ }
+
+ -- | Check Box (no syntax validation)
+ | CheckBox { cbValue_ :: Bool }
+
+ -- | Very general action.
+ | Action { action_ :: IO () }
+
+ -- | In case no data needed for a widget.
+ | NoDataJustAttributes
+
+ -- Action is so particular GUI solution specific so we not abstract it.
+-- forall a. Action { action :: IORef a -> IO () } -- ^ action itself
+
+instance Show InputFieldType where
+ show (Fl x) = "Fl " ++ show x
+ show (In x) = "In " ++ show x
+ show (Str x) = "St " ++ x
+ show (Da x) = "Da " ++ show x
+ show (Selection x y) = "Sel " ++ show x ++ " " ++ show y
+ show (CheckBox x) = "CB " ++ show x
+ show (Action _) = "Action"
+
+$( deriveLenses ''InputFieldType )
+
+isSelectionJust (Selection (Just _) _) = True
+isSelectionJust _ = False
+isInputJust (Fl (Just _)) = True
+isInputJust (In (Just _)) = True
+isInputJust (Da (Just _)) = True
+isInputJust _ = False
+isCheckBox (CheckBox _) = True
+isCheckBox _ = False
+setCheckBox v (CheckBox _) = CheckBox v
+setCheckBox _ x = x
+
+newSelection :: Int -> InputFieldType -> InputFieldType
+newSelection i s@(Selection _ xs) | length xs < i-1 || i < 0 = s
+ | otherwise = Selection (Just i) xs
+
+-- ================= Abstract Widget ========================
+-- | Attributes of an abstract widget
+data Attributes = Attributes {
+ rawValue_ :: String -- ^ raw value
+ , validated_ :: Bool -- ^ value has been validated
+ , visible_ :: Bool -- ^ visibility
+ , editable_ :: Bool -- ^ value editable
+ , isError_ :: Bool -- ^ True when value is not correct
+ , errMssg_ :: String -- ^ error message
+ }
+ deriving (Show, Eq, Ord)
+
+$( deriveLenses ''Attributes )
+
+-- | Abstraction of widget. It consists of id, value with type and attributes.
+-- This is main data type to use as widget field. It consist of all what needed:
+-- its ID, its value of one of allowed types and attributes.
+data InputField = InputField {idOf_ :: Int
+ ,val_ :: InputFieldType
+ ,att_ :: Attributes
+ }
+ deriving Show
+
+$( deriveLenses ''InputField )
+
+-- | Boilerplating not provided by Lenses.Template
+val_flValue = val . flValue
+val_inValue = val . inValue
+val_stValue = val . stValue
+val_daValue = val . daValue
+val_cbValue = val . cbValue
+val_selValue = val . selValue
+val_selString = val . selString
+val_action = val . action
+
+att_rawValue = att . rawValue
+att_validated = att . validated
+att_visible = att . visible
+att_editable = att . editable
+att_isError = att . isError
+att_errMssg = att . errMssg
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/license b/license
new file mode 100644
--- /dev/null
+++ b/license
@@ -0,0 +1,2 @@
+copyright: Bartosz Wójcik (2010)
+license: BSD3
diff --git a/wtk-gtk.cabal b/wtk-gtk.cabal
new file mode 100644
--- /dev/null
+++ b/wtk-gtk.cabal
@@ -0,0 +1,29 @@
+Name: wtk-gtk
+Version: 0.1
+License: BSD3
+License-file: license
+Author: Bartosz Wojcik
+Maintainer: Bartosz Wojcik
+Copyright: Copyright (c) 2012 Bartosz Wojcik
+Category: Tool Kit
+Synopsis: GTK tools within Wojcik Tool Kit
+Stability: experimental
+Build-type: Simple
+Description: Set of simple tools for standardized development of UI where
+ input is set of fields of certain (though various) types
+ and there is defined business logic between the fields, values
+ they can accept. Helps with error messages for user.
+ It's idea is separation of presentation layer and business logic.
+ This succeed but at certain costs.
+ Tool is definetely experimental. Contains lots of awkward hacks.
+
+
+Cabal-Version: >=1.2.3
+
+Library
+ Build-Depends: base >= 3 && < 5, parsec >= 2.1, old-locale >= 1.0, time >= 1.1.0,
+ containers >= 0.2, gtk >= 0.10, mtl >= 1.1.0.2, wtk, lenses
+ Exposed-modules: Graphics.UI.Gtk.WtkGui,
+ Graphics.UI.Gtk.WtkGtk,
+ Graphics.UI.Gtk.WtkGtkBp
+