import Control.Monad

import Data.Maybe

import Graphics.XHB
import Graphics.XHB.Gen.Xproto
import qualified Graphics.XHB.Connection.Open as CO

import System.Exit

import Phi.X11.Atoms
import Phi.X11.Util


{-sYSTEM_TRAY_REQUEST_DOCK :: CInt
sYSTEM_TRAY_REQUEST_DOCK = 0

sYSTEM_TRAY_BEGIN_MESSAGE :: CInt
sYSTEM_TRAY_BEGIN_MESSAGE = 1

sYSTEM_TRAY_CANCEL_MESSAGE :: CInt
sYSTEM_TRAY_CANCEL_MESSAGE = 2

xEMBED_EMBEDDED_NOTIFY :: CInt
xEMBED_EMBEDDED_NOTIFY = 0-}


main :: IO ()
main = do
  conn <- liftM fromJust connect
  atoms <- initAtoms conn
  
  let dispname = displayInfo conn
      screen = (roots_Setup . connectionSetup $ conn) !! CO.screen dispname
  
  xembedWindow <- initSystray conn atoms screen
  
  return ()


initSystray :: Connection -> Atoms -> SCREEN -> IO WINDOW
initSystray conn atoms screen = do
  currentSystrayWin <- getSelectionOwner conn (atom_NET_SYSTEM_TRAY_SCREEN atoms) >>= getReply' "initSystray: getSelectionOwner failed"
  when (currentSystrayWin /= fromXid xidNone) $ do
    putStrLn "PhiSystrayHelper: another systray is running."
    exitFailure
  
  let rootwin = root_SCREEN screen
      depth = root_depth_SCREEN screen
      visual = root_visual_SCREEN screen
  xembedWin <- newResource conn
  createWindow conn $ MkCreateWindow depth xembedWin rootwin (-1) (-1) 1 1 0 WindowClassInputOutput visual emptyValueParam
  
  -- orient horizontally
  changeProperty32 conn PropModeReplace xembedWin (atom_NET_SYSTEM_TRAY_ORIENTATION atoms) (atomCARDINAL atoms) [0]
  
  -- set visual
  changeProperty32 conn PropModeReplace xembedWin (atom_NET_SYSTEM_TRAY_VISUAL atoms) (atomVISUALID atoms) [fromIntegral visual]
  
  setSelectionOwner conn $ MkSetSelectionOwner xembedWin (atom_NET_SYSTEM_TRAY_SCREEN atoms) 0
  systrayWin <- getSelectionOwner conn (atom_NET_SYSTEM_TRAY_SCREEN atoms) >>= getReply' "initSystray: getSelectionOwner failed"
  when (systrayWin /= xembedWin) $ do
    destroyWindow conn xembedWin
    putStrLn $ "PhiSystrayHelper: can't initialize systray."
    exitFailure
  
  sendEvent conn $ MkSendEvent False rootwin [EventMaskStructureNotify] $
    serializeClientMessage $ MkClientMessageEvent 32 rootwin (atomMANAGER atoms) $
    ClientData32 [0, fromXid . toXid $ atom_NET_SYSTEM_TRAY_SCREEN atoms, fromXid . toXid $ xembedWin, 0, 0]
  
  return xembedWin