import Control.Concurrent
import Control.Monad
import Control.Monad.State.Strict

import Data.Word
import Data.Maybe

import Graphics.XHB
import Graphics.XHB.Connection.XCB
import Graphics.XHB.Gen.Xproto

import System.Exit

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


sYSTEM_TRAY_REQUEST_DOCK :: Word32
sYSTEM_TRAY_REQUEST_DOCK = 0

sYSTEM_TRAY_BEGIN_MESSAGE :: Word32
sYSTEM_TRAY_BEGIN_MESSAGE = 1

sYSTEM_TRAY_CANCEL_MESSAGE :: Word32
sYSTEM_TRAY_CANCEL_MESSAGE = 2

xEMBED_EMBEDDED_NOTIFY :: Word32
xEMBED_EMBEDDED_NOTIFY = 0


data SystrayState = SystrayState
                    { systrayIcons :: [(WINDOW, WINDOW)]
                    }


main :: IO ()
main = do
  conn <- liftM fromJust connect
  forkIO $ receiveErrors conn
  
  atoms <- initAtoms conn
  
  let screen = (roots_Setup . connectionSetup $ conn) !! connectionScreen conn
  
  (xembedWin, systrayWin) <- initSystray conn atoms screen
  
  execStateT (runSystray xembedWin systrayWin) $ SystrayState []
  
  return ()

receiveErrors :: Connection -> IO ()
receiveErrors conn =
  forever $ waitForError conn >>= putStrLn . ("XHB error: " ++) . show

initSystray :: Connection -> Atoms -> SCREEN -> IO (WINDOW, 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 "phi-systray-helper: another systray is running."
    exitFailure
  
  currentSystrayHelperWin <- getSelectionOwner conn (atomPHI_SYSTRAY_HELPER atoms) >>= getReply' "initSystray: getSelectionOwner failed"
  when (currentSystrayHelperWin /= fromXid xidNone) $ do
    putStrLn "phi-systray-helper: another systray helper 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 $ "phi-systray-helper: can't initialize systray."
    exitFailure
  
  systrayWin <- newResource conn
  createWindow conn $ MkCreateWindow depth systrayWin rootwin (-1) (-1) 1 1 0 WindowClassInputOutput visual emptyValueParam
  
  setSelectionOwner conn $ MkSetSelectionOwner systrayWin (atomPHI_SYSTRAY_HELPER atoms) 0
  systrayHelperWin <- getSelectionOwner conn (atomPHI_SYSTRAY_HELPER atoms) >>= getReply' "initSystray: getSelectionOwner failed"
  when (systrayHelperWin /= systrayWin) $ do
    destroyWindow conn systrayHelperWin
    destroyWindow conn xembedWin
    putStrLn $ "phi-systray-helper: can't initialize systray helper."
    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, systrayWin)


runSystray :: WINDOW -> WINDOW -> StateT SystrayState IO ()
runSystray xembedWin systrayWin = do
  return ()