{-# LINE 1 "Graphics/XOSD/Base.hsc" #-}
{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-}
{-# LINE 2 "Graphics/XOSD/Base.hsc" #-}

--------------------------------------------------------------------
-- |
-- Module   : Graphics.XOSD.Base
-- Copyright: Copyright (c) 2008..2012, Don Stewart
--
-- License   : BSD3
-- Maintainer:  Don Stewart <dons00@gmail.com>
-- 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


{-# LINE 123 "Graphics/XOSD/Base.hsc" #-}

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

xosd_percentage    :: XOSD_Format
xosd_percentage    =  0
xosd_string        :: XOSD_Format
xosd_string        =  1
xosd_slider        :: XOSD_Format
xosd_slider        =  3

{-# LINE 425 "Graphics/XOSD/Base.hsc" #-}
--  , 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

xosd_top           :: XOSD_VAlign
xosd_top           =  0
xosd_middle        :: XOSD_VAlign
xosd_middle        =  2
xosd_bottom        :: XOSD_VAlign
xosd_bottom        =  1

{-# LINE 448 "Graphics/XOSD/Base.hsc" #-}

-- | 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

xosd_left      :: XOSD_HAlign
xosd_left      =  0
xosd_center    :: XOSD_HAlign
xosd_center    =  1
xosd_right     :: XOSD_HAlign
xosd_right     =  2

{-# LINE 470 "Graphics/XOSD/Base.hsc" #-}

-- | 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