module Barrie.Widgets (Widget, widgetElementName, widgetToLines, widgetChildren, widgetStyle, widgetPopupChild, mkWidget, mkPopup, ui, ui', uiElementName, LayoutDirection(..), vbox, hbox, menu, menuItem, button, labelButton, checkButton, textLabel, slider, hslider, vslider, staticDropList, dropList, listView, radioButtonList, textBox, textBoxWithValue) where import Data.List import Barrie.Style data Widget = Widget { elementName :: String, styles :: Style, uiName :: [String], wpopup :: Maybe Widget, wdirection :: Maybe LayoutDirection, children :: [Widget] } deriving (Read, Show) data LayoutDirection = Vertical | Horizontal deriving (Read, Show) instance Styled Widget where getStyle = styles setStyle style w = w { styles = style } widgetElementName :: Widget -> String widgetElementName w = prefix ++ elementName w where prefix = case wdirection w of Nothing -> "" Just Vertical -> "v" Just Horizontal -> "h" 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 Nothing ws mkPopup :: String -> Widget -> Widget -> Widget mkPopup uiname popup w = ui uiname w { wpopup = Just popup } layoutDirection :: LayoutDirection -> Widget -> Widget layoutDirection d w = w { wdirection = Just d } 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 = layoutDirection Vertical . mkWidget "box" hbox = layoutDirection Horizontal . mkWidget "box" slider :: (Real a) => LayoutDirection -> a -> a -> a -> Widget slider d lo hi adj = (minValue ((realToFrac lo) :: Double) . maxValue ((realToFrac hi) :: Double) . adjustment ((realToFrac adj) :: Double) . layoutDirection d) (mkWidget "slider" []) hslider, vslider :: (Real a) => a -> a -> a -> Widget hslider = slider Horizontal vslider = slider Vertical 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 []) checkButton :: Widget checkButton = mkWidget "checkbutton" [] 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" [] listView :: Widget listView = mkWidget "list" [] radioButtonList :: LayoutDirection -> Widget radioButtonList d = layoutDirection d $ mkWidget "radioButtonList" [] textBox :: Widget textBox = mkWidget "textbox" [] textBoxWithValue :: String -> Widget textBoxWithValue text = textValue text textBox