{-# LANGUAGE TemplateHaskell #-}
module Simple.UI.Widgets.TextItem (
TextItem,
TextItemClass,
castToTextItem,
textItemNew,
itemData
) where
import Control.Lens (makeLensesFor, (.=))
import Control.Monad (forM_)
import Simple.UI.Core.Attribute
import Simple.UI.Core.Draw
import Simple.UI.Core.ListenerList
import Simple.UI.Core.UIApp
import Simple.UI.Widgets.Properties.Selected
import Simple.UI.Widgets.Text
import Simple.UI.Widgets.Widget
data TextItem a = TextItem
{ _textItemParent :: Text
, _textItemData :: Attribute (Maybe a)
, _textItemSelected :: Attribute Bool
}
makeLensesFor [("_textItemParent", "textItemParent")] ''TextItem
class TextItemClass w where
castToTextItem :: w a -> TextItem a
itemData :: w a -> Attribute (Maybe a)
itemData = _textItemData . castToTextItem
instance WidgetClass (TextItem a) where
castToWidget = castToWidget . _textItemParent
overrideWidget = overrideWidgetHelper textItemParent
instance TextClass (TextItem a) where
castToText = castToText . _textItemParent
instance TextItemClass TextItem where
castToTextItem = id
instance HasSelected (TextItem a) where
selected = _textItemSelected
textItemNew :: Maybe String -> UIApp u (TextItem a)
textItemNew s = do
parent <- textNew s
sel <- attributeNew False
d <- attributeNew Nothing
let textItem = overrideWidget
TextItem { _textItemParent = parent
, _textItemData = d
, _textItemSelected = sel
}
$ virtualWidgetName .= "textitem"
_ <- on textItem draw $ textItemDraw textItem
return textItem
textItemDraw :: TextItem a -> Drawing -> Int -> Int -> UIApp u ()
textItemDraw item drawing width _ = do
maybeText <- get item text
(fg, bg, style) <- selectedGetColors item
drawingRun drawing $ do
drawingSetAttrs fg bg style
drawingClear
forM_ maybeText $ \_text ->
drawingRun drawing $ do
_align <- get item align
case _align of
TextAlignLeft -> drawingPutString 0 0 _text
TextAlignRight -> drawingPutString (width - length _text) 0 _text
TextAlignCenter -> drawingPutString ((width - length _text) `div` 2) 0 _text