{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-} -------------------------------------------------------------------- -- | -- Module : Graphics.XOSD.Base -- Copyright: Copyright (c) 2008..2012, Don Stewart -- -- License : BSD3 -- Maintainer: Don Stewart -- Stability : Stable -- Portability: CPP, FFI -- Tested with: GHC 6.10, GHC 7.6 -- -- Bindings to xosd, the X on-screen display library -- xosd is a library for displaying an on-screen display (like the one -- on many TVs) on your X display. -- -- An example using the lowest level C layer: -- -- > do x <- create 1 -- > setFont x "-adobe-helvetica-bold-r-*-*-34-*-*-*-*-*-*-*" -- > setColor x "LimeGreen" -- > display x 0 (String "Screen 1") -- -- runXOSD [Timeout 10, VAlign VAlignMiddle, HAlign HAlignCenter, Font -- "-adobe-helvetica-bold-r-*-*-34-*-*-*-*-*-*-*", Color "LimeGreen", -- Display (String "TEST")] (\x -> sequence_ [ display x 0 (String (show -- i)) >> Control.Concurrent.threadDelay (10^4) | i <- [1..] ]) {- sequence_ [ ((last . lines) `fmap`System.Process.readProcess "cpufreq-info" [] []) >>= \s -> display x 0 (String s) >> Control.Concurrent.threadDelay (10^4) | n <- [0..] ] -} {- sequence_ [ display x 0 (String (Text.Printf.printf "%0.2f" (n/100))) >> Control.Concurrent.threadDelay (10^4) | n <- [1..] ] -} {- Control.Monad.forever (getClockTime >>= \t -> display x 0 (String (show t)) >> Control.Concurrent.threadDelay (10^6) -} module Graphics.XOSD.Base ( -- * The abstract XOSD type XOSD -- * Formatting types , VAlign(..) , HAlign(..) , Format(..) -- * Introduction and elimination , create , destroy -- * Error handling , xosdEitherIf , xosdErrorIf , xosdError -- * Setting attributes in the xosd object , setBarLength , setVAlign , setHAlign , setShadowOffset , setShadowColor , setOutlineOffset , setOutlineColor , setHorizontalOffset , setVerticalOffset , setTimeout , setColor , setFont , display , setHidden , setVisible , scroll -- * Testing state of the xosd object , isOnScreen , getNumberOfLines -- * Control structures , wait -- * Helpers , toXOSDVAlign , toXOSDHAlign , toXOSDFormat -- * Raw C API , 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 #include import Foreign import Foreign.C.Types import Foreign.C.String import Control.Monad -- | An abstract X on-screen display "object" -- -- An xosd window can be used to display textual or numerical data on a -- X11 display in a unmanaged, shaped window that appears to be -- transparent. It provides a similar effect to the on-screen display -- of many televisions and video recorders -- type XOSD = Ptr XOSD_ data XOSD_ {- sequence_ [ display x (i`mod`9) (Percent (truncate (100 * sin (fromIntegral i)))) >> Control.Concurrent.threadDelay (10 ^ 4) | i <- [0,5..100000] ] -} ------------------------------------------------------------------------ -- Introduction -- | Create a new xosd window. -- The argument is the maximum number of lines of text that the window can display. -- Throw an exception on failure. create :: Int -> IO XOSD create n = either error return =<< createEither n -- | Create new xosd window -- The argument is the maximum number of lines of text that the window can display. -- Failure to create an xosd window is captured via 'Either' createEither :: Int -> IO (Either String XOSD) createEither n = xosdEitherIf (== nullPtr) (xosd_create (fromIntegral n)) foreign import ccall unsafe xosd_create :: CInt -> IO XOSD ------------------------------------------------------------------------ -- Error handling -- | Throw an error (encapsulated in Either) with the current String in 'xosd_error' 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) -- | Throw an error with the current String in 'xosd_error' if predicate is True -- when applied to result of action. xosdErrorIf :: (a -> Bool) -> IO a -> IO a xosdErrorIf p f = do v <- xosdEitherIf p f either error return v -- | Throw an error with the current String in 'xosd_error' unconditionally xosdError :: IO a xosdError = xosdErrorIf (const True) undefined foreign import ccall unsafe xosd_error :: IO CString ------------------------------------------------------------------------ -- | xosd_uninit destroys an existing xosd window, freeing the memory. -- This is an unsafe function: as destroying an xosd object twice will -- likely cause bad things to happen, so don't do that. destroy :: XOSD -> IO () destroy xosd = do xosdErrorIf (== -1) (xosd_destroy xosd) return () foreign import ccall unsafe xosd_destroy :: XOSD -> IO CInt ------------------------------------------------------------------------ -- Wrappers for setting functions -- | Set length of percentage and slider bar 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 -- Change the vertical position of the display 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 -- TODO X and Y pos. -- Change the horizontal alignment of the display 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 -- | Change the offset of the text shadow 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 -- | Change the offset of the text outline- -- The outline is drawn over the shadow. 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 -- | Change the colour of the outline 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 -- | Change the colour of the shadow 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 -- | Change the number of pixels the display is offset from the position 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 -- | Change the number of pixels the display is offset from the position 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 -- | Change the time before display is hidden. 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 -- | Change the colour of the display 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 -- | Change the text-display font 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 -- | Hide the display setHidden :: XOSD -> IO () setHidden xosd = do xosdErrorIf (== -1) (xosd_hide xosd) return () foreign import ccall unsafe xosd_hide :: XOSD -> IO CInt -- | Show the display after being hidden setVisible :: XOSD -> IO () setVisible xosd = do xosdErrorIf (== -1) (xosd_show xosd) return () foreign import ccall unsafe xosd_show :: XOSD -> IO CInt ------------------------------------------------------------------------ -- TODO ensure 'n' is within the static set. -- | Display some content. display :: XOSD -> Int -> Format -> IO () display xosd n fmt = do m <- getNumberOfLines xosd () <- when (n < 0 || n > m-1) $ 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 -- Rendering 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 ------------------------------------------------------------------------ -- Wrappers for getting functions 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 -- | Get the maximum number of lines allowed 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 ------------------------------------------------------------------------ -- Control -- | Wait until nothing is displayed. Blocks the process until no longer visible. 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 the display 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 ------------------------------------------------------------------------ -- | The type of data that can be displayed. type XOSD_Format = CInt #{enum XOSD_Format, , xosd_percentage = XOSD_percentage , xosd_string = XOSD_string , xosd_slider = XOSD_slider } -- , xosd_printf = XOSD_printf -- | The type of possible display formats data Format = Percent {-# UNPACK #-} !Int | Slider {-# UNPACK #-} !Int | String String deriving (Eq,Show,Read) -- | Translate abstract to concrete formatting types toXOSDFormat :: Format -> XOSD_Format toXOSDFormat (Percent _) = xosd_percentage toXOSDFormat (Slider _) = xosd_slider toXOSDFormat (String _ ) = xosd_string -- | VAlign of the display type XOSD_VAlign = CInt #{enum XOSD_VAlign, , xosd_top = XOSD_top , xosd_middle = XOSD_middle , xosd_bottom = XOSD_bottom } -- | Translate abstract to concrete formatting types toXOSDVAlign :: VAlign -> XOSD_VAlign toXOSDVAlign VAlignTop = xosd_top toXOSDVAlign VAlignMiddle = xosd_middle toXOSDVAlign VAlignBottom = xosd_bottom -- | Valid screen positions (vertical alignment) data VAlign = VAlignTop | VAlignMiddle | VAlignBottom deriving (Read,Show,Eq, Ord) -- | HAlign of the display type XOSD_HAlign = CInt #{enum XOSD_HAlign, , xosd_left = XOSD_left , xosd_center = XOSD_center , xosd_right = XOSD_right } -- | Valid screen positions (vertical alignment) data HAlign = HAlignLeft | HAlignCenter | HAlignRight deriving (Read,Show,Eq, Ord) -- | Translate abstract to concrete formatting types toXOSDHAlign :: HAlign -> XOSD_HAlign toXOSDHAlign HAlignLeft = xosd_left toXOSDHAlign HAlignCenter = xosd_center toXOSDHAlign HAlignRight = xosd_right