Widgets.hs

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,
     FileChooserAction(..),
     fileChooserAction, fileChooser, fileOpen, fileSave)
    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

data FileChooserAction = FileOpen | FileSave deriving (Read, Show)

fileChooser :: FileChooserAction -> String -> Widget
fileChooser action label =
     addStyle (mkStyle "fileChooserAction" (show action)) $
     caption label $ mkWidget "fileChooser" []

fileOpen, fileSave :: String -> Widget
fileOpen = fileChooser FileOpen
fileSave = fileChooser FileSave

fileChooserAction :: (Styled a) => a -> FileChooserAction
fileChooserAction = maybe FileOpen read . styleValue "fileChooserAction"