{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-}

--------------------------------------------------------------------
-- |
-- Module   : Graphics.XOSD.Base
-- Copyright: Copyright (c) 2008, Don Stewart
--
-- License   : BSD3
-- Maintainer:  Don Stewart <dons@galois.com>
-- Stability :  experimental
-- Portability: CPP, FFI
-- Tested with: GHC 6.10
--
-- 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 "DarkRed"
-- >    display x 0 (String "Screen 1")
--
module Graphics.XOSD.Base (

        -- * The abstract XOSD type
        XOSD

        -- * Low level Haskell layer
        , create
        , create_
        , destroy
        , withXOSD

        -- * Set attributes
        , setFont
        , setColor

        -- * Render to screen
        , Format(..)
        , XOSD_Command
        , display
        , xosd_percentage, xosd_string, xosd_slider

        -- * C layer
        , xosd_create      --           :: CInt -> IO XOSD
        , xosd_uninit      --           :: XOSD -> IO CInt
        , xosd_set_timeout --           :: XOSD -> CInt -> IO CInt
        , xosd_set_vertical_offset  --  :: XOSD -> CInt -> IO CInt
        , xosd_set_horizontal_offset -- :: XOSD -> CInt -> IO CInt
        , xosd_set_pos           --   :: XOSD -> CInt -> IO CInt
        , xosd_set_font      --       :: XOSD -> CString -> IO CInt
        , xosd_set_colour    --       :: XOSD -> CString -> IO CInt
        , xosd_is_onscreen     --     :: XOSD -> IO CInt
        , xosd_error         --       :: IO CString
        , xosd_get_colour   --        :: XOSD -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO CInt
        , xosd_get_number_lines  --   :: XOSD -> IO CInt
        , xosd_wait_until_no_display -- :: XOSD -> IO CInt
        , xosd_hide        --        :: XOSD -> IO CInt
        , xosd_show       --         :: XOSD -> IO CInt
        , xosd_scroll    --          :: XOSD -> CInt -> IO CInt
        , xosd_display_string  --     :: XOSD -> CInt -> XOSD_Command -> CString -> IO CInt

    ) where

#include <xosd.h>

import Foreign
import Foreign.C.Types
import Foreign.C.String
import Control.Exception

data XOSD_

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

------------------------------------------------------------------------
-- Introduction

-- | xosd_init creates a new xosd window
-- The argument is the maximum number of lines of text that the window can display.
create :: Int -> IO (Either String XOSD)
create n = do p <- xosd_create (fromIntegral n)
              if p == nullPtr
                    then do err <- peekCString =<< xosd_error
                            return (Left err)
                    else return (Right p)

-- | Create a new xosd window. Throw an exception on failure.
-- The argument is the maximum number of lines of text that the window can display.
create_ :: Int -> IO XOSD
create_ n = do
    r_xosd <- create n
    case r_xosd of
        Left  err  -> error err
        Right xosd -> return xosd

-- | xosd_uninit destroys an existing xosd window, freeing the memory.
-- This is an unsafe function: destroying an xosd object twice will
-- likely cause bad things to happen. 
destroy :: XOSD -> IO ()
destroy xosd = xosd_uninit xosd >> return ()

-- | Run some code with an X on-screen display attached.
-- and automatically close the display when we're done.
-- An exception will be thrown should we not be able to create a new
-- display.
--
withXOSD :: Int -> (XOSD -> IO ()) -> IO ()
withXOSD n a = do
    bracket
        (create_ n)
        (destroy)
        a

display :: XOSD -> Int -> Format -> IO ()
display xosd n fmt = case fmt of
    Percent n -> undefined
    Slider  n -> undefined
    String  s -> withCString s $ \cstr -> do
                    v    <- xosd_display_string xosd (fromIntegral n) xosd_string cstr
                    return ()

setFont :: XOSD -> String -> IO ()
setFont xosd s = do
    withCString s $ \cstr -> do
        n <- xosd_set_font xosd cstr
        return ()

setColor :: XOSD -> String -> IO ()
setColor xosd s = do
    withCString s $ \cstr -> do
        n <- xosd_set_colour xosd cstr
        return ()

------------------------------------------------------------------------

data Format = Percent !Int
            | Slider  !Int
            | String String
            deriving (Eq,Show)

--
-- Percentage bar (like a progress bar)
-- Text
-- Formatted Text
-- Slider (like a volume control)
--
type XOSD_Command = CInt

#{enum XOSD_Command,
    , xosd_percentage = XOSD_percentage
    , xosd_string     = XOSD_string
    , xosd_slider     = XOSD_slider
    }
--    , xosd_printf  = XOSD_printf -- unsafe

------------------------------------------------------------------------
-- Intro/elim
foreign import ccall unsafe
    xosd_create                 :: CInt -> IO XOSD

foreign import ccall unsafe
    xosd_uninit                 :: XOSD -> IO CInt

-- Setting attributes
foreign import ccall unsafe
    xosd_set_timeout            :: XOSD -> CInt -> IO CInt

foreign import ccall unsafe
    xosd_set_vertical_offset    :: XOSD -> CInt -> IO CInt

foreign import ccall unsafe
    xosd_set_horizontal_offset  :: XOSD -> CInt -> IO CInt

foreign import ccall unsafe
    xosd_set_pos                :: XOSD -> CInt -> IO CInt

foreign import ccall unsafe
    xosd_set_font               :: XOSD -> CString -> IO CInt

foreign import ccall unsafe
    xosd_set_colour             :: XOSD -> CString -> IO CInt

-- Tests
foreign import ccall unsafe
    xosd_is_onscreen            :: XOSD -> IO CInt

foreign import ccall unsafe
    xosd_error                  :: IO CString

foreign import ccall unsafe
    xosd_get_colour             :: XOSD -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO CInt

foreign import ccall unsafe
    xosd_get_number_lines       :: XOSD -> IO CInt

-- Control
foreign import ccall unsafe
     xosd_wait_until_no_display :: XOSD -> IO CInt

foreign import ccall unsafe
     xosd_hide                  :: XOSD -> IO CInt

foreign import ccall unsafe
     xosd_show                  :: XOSD -> IO CInt

foreign import ccall unsafe
     xosd_scroll                :: XOSD -> CInt -> IO CInt

-- Rendering
foreign import ccall unsafe "xosd_display"
     xosd_display_string       :: XOSD -> CInt -> XOSD_Command -> CString -> IO CInt