{-# 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 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
a3} in
let {a4' = cFromEnum a4} in
multiLabelNew''_ a1' a2' a3' a4' >>= \res ->
let {res' = id res} in
Labeltype -> IO Labeltype
forall (m :: * -> *) a. Monad m => a -> m a
return (Labeltype
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 ()
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 :: Ref MultiLabel -> IO [MultiLabelContent]
getMultiLabelContents ml :: Ref MultiLabel
ml =
Ref MultiLabel
-> (Ptr () -> IO [MultiLabelContent]) -> IO [MultiLabelContent]
forall a b c. HasCallStack => Ref a -> (Ptr b -> IO c) -> IO c
withRef Ref MultiLabel
ml ((Ptr () -> IO [MultiLabelContent]) -> IO [MultiLabelContent])
-> (Ptr () -> IO [MultiLabelContent]) -> IO [MultiLabelContent]
forall a b. (a -> b) -> a -> b
$ \mlPtr :: Ptr ()
mlPtr -> [MultiLabelContent] -> Ptr () -> IO [MultiLabelContent]
extractMultiLabels [] Ptr ()
mlPtr
where
extractMultiLabels :: [MultiLabelContent] -> Ptr () -> IO [MultiLabelContent]
extractMultiLabels :: [MultiLabelContent] -> Ptr () -> IO [MultiLabelContent]
extractMultiLabels accum :: [MultiLabelContent]
accum mlPtr :: Ptr ()
mlPtr = do
Labeltype
tA <- Ptr () -> IO Labeltype
typea' Ptr ()
mlPtr
Labeltype
tB <- Ptr () -> IO Labeltype
typeb' Ptr ()
mlPtr
case (Labeltype
tA, Labeltype
tB) of
(NoLabelType, NoLabelType) -> [MultiLabelContent] -> IO [MultiLabelContent]
forall (m :: * -> *) a. Monad m => a -> m a
return []
(ImageLabelType,_) -> do
(Ref Image
i :: Ref Image) <- Ptr () -> IO (Ptr CChar)
labela' Ptr ()
mlPtr IO (Ptr CChar) -> (Ptr CChar -> IO (Ref Image)) -> IO (Ref Image)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr () -> IO (Ref Image)
forall a. Ptr () -> IO (Ref a)
toRef (Ptr () -> IO (Ref Image))
-> (Ptr CChar -> Ptr ()) -> Ptr CChar -> IO (Ref Image)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr CChar -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr
let soFar :: [MultiLabelContent]
soFar = [MultiLabelContent]
accum [MultiLabelContent] -> [MultiLabelContent] -> [MultiLabelContent]
forall a. [a] -> [a] -> [a]
++ [(Ref Image -> MultiLabelContent
forall a. Parent a Image => Ref a -> MultiLabelContent
MultiLabelContentImage Ref Image
i)]
Ptr CChar
rest <- Ptr () -> IO (Ptr CChar)
labelb' Ptr ()
mlPtr
[MultiLabelContent] -> Ptr () -> IO [MultiLabelContent]
extractMultiLabels [MultiLabelContent]
soFar (Ptr CChar -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
rest)
(lt :: Labeltype
lt,_) -> do
Text
t <- Ptr () -> IO (Ptr CChar)
labela' Ptr ()
mlPtr IO (Ptr CChar) -> (Ptr CChar -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cStringToText
let soFar :: [MultiLabelContent]
soFar = [MultiLabelContent]
accum [MultiLabelContent] -> [MultiLabelContent] -> [MultiLabelContent]
forall a. [a] -> [a] -> [a]
++ [((Labeltype, Text) -> MultiLabelContent
MultiLabelContentText (Labeltype
lt, Text
t))]
Ptr CChar
rest <- Ptr () -> IO (Ptr CChar)
labelb' Ptr ()
mlPtr
[MultiLabelContent] -> Ptr () -> IO [MultiLabelContent]
extractMultiLabels [MultiLabelContent]
soFar (Ptr CChar -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
rest)
multiLabelNew :: [MultiLabelContent] -> IO (Ref MultiLabel)
multiLabelNew :: [MultiLabelContent] -> IO (Ref MultiLabel)
multiLabelNew mlcs :: [MultiLabelContent]
mlcs =
[MultiLabelContent] -> IO (Ptr ())
chainMultiLabels [MultiLabelContent]
mlcs IO (Ptr ())
-> (Ptr () -> IO (Ref MultiLabel)) -> IO (Ref MultiLabel)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr () -> IO (Ref MultiLabel)
forall a. Ptr () -> IO (Ref a)
toRef
where
chainMultiLabels :: [MultiLabelContent] -> IO (Ptr ())
chainMultiLabels :: [MultiLabelContent] -> IO (Ptr ())
chainMultiLabels [] = Ptr CChar -> Ptr CChar -> Labeltype -> Labeltype -> IO (Ptr ())
multiLabelNew' (Ptr Any -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
forall a. Ptr a
nullPtr) (Ptr Any -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
forall a. Ptr a
nullPtr) Labeltype
NoLabelType Labeltype
NoLabelType
chainMultiLabels (mlc :: MultiLabelContent
mlc:mlcs :: [MultiLabelContent]
mlcs) = do
(lt :: Labeltype
lt,ptr :: Ptr CChar
ptr) <- MultiLabelContent -> IO (Labeltype, Ptr CChar)
toLabelTypePtr MultiLabelContent
mlc
Ptr ()
mls <- [MultiLabelContent] -> IO (Ptr ())
chainMultiLabels [MultiLabelContent]
mlcs
Ptr CChar -> Ptr CChar -> Labeltype -> Labeltype -> IO (Ptr ())
multiLabelNew' Ptr CChar
ptr (Ptr () -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
mls) Labeltype
lt Labeltype
MultiLabelType
setMultiLabelContents :: Ref MultiLabel -> [MultiLabelContent] -> IO ()
setMultiLabelContents :: Ref MultiLabel -> [MultiLabelContent] -> IO ()
setMultiLabelContents ml :: Ref MultiLabel
ml mlcs :: [MultiLabelContent]
mlcs = do
[MultiLabelContent]
currMlcs <- Ref MultiLabel -> IO [MultiLabelContent]
getMultiLabelContents Ref MultiLabel
ml
Ref MultiLabel -> (Ptr () -> IO ()) -> IO ()
forall a b c. HasCallStack => Ref a -> (Ptr b -> IO c) -> IO c
withRef Ref MultiLabel
ml ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \mlPtr :: Ptr ()
mlPtr -> do
Ptr () -> [MultiLabelContent] -> IO ()
freeTextLabels Ptr ()
mlPtr [MultiLabelContent]
currMlcs
Ptr () -> [MultiLabelContent] -> IO ()
insertNewContents Ptr ()
mlPtr [MultiLabelContent]
mlcs
where
freeTextLabels :: Ptr () -> [MultiLabelContent] -> IO ()
freeTextLabels :: Ptr () -> [MultiLabelContent] -> IO ()
freeTextLabels mlPtr :: Ptr ()
mlPtr [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
freeTextLabels mlPtr :: Ptr ()
mlPtr (mlc :: MultiLabelContent
mlc:mlcs :: [MultiLabelContent]
mlcs)=
case MultiLabelContent
mlc of
MultiLabelContentText _ -> do
Ptr CChar
t <- Ptr () -> IO (Ptr CChar)
labela' Ptr ()
mlPtr
Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
free Ptr CChar
t
Ptr CChar
rest <- Ptr () -> IO (Ptr CChar)
labelb' Ptr ()
mlPtr
Ptr () -> [MultiLabelContent] -> IO ()
freeTextLabels (Ptr CChar -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
rest) [MultiLabelContent]
mlcs
_ -> do
Ptr CChar
rest <- Ptr () -> IO (Ptr CChar)
labelb' Ptr ()
mlPtr
Ptr () -> [MultiLabelContent] -> IO ()
freeTextLabels (Ptr CChar -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
rest) [MultiLabelContent]
mlcs
insertNewContents :: Ptr () -> [MultiLabelContent] -> IO ()
insertNewContents :: Ptr () -> [MultiLabelContent] -> IO ()
insertNewContents mlPtr :: Ptr ()
mlPtr [] = do
Ptr () -> Labeltype -> IO ()
setTypeb' Ptr ()
mlPtr Labeltype
MultiLabelType
Ptr ()
end <- Ptr CChar -> Ptr CChar -> Labeltype -> Labeltype -> IO (Ptr ())
multiLabelNew' (Ptr Any -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
forall a. Ptr a
nullPtr) (Ptr Any -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
forall a. Ptr a
nullPtr) Labeltype
NoLabelType Labeltype
NoLabelType
Ptr () -> Ptr CChar -> IO ()
setLabelb' Ptr ()
mlPtr (Ptr () -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
end)
insertNewContents mlPtr :: Ptr ()
mlPtr mlcs :: [MultiLabelContent]
mlcs = do
Ptr ()
rest <- Ptr () -> MultiLabelContent -> IO (Ptr ())
setPtr Ptr ()
mlPtr ([MultiLabelContent] -> MultiLabelContent
forall a. [a] -> a
head [MultiLabelContent]
mlcs)
if ([MultiLabelContent] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([MultiLabelContent] -> [MultiLabelContent]
forall a. [a] -> [a]
tail [MultiLabelContent]
mlcs))
then do
Ptr () -> Labeltype -> IO ()
setTypeb' Ptr ()
mlPtr Labeltype
MultiLabelType
Ptr ()
end <- Ptr CChar -> Ptr CChar -> Labeltype -> Labeltype -> IO (Ptr ())
multiLabelNew' (Ptr Any -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
forall a. Ptr a
nullPtr) (Ptr Any -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
forall a. Ptr a
nullPtr) Labeltype
NoLabelType Labeltype
NoLabelType
Ptr () -> Ptr CChar -> IO ()
setLabelb' Ptr ()
mlPtr (Ptr () -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
end)
else Ptr () -> [MultiLabelContent] -> IO ()
insertNewContents (Ptr () -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
rest) ([MultiLabelContent] -> [MultiLabelContent]
forall a. [a] -> [a]
tail [MultiLabelContent]
mlcs)
setPtr :: Ptr () -> MultiLabelContent -> IO (Ptr ())
setPtr :: Ptr () -> MultiLabelContent -> IO (Ptr ())
setPtr mlPtr :: Ptr ()
mlPtr mlc :: MultiLabelContent
mlc = do
(lt :: Labeltype
lt,ptr :: Ptr CChar
ptr) <- MultiLabelContent -> IO (Labeltype, Ptr CChar)
toLabelTypePtr MultiLabelContent
mlc
Ptr () -> Labeltype -> IO ()
setTypea' Ptr ()
mlPtr Labeltype
lt
Ptr () -> Ptr CChar -> IO ()
setLabela' Ptr ()
mlPtr Ptr CChar
ptr
Ptr () -> IO (Ptr CChar)
labelb' Ptr ()
mlPtr IO (Ptr CChar) -> (Ptr CChar -> IO (Ptr ())) -> IO (Ptr ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr () -> IO (Ptr ()))
-> (Ptr CChar -> Ptr ()) -> Ptr CChar -> IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr CChar -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr
instance (Parent a WidgetBase, impl ~ (Ref a -> IO ())) => Op (WidgetLabel ()) MultiLabel orig impl where
runOp :: WidgetLabel () -> orig -> Ref MultiLabel -> impl
runOp _ _ widget :: Ref MultiLabel
widget widget' :: Ref a
widget' =
Ref MultiLabel -> (Ptr () -> IO ()) -> IO ()
forall a b c. HasCallStack => Ref a -> (Ptr b -> IO c) -> IO c
withRef Ref MultiLabel
widget ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \widgetPtr :: Ptr ()
widgetPtr ->
Ref a -> (Ptr () -> IO ()) -> IO ()
forall a b c. HasCallStack => Ref a -> (Ptr b -> IO c) -> IO c
withRef Ref a
widget' ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \widget'Ptr :: Ptr ()
widget'Ptr ->
Ptr () -> Ptr () -> IO ()
setWidgetLabel' Ptr ()
widgetPtr Ptr ()
widget'Ptr
instance (Parent a MenuItemBase, impl ~ (Ref a -> IO ())) => Op (MenuItemLabel ()) MultiLabel orig impl where
runOp :: MenuItemLabel () -> orig -> Ref MultiLabel -> impl
runOp _ _ widget :: Ref MultiLabel
widget widget' :: Ref a
widget' =
Ref MultiLabel -> (Ptr () -> IO ()) -> IO ()
forall a b c. HasCallStack => Ref a -> (Ptr b -> IO c) -> IO c
withRef Ref MultiLabel
widget ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \widgetPtr :: Ptr ()
widgetPtr ->
Ref a -> (Ptr () -> IO ()) -> IO ()
forall a b c. HasCallStack => Ref a -> (Ptr b -> IO c) -> IO c
withRef Ref a
widget' ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \widget'Ptr :: Ptr ()
widget'Ptr ->
Ptr () -> Ptr () -> IO ()
setMenuItemLabel' Ptr ()
widgetPtr Ptr ()
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"
:: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))