module Graphics.XOSD.Base (
XOSD
, VAlign(..)
, HAlign(..)
, Format(..)
, create
, destroy
, xosdEitherIf
, xosdErrorIf
, xosdError
, setBarLength
, setVAlign
, setHAlign
, setShadowOffset
, setShadowColor
, setOutlineOffset
, setOutlineColor
, setHorizontalOffset
, setVerticalOffset
, setTimeout
, setColor
, setFont
, display
, setHidden
, setVisible
, scroll
, isOnScreen
, getNumberOfLines
, wait
, toXOSDVAlign
, toXOSDHAlign
, toXOSDFormat
, xosd_create
, xosd_error
, xosd_destroy
, xosd_set_bar_length
, xosd_is_onscreen
, xosd_wait_until_no_display
, xosd_hide
, xosd_show
, xosd_set_pos
, xosd_set_align
, xosd_set_shadow_offset
, xosd_set_outline_offset
, xosd_set_outline_colour
, xosd_set_shadow_colour
, xosd_set_horizontal_offset
, xosd_set_vertical_offset
, xosd_set_timeout
, xosd_set_colour
, xosd_set_font
, xosd_get_colour
, xosd_get_number_lines
, xosd_scroll
, xosd_display_string
, xosd_display_percent
, xosd_display_slider
) where
import Foreign
import Foreign.C.Types
import Foreign.C.String
import Control.Monad
type XOSD = Ptr XOSD_
data XOSD_
create :: Int -> IO XOSD
create n = either error return =<< createEither n
createEither :: Int -> IO (Either String XOSD)
createEither n = xosdEitherIf (== nullPtr) (xosd_create (fromIntegral n))
foreign import ccall unsafe
xosd_create :: CInt -> IO XOSD
xosdEitherIf :: (a -> Bool) -> IO a -> IO (Either String a)
xosdEitherIf p f = do
v <- f
if p v then do s <- peekCString =<< xosd_error
return (Left s)
else return (Right v)
xosdErrorIf :: (a -> Bool) -> IO a -> IO a
xosdErrorIf p f = do
v <- xosdEitherIf p f
either error return v
xosdError :: IO a
xosdError = xosdErrorIf (const True) undefined
foreign import ccall unsafe
xosd_error :: IO CString
destroy :: XOSD -> IO ()
destroy xosd = do xosdErrorIf (== 1) (xosd_destroy xosd)
return ()
foreign import ccall unsafe
xosd_destroy :: XOSD -> IO CInt
setBarLength :: XOSD -> Int -> IO ()
setBarLength xosd n = do
xosdErrorIf (== 1) (xosd_set_bar_length xosd (fromIntegral n))
return ()
foreign import ccall unsafe
xosd_set_bar_length :: XOSD -> CInt -> IO CInt
setVAlign :: XOSD -> VAlign -> IO ()
setVAlign xosd pos = do
xosdErrorIf (== 1) $ xosd_set_pos xosd (toXOSDVAlign pos)
return ()
foreign import ccall unsafe
xosd_set_pos :: XOSD -> CInt -> IO CInt
setHAlign :: XOSD -> HAlign -> IO ()
setHAlign xosd pos = do
xosdErrorIf (== 1) $ xosd_set_align xosd (toXOSDHAlign pos)
return ()
foreign import ccall unsafe
xosd_set_align :: XOSD -> CInt -> IO CInt
setShadowOffset :: XOSD -> Int -> IO ()
setShadowOffset xosd n = do
xosdErrorIf (== 1) $ xosd_set_shadow_offset xosd (fromIntegral n)
return ()
foreign import ccall unsafe
xosd_set_shadow_offset :: XOSD -> CInt -> IO CInt
setOutlineOffset :: XOSD -> Int -> IO ()
setOutlineOffset xosd n = do
xosdErrorIf (== 1) $ xosd_set_outline_offset xosd (fromIntegral n)
return ()
foreign import ccall unsafe
xosd_set_outline_offset :: XOSD -> CInt -> IO CInt
setOutlineColor :: XOSD -> String -> IO ()
setOutlineColor xosd c = do
xosdErrorIf (== 1) $
withCString c $
xosd_set_outline_colour xosd
return ()
foreign import ccall unsafe
xosd_set_outline_colour :: XOSD -> CString -> IO CInt
setShadowColor :: XOSD -> String -> IO ()
setShadowColor xosd c = do
xosdErrorIf (== 1) $
withCString c $
xosd_set_shadow_colour xosd
return ()
foreign import ccall unsafe
xosd_set_shadow_colour :: XOSD -> CString -> IO CInt
setHorizontalOffset :: XOSD -> Int -> IO ()
setHorizontalOffset xosd n = do
xosdErrorIf (== 1) $ xosd_set_horizontal_offset xosd (fromIntegral n)
return ()
foreign import ccall unsafe
xosd_set_horizontal_offset :: XOSD -> CInt -> IO CInt
setVerticalOffset :: XOSD -> Int -> IO ()
setVerticalOffset xosd n = do
xosdErrorIf (== 1) $ xosd_set_vertical_offset xosd (fromIntegral n)
return ()
foreign import ccall unsafe
xosd_set_vertical_offset :: XOSD -> CInt -> IO CInt
setTimeout :: XOSD -> Int -> IO ()
setTimeout xosd n = do
xosdErrorIf (== 1) $ xosd_set_timeout xosd (fromIntegral n)
return ()
foreign import ccall unsafe
xosd_set_timeout :: XOSD -> CInt -> IO CInt
setColor :: XOSD -> String -> IO ()
setColor xosd c = do
xosdErrorIf (== 1) $
withCString c $
xosd_set_colour xosd
return ()
foreign import ccall unsafe
xosd_set_colour :: XOSD -> CString -> IO CInt
setFont :: XOSD -> String -> IO ()
setFont xosd c = do
xosdErrorIf (== 1) $
withCString c $
xosd_set_font xosd
return ()
foreign import ccall unsafe
xosd_set_font :: XOSD -> CString -> IO CInt
setHidden :: XOSD -> IO ()
setHidden xosd = do
xosdErrorIf (== 1) (xosd_hide xosd)
return ()
foreign import ccall unsafe
xosd_hide :: XOSD -> IO CInt
setVisible :: XOSD -> IO ()
setVisible xosd = do
xosdErrorIf (== 1) (xosd_show xosd)
return ()
foreign import ccall unsafe
xosd_show :: XOSD -> IO CInt
display :: XOSD -> Int -> Format -> IO ()
display xosd n fmt = do
m <- getNumberOfLines xosd
() <- when (n < 0 || n > m1) $ error $ "Indexing display out of range: "++ show n
xosdErrorIf (== 1) $ case fmt of
Percent i -> xosd_display_percent xosd (fromIntegral n) flag (fromIntegral i)
Slider i -> xosd_display_slider xosd (fromIntegral n) flag (fromIntegral i)
String s -> withCString s $ xosd_display_string xosd (fromIntegral n) flag
return ()
where
flag = toXOSDFormat fmt
foreign import ccall unsafe "xosd_display"
xosd_display_string :: XOSD -> CInt -> XOSD_Format -> CString -> IO CInt
foreign import ccall unsafe "xosd_display"
xosd_display_percent :: XOSD -> CInt -> XOSD_Format -> CInt -> IO CInt
foreign import ccall unsafe "xosd_display"
xosd_display_slider :: XOSD -> CInt -> XOSD_Format -> CInt -> IO CInt
isOnScreen :: XOSD -> IO Bool
isOnScreen xosd = do
n <- xosd_is_onscreen xosd
case n of
1 -> return True
0 -> return False
_ -> xosdError
foreign import ccall unsafe
xosd_is_onscreen :: XOSD -> IO CInt
foreign import ccall unsafe
xosd_get_colour :: XOSD -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO CInt
getNumberOfLines :: XOSD -> IO Int
getNumberOfLines xosd = do
n <- xosdErrorIf (== 1) (xosd_get_number_lines xosd)
return (fromIntegral n)
foreign import ccall unsafe
xosd_get_number_lines :: XOSD -> IO CInt
wait :: XOSD -> IO ()
wait xosd = do
xosdErrorIf (== 1) (xosd_wait_until_no_display xosd)
return ()
foreign import ccall unsafe
xosd_wait_until_no_display :: XOSD -> IO CInt
scroll :: XOSD -> Int -> IO ()
scroll xosd n | n >= 0 = do
xosdErrorIf (== 1) (xosd_scroll xosd (fromIntegral n))
return ()
| otherwise = error $ "XOSD.scroll: negative scroll value: " ++ show n
foreign import ccall unsafe
xosd_scroll :: XOSD -> CInt -> IO CInt
type XOSD_Format = CInt
xosd_percentage :: XOSD_Format
xosd_percentage = 0
xosd_string :: XOSD_Format
xosd_string = 1
xosd_slider :: XOSD_Format
xosd_slider = 3
data Format
= Percent !Int
| Slider !Int
| String String
deriving (Eq,Show,Read)
toXOSDFormat :: Format -> XOSD_Format
toXOSDFormat (Percent _) = xosd_percentage
toXOSDFormat (Slider _) = xosd_slider
toXOSDFormat (String _ ) = xosd_string
type XOSD_VAlign = CInt
xosd_top :: XOSD_VAlign
xosd_top = 0
xosd_middle :: XOSD_VAlign
xosd_middle = 2
xosd_bottom :: XOSD_VAlign
xosd_bottom = 1
toXOSDVAlign :: VAlign -> XOSD_VAlign
toXOSDVAlign VAlignTop = xosd_top
toXOSDVAlign VAlignMiddle = xosd_middle
toXOSDVAlign VAlignBottom = xosd_bottom
data VAlign
= VAlignTop
| VAlignMiddle
| VAlignBottom
deriving (Read,Show,Eq, Ord)
type XOSD_HAlign = CInt
xosd_left :: XOSD_HAlign
xosd_left = 0
xosd_center :: XOSD_HAlign
xosd_center = 1
xosd_right :: XOSD_HAlign
xosd_right = 2
data HAlign
= HAlignLeft
| HAlignCenter
| HAlignRight
deriving (Read,Show,Eq, Ord)
toXOSDHAlign :: HAlign -> XOSD_HAlign
toXOSDHAlign HAlignLeft = xosd_left
toXOSDHAlign HAlignCenter = xosd_center
toXOSDHAlign HAlignRight = xosd_right