--------------------------------------------------------------------
-- |
-- Module   : Graphics.XOSD
-- 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.
--
-- > runXOSD [ Timeout 3
-- >          , VAlign VAlignMiddle
-- >          , HAlign HAlignCenter
-- >          , Font "-adobe-helvetica-bold-r-*-*-34-*-*-*-*-*-*-*"
-- >          , Color "LimeGreen"
-- >          , Display (String "TEST")] 
-- >      (const $ return ())
--
module Graphics.XOSD (

        -- * The abstract XOSD type
        XOSD,
        Attribute(..),
        Format(..), VAlign(..), HAlign(..),

        -- * Interface to the interpreter
        runXOSD,

        -- * Introduction and elimination
        initialize,
        destroy,

        -- * Operations on a running XOSD
        set,
        display,
        wait,
        scroll,

    ) where

import Control.Exception
import Graphics.XOSD.Base

--
-- TODO do nothing on errors, don't crash.
--

-- | Attributes that can be set on an XOSD object
data Attribute
    = Lines         !Int
    | BarLength     !Int
    | VAlign        !VAlign -- Todo flatten
    | HAlign        !HAlign -- Todo flatten
    | VOffset       !Int
    | HOffset       !Int
    | ShadowOffset  !Int
    | OutlineOffset !Int
    | OutlineColor  String
    | ShadowColor   String
    | Color         String
    | Font          String
    | Timeout       !Int
    | Hidden
    | Visible
    | Scroll        !Int
    | Display       !Format
    deriving (Show,Eq)

-- | Create a new XOSD object with given attributes.
initialize :: [Attribute] -> IO XOSD
initialize attrs = do
        xosd <- create size
        set xosd attrs
        return xosd
    where
        size = case reverse [ n | Lines n <- attrs ] of
                    []  -> 1
                    n:_ -> n

-- | Set a list of attributes
set :: XOSD -> [Attribute] -> IO ()
set xosd attrs = mapM_ setAttr attrs
  where
    -- | Set argument attribute for this XOSD object
    setAttr :: Attribute -> IO ()
    setAttr (Lines _)         = return ()
    setAttr (BarLength n)     = setBarLength        xosd n
    setAttr (VAlign v)        = setVAlign           xosd v
    setAttr (HAlign v)        = setHAlign           xosd v
    setAttr (ShadowOffset o)  = setShadowOffset     xosd o
    setAttr (OutlineOffset o) = setOutlineOffset    xosd o
    setAttr (OutlineColor c)  = setOutlineColor     xosd c
    setAttr (ShadowColor c)   = setShadowColor      xosd c
    setAttr (VOffset c)       = setVerticalOffset   xosd c
    setAttr (HOffset c)       = setHorizontalOffset xosd c
    setAttr (Timeout i)       = setTimeout          xosd i
    setAttr (Color c)         = setColor            xosd c
    setAttr (Font f)          = setFont             xosd f
    setAttr Hidden            = setHidden           xosd
    setAttr Visible           = setVisible          xosd
    setAttr (Scroll n)        = scroll              xosd n
    setAttr (Display d)       = display             xosd 0 d -- XXX

-- | Run some code with an X on-screen display attached.
runXOSD :: [Attribute] -> (XOSD -> IO ()) -> IO ()
runXOSD n a = do
    bracket
        (initialize n)
        (\x -> wait x >> destroy x)
        a