{-# LINE 1 "src/Graphics/UI/FLTK/LowLevel/MultiLabel.chs" #-}
{-# LANGUAGE ScopedTypeVariables, ExistentialQuantification, CPP, UndecidableInstances, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Graphics.UI.FLTK.LowLevel.MultiLabel
(
multiLabelNew,
MultiLabelContent(..),
getMultiLabelContents,
setMultiLabelContents
)
where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import C2HS hiding (cFromEnum, cFromBool, cToBool,cToEnum)
import Graphics.UI.FLTK.LowLevel.Fl_Types
import Graphics.UI.FLTK.LowLevel.Utils
import Graphics.UI.FLTK.LowLevel.Hierarchy
import Graphics.UI.FLTK.LowLevel.Dispatch
import Graphics.UI.FLTK.LowLevel.Fl_Enumerations
import qualified Data.Text as T
multiLabelNew' :: (Ptr CChar) -> (Ptr CChar) -> (Labeltype) -> (Labeltype) -> IO ((Ptr ()))
multiLabelNew' a1 a2 a3 a4 =
let {a1' = id a1} in
let {a2' = id a2} in
let {a3' = cFromEnum a3} in
let {a4' = cFromEnum a4} in
multiLabelNew''_ a1' a2' a3' a4' >>= \res ->
let {res' = id res} in
return (res')
{-# LINE 26 "src/Graphics/UI/FLTK/LowLevel/MultiLabel.chs" #-}
labela' :: (Ptr ()) -> IO ((Ptr CChar))
labela' a1 =
let {a1' = id a1} in
labela''_ a1' >>= \res ->
let {res' = id res} in
return (res')
{-# LINE 27 "src/Graphics/UI/FLTK/LowLevel/MultiLabel.chs" #-}
setLabela' :: (Ptr ()) -> (Ptr CChar) -> IO ()
setLabela' a1 a2 =
let {a1' = id a1} in
let {a2' = id a2} in
setLabela''_ a1' a2' >>
return ()
{-# LINE 28 "src/Graphics/UI/FLTK/LowLevel/MultiLabel.chs" #-}
labelb' :: (Ptr ()) -> IO ((Ptr CChar))
labelb' a1 =
let {a1' = id a1} in
labelb''_ a1' >>= \res ->
let {res' = id res} in
return (res')
{-# LINE 29 "src/Graphics/UI/FLTK/LowLevel/MultiLabel.chs" #-}
setLabelb' :: (Ptr ()) -> (Ptr CChar) -> IO ()
setLabelb' a1 a2 =
let {a1' = id a1} in
let {a2' = id a2} in
setLabelb''_ a1' a2' >>
return ()
{-# LINE 30 "src/Graphics/UI/FLTK/LowLevel/MultiLabel.chs" #-}
typea' :: (Ptr ()) -> IO ((Labeltype))
typea' a1 =
let {a1' = id a1} in
typea''_ a1' >>= \res ->
let {res' = cToEnum res} in
return (res')
{-# LINE 31 "src/Graphics/UI/FLTK/LowLevel/MultiLabel.chs" #-}
setTypea' :: (Ptr ()) -> (Labeltype) -> IO ()
setTypea' a1 a2 =
let {a1' = id a1} in
let {a2' = cFromEnum a2} in
setTypea''_ a1' a2' >>
return ()
{-# LINE 32 "src/Graphics/UI/FLTK/LowLevel/MultiLabel.chs" #-}
typeb' :: (Ptr ()) -> IO ((Labeltype))
typeb' a1 =
let {a1' = id a1} in
typeb''_ a1' >>= \res ->
let {res' = cToEnum res} in
return (res')
{-# LINE 33 "src/Graphics/UI/FLTK/LowLevel/MultiLabel.chs" #-}
setTypeb' :: (Ptr ()) -> (Labeltype) -> IO ()
setTypeb' a1 a2 =
let {a1' = id a1} in
let {a2' = cFromEnum a2} in
setTypeb''_ a1' a2' >>
return ()
{-# LINE 34 "src/Graphics/UI/FLTK/LowLevel/MultiLabel.chs" #-}
setWidgetLabel' :: (Ptr ()) -> (Ptr ()) -> IO ()
setWidgetLabel' a1 a2 =
let {a1' = id a1} in
let {a2' = id a2} in
setWidgetLabel''_ a1' a2' >>
return ()
{-# LINE 35 "src/Graphics/UI/FLTK/LowLevel/MultiLabel.chs" #-}
setMenuItemLabel' :: (Ptr ()) -> (Ptr ()) -> IO ()
setMenuItemLabel' a1 a2 =
let {a1' = id a1} in
let {a2' = id a2} in
setMenuItemLabel''_ a1' a2' >>
return ()
{-# LINE 36 "src/Graphics/UI/FLTK/LowLevel/MultiLabel.chs" #-}
data MultiLabelContent
= MultiLabelContentText (Labeltype, T.Text)
| forall a.(Parent a Image) => MultiLabelContentImage (Ref a)
toLabelTypePtr :: MultiLabelContent -> IO (Labeltype, Ptr CChar)
toLabelTypePtr mlc =
case mlc of
MultiLabelContentText (lt, t) -> do
t' <- copyTextToCString t
return (lt, t')
MultiLabelContentImage i -> do
i' <- unsafeRefToPtr i
return (ImageLabelType, (castPtr i'))
getMultiLabelContents :: Ref MultiLabel -> IO [MultiLabelContent]
getMultiLabelContents ml =
withRef ml $ \mlPtr -> extractMultiLabels [] mlPtr
where
extractMultiLabels :: [MultiLabelContent] -> Ptr () -> IO [MultiLabelContent]
extractMultiLabels accum mlPtr = do
tA <- typea' mlPtr
tB <- typeb' mlPtr
case (tA, tB) of
(NoLabelType, NoLabelType) -> return []
(ImageLabelType,_) -> do
(i :: Ref Image) <- labela' mlPtr >>= toRef . castPtr
let soFar = accum ++ [(MultiLabelContentImage i)]
rest <- labelb' mlPtr
extractMultiLabels soFar (castPtr rest)
(lt,_) -> do
t <- labela' mlPtr >>= cStringToText
let soFar = accum ++ [(MultiLabelContentText (lt, t))]
rest <- labelb' mlPtr
extractMultiLabels soFar (castPtr rest)
multiLabelNew :: [MultiLabelContent] -> IO (Ref MultiLabel)
multiLabelNew mlcs =
chainMultiLabels mlcs >>= toRef
where
chainMultiLabels :: [MultiLabelContent] -> IO (Ptr ())
chainMultiLabels [] = multiLabelNew' (castPtr nullPtr) (castPtr nullPtr) NoLabelType NoLabelType
chainMultiLabels (mlc:mlcs) = do
(lt,ptr) <- toLabelTypePtr mlc
mls <- chainMultiLabels mlcs
multiLabelNew' ptr (castPtr mls) lt MultiLabelType
setMultiLabelContents :: Ref MultiLabel -> [MultiLabelContent] -> IO ()
setMultiLabelContents ml mlcs = do
currMlcs <- getMultiLabelContents ml
withRef ml $ \mlPtr -> do
freeTextLabels mlPtr currMlcs
insertNewContents mlPtr mlcs
where
freeTextLabels :: Ptr () -> [MultiLabelContent] -> IO ()
freeTextLabels mlPtr [] = return ()
freeTextLabels mlPtr (mlc:mlcs)=
case mlc of
MultiLabelContentText _ -> do
t <- labela' mlPtr
free t
rest <- labelb' mlPtr
freeTextLabels (castPtr rest) mlcs
_ -> do
rest <- labelb' mlPtr
freeTextLabels (castPtr rest) mlcs
insertNewContents :: Ptr () -> [MultiLabelContent] -> IO ()
insertNewContents mlPtr [] = do
setTypeb' mlPtr MultiLabelType
end <- multiLabelNew' (castPtr nullPtr) (castPtr nullPtr) NoLabelType NoLabelType
setLabelb' mlPtr (castPtr end)
insertNewContents mlPtr mlcs = do
rest <- setPtr mlPtr (head mlcs)
if (null (tail mlcs))
then do
setTypeb' mlPtr MultiLabelType
end <- multiLabelNew' (castPtr nullPtr) (castPtr nullPtr) NoLabelType NoLabelType
setLabelb' mlPtr (castPtr end)
else insertNewContents (castPtr rest) (tail mlcs)
setPtr :: Ptr () -> MultiLabelContent -> IO (Ptr ())
setPtr mlPtr mlc = do
(lt,ptr) <- toLabelTypePtr mlc
setTypea' mlPtr lt
setLabela' mlPtr ptr
labelb' mlPtr >>= return . castPtr
instance (Parent a Widget, impl ~ (Ref a -> IO ())) => Op (WidgetLabel ()) MultiLabel orig impl where
runOp _ _ widget widget' =
withRef widget $ \widgetPtr ->
withRef widget' $ \widget'Ptr ->
setWidgetLabel' widgetPtr widget'Ptr
instance (Parent a MenuItem, impl ~ (Ref a -> IO ())) => Op (MenuItemLabel ()) MultiLabel orig impl where
runOp _ _ widget widget' =
withRef widget $ \widgetPtr ->
withRef widget' $ \widget'Ptr ->
setMenuItemLabel' widgetPtr widget'Ptr
foreign import ccall safe "Graphics/UI/FLTK/LowLevel/MultiLabel.chs.h Fl_Multi_Label_New"
multiLabelNew''_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUChar -> (C2HSImp.CUChar -> (IO (C2HSImp.Ptr ()))))))
foreign import ccall safe "Graphics/UI/FLTK/LowLevel/MultiLabel.chs.h Fl_Multi_Label_labela"
labela''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))
foreign import ccall safe "Graphics/UI/FLTK/LowLevel/MultiLabel.chs.h Fl_Multi_Label_set_labela"
setLabela''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO ())))
foreign import ccall safe "Graphics/UI/FLTK/LowLevel/MultiLabel.chs.h Fl_Multi_Label_labelb"
labelb''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))
foreign import ccall safe "Graphics/UI/FLTK/LowLevel/MultiLabel.chs.h Fl_Multi_Label_set_labelb"
setLabelb''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO ())))
foreign import ccall safe "Graphics/UI/FLTK/LowLevel/MultiLabel.chs.h Fl_Multi_Label_typea"
typea''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CUChar))
foreign import ccall safe "Graphics/UI/FLTK/LowLevel/MultiLabel.chs.h Fl_Multi_Label_set_typea"
setTypea''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CUChar -> (IO ())))
foreign import ccall safe "Graphics/UI/FLTK/LowLevel/MultiLabel.chs.h Fl_Multi_Label_typeb"
typeb''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CUChar))
foreign import ccall safe "Graphics/UI/FLTK/LowLevel/MultiLabel.chs.h Fl_Multi_Label_set_typeb"
setTypeb''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CUChar -> (IO ())))
foreign import ccall safe "Graphics/UI/FLTK/LowLevel/MultiLabel.chs.h Fl_Multi_Label_label_widget"
setWidgetLabel''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))
foreign import ccall safe "Graphics/UI/FLTK/LowLevel/MultiLabel.chs.h Fl_Multi_Label_label_menu_item"
setMenuItemLabel''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))