Widgets.lhs

> module Barrie.Widgets
>     (Widget, widgetElementName, widgetToLines, widgetChildren, widgetStyle,
>      widgetPopupChild,
>      mkWidget, mkPopup,
>      ui, ui', uiElementName,
>      vbox, hbox, menu, menuItem, button, labelButton, textLabel,
>      staticDropList, dropList, list, textBox, textBoxWithValue)
>     where

> import Data.List

> import Barrie.Style

> data Widget = Widget { elementName  :: String,
>                        styles       :: Style,
>                        uiName       :: [String],
>                        wpopup       :: Maybe Widget,
>                        children     :: [Widget]
>                      }
>               deriving (Read, Show)

> instance Styled Widget where
>    getStyle = styles
>    setStyle style w = w { styles = style }

> widgetElementName :: Widget -> String
> widgetElementName = elementName

> widgetToLines :: Widget -> [String]
> widgetToLines w = widgetLine : concatMap widgetToLines (children w)
>     where widgetLine = elementName w ++ uiLine
>           uiLine = case uiName w of
>                      []  -> ""
>                      nms -> " (" ++ intercalate "." nms ++ ")"

> widgetChildren :: Widget -> [Widget]
> widgetChildren = children

> widgetStyle :: Widget -> Style
> widgetStyle = styles

> widgetPopupChild :: Widget -> Maybe Widget
> widgetPopupChild = wpopup

> mkWidget :: String -> [Widget] -> Widget
> mkWidget elmtName ws = Widget elmtName emptyStyle [] Nothing ws

> mkPopup :: String -> Widget -> Widget -> Widget
> mkPopup uiname popup w = ui uiname w { wpopup = Just popup }

> ui :: String -> Widget -> Widget
> ui name = ui' [name]

> ui' :: [String] -> Widget -> Widget
> ui' name widget = widget { uiName = name }

> uiElementName :: Widget -> [String]
> uiElementName = uiName

> vbox, hbox :: [Widget] -> Widget
> vbox = mkWidget "vbox"
> hbox = mkWidget "hbox"

> table :: [[Widget]] -> Widget
> table = mkWidget "table" . map tableRow

> tableRow :: [Widget] -> Widget
> tableRow = mkWidget "tr" . map tableCell

> tableCell :: Widget -> Widget
> tableCell = mkWidget "td" . (:[])

> menu :: [Widget] -> Widget
> menu = mkWidget "menu"

> menuItem :: [Widget] -> Widget
> menuItem = mkWidget "menuitem"

> button :: [Widget] -> Widget
> button = mkWidget "button"

> labelButton :: String -> Widget
> labelButton text = caption text (button [])

> textLabel :: String -> Widget
> textLabel text = caption text (mkWidget "label" [])

> staticDropList :: String -> [String] -> Widget
> staticDropList val vals = textValue val $ textItems vals $
>                                 mkWidget "droplist" []

> dropList :: Widget
> dropList = mkWidget "droplist" []

> list :: Widget
> list = mkWidget "list" []

> textBox :: Widget
> textBox  = mkWidget "textbox" []

> textBoxWithValue :: String -> Widget
> textBoxWithValue text  = textValue text textBox