{-# LANGUAGE ImplicitParams, OverloadedStrings, AllowAmbiguousTypes, GADTs, CPP, ExistentialQuantification, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, ScopedTypeVariables, UndecidableInstances #-}
module Graphics.UI.FLTK.Theme.Light.Table
(
drawDataCell,
drawHeader,
drawHeaderWithImage,
tableCustom,
tableRowNew
)
where
import Graphics.UI.FLTK.LowLevel.Fl_Types
import Graphics.UI.FLTK.Theme.Light.Common
import qualified Data.Text as T
import qualified Graphics.UI.FLTK.LowLevel.FLTKHS as LowLevel
import Graphics.UI.FLTK.LowLevel.Fl_Enumerations
import Graphics.UI.FLTK.Theme.Light.Assets
drawHeader :: (?assets :: Assets) => Color -> Alignments -> T.Text -> Rectangle -> IO ()
drawHeader c labelAlign l rect = do
spec <- fmap (\s -> s { fillCornerRadius = 0 }) (makeFillSpec rect c c)
fillRectangle spec False
borderRectangle spec True False
f <- LowLevel.flcFont
s <- LowLevel.flcSize
LowLevel.flcSetFont commonFont commonFontSize
oldC <- LowLevel.flcColor
LowLevel.flcSetColor blackColor
LowLevel.flcDrawInBox l rect labelAlign Nothing Nothing
LowLevel.flcSetColor oldC
LowLevel.flcSetFont f s
drawHeaderWithImage :: (LowLevel.Parent a LowLevel.Image, ?assets :: Assets) => Color -> Alignments -> T.Text -> Ref a -> Rectangle -> IO ()
drawHeaderWithImage c labelAlign l i rect = do
spec <- fmap (\s -> s { fillCornerRadius = 0 }) (makeFillSpec rect c c)
fillRectangle spec False
borderRectangle spec True False
f <- LowLevel.flcFont
s <- LowLevel.flcSize
LowLevel.flcSetFont commonFont commonFontSize
oldC <- LowLevel.flcColor
LowLevel.flcSetColor blackColor
LowLevel.flcDrawInBoxWithImageReference l rect labelAlign Nothing i Nothing
LowLevel.flcSetColor oldC
LowLevel.flcSetFont f s
drawDataCell :: (?assets :: Assets) => Color -> Alignments -> T.Text -> Rectangle -> IO ()
drawDataCell c contentsAlign contents rect = do
spec <- fmap (\s -> s { fillCornerRadius = 0 }) (makeFillSpec rect c c)
LowLevel.flcRectfWithColor rect c
f <- LowLevel.flcFont
s <- LowLevel.flcSize
oldC <- LowLevel.flcColor
LowLevel.flcSetFont commonFont commonFontSize
LowLevel.flcSetColor blackColor
let (x,y,w,h) = fromRectangle rect
LowLevel.flcDrawInBox contents (toRectangle (x+1,y+1,w-2,h-2)) contentsAlign Nothing Nothing
LowLevel.flcRectWithColor rect (fillBorderColor spec)
LowLevel.flcSetColor oldC
LowLevel.flcSetFont f s
tableCustom :: Rectangle
-> Maybe T.Text
-> Maybe (Ref LowLevel.Table -> IO ())
-> (Ref LowLevel.Table -> TableContext -> LowLevel.TableCoordinate -> Rectangle -> IO ())
-> LowLevel.CustomWidgetFuncs LowLevel.Table
-> LowLevel.CustomTableFuncs LowLevel.Table
-> IO (Ref LowLevel.Table)
tableCustom rectangle label' draw'' drawCell' customWidgetFuncs' customTableFuncs' = do
t <- LowLevel.tableCustom rectangle label' draw'' drawCell' customWidgetFuncs' customTableFuncs'
c <- commonColor
LowLevel.setColor t lightBackground
LowLevel.setColHeaderColor t c
LowLevel.setRowHeaderColor t c
commonFillColor >>= LowLevel.setSelectionColor t
return t
tableRowNew :: Rectangle
-> Maybe T.Text
-> Maybe (Ref LowLevel.TableRow -> IO ())
-> (Ref LowLevel.TableRow -> TableContext -> LowLevel.TableCoordinate -> Rectangle -> IO ())
-> LowLevel.CustomWidgetFuncs LowLevel.TableRow
-> LowLevel.CustomTableFuncs LowLevel.TableRow
-> IO (Ref LowLevel.TableRow)
tableRowNew rectangle label' draw'' drawCell' customWidgetFuncs' customTableFuncs' = do
t <- LowLevel.tableRowNew rectangle label' draw'' drawCell' customWidgetFuncs' customTableFuncs'
c <- commonColor
LowLevel.setColor t lightBackground
LowLevel.setColHeaderColor t c
LowLevel.setRowHeaderColor t c
commonFillColor >>= LowLevel.setSelectionColor t
return t