wtk-gtk (empty) → 0.1
raw patch · 6 files changed
+708/−0 lines, 6 filesdep +basedep +containersdep +gtksetup-changed
Dependencies added: base, containers, gtk, lenses, mtl, old-locale, parsec, time, wtk
Files
- Graphics/UI/Gtk/WtkGtk.hs +402/−0
- Graphics/UI/Gtk/WtkGtkBp.hs +146/−0
- Graphics/UI/Gtk/WtkGui.hs +127/−0
- Setup.hs +2/−0
- license +2/−0
- wtk-gtk.cabal +29/−0
+ Graphics/UI/Gtk/WtkGtk.hs view
@@ -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
+ Graphics/UI/Gtk/WtkGtkBp.hs view
@@ -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 ("<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 ()-} + +
+ Graphics/UI/Gtk/WtkGui.hs view
@@ -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
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple +main = defaultMain
+ license view
@@ -0,0 +1,2 @@+copyright: Bartosz Wójcik (2010)+license: BSD3
+ wtk-gtk.cabal view
@@ -0,0 +1,29 @@+Name: wtk-gtk+Version: 0.1+License: BSD3+License-file: license+Author: Bartosz Wojcik+Maintainer: Bartosz Wojcik <bartoszmwojcik@gmail.com>+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+