-----------------------------------------------------------------------------
-- |
-- Module      :  hxput
-- Copyright   :  (c) Andrea Rossato, Matthew Sackman
-- License     :  BSD3
--
-- Maintainer  :  Matthew Sackman <matthew@wellquite.org>
-- Stability   :  unstable
-- Portability :  unportable
--
--  Sets the mouse selection
--
-----------------------------------------------------------------------------

module Main where

import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras
import System.Exit (exitWith, ExitCode(..))
import System.Environment

import Data.Char

main :: IO ()
main = do
  (text:_) <- getArgs
  dpy <- openDisplay ""
  let dflt = defaultScreen dpy
  rootw  <- rootWindow dpy dflt
  win <- createSimpleWindow dpy rootw 0 0 1 1 0 0 0
  p <- internAtom dpy "PRIMARY" True
  ty <- internAtom dpy "UTF8_STRING" False
  xSetSelectionOwner dpy p win currentTime
  winOwn <- xGetSelectionOwner dpy p
  if winOwn == win
    then do allocaXEvent $ processEvent dpy ty text
            destroyWindow dpy win
            exitWith ExitSuccess
    else do putStrLn "Unable to obtain ownership of the selection"
            destroyWindow dpy win
            exitWith (ExitFailure 1)

processEvent :: Display -> Atom -> [Char] -> XEventPtr -> IO a
processEvent dpy ty text e = do
  nextEvent dpy e
  ev <- getEvent e
  if ev_event_type ev == selectionRequest
    then do print ev
            -- selection == eg PRIMARY
            -- target == type eg UTF8
            -- property == property name or None
            allocaXEvent $ \replyPtr -> do
                   changeProperty8 (ev_event_display ev)
                                   (ev_requestor ev)
                                   (ev_property ev)
                                   ty
                                   propModeReplace
                                   (map (fromIntegral . ord) text)
                   setSelectionNotify replyPtr (ev_requestor ev) (ev_selection ev) (ev_target ev) (ev_property ev) (ev_time ev)
                   sendEvent dpy (ev_requestor ev) False noEventMask replyPtr
            sync dpy False
            putStrLn "Sent"
    else do putStrLn "Unexpected Message Received"
            print ev
  processEvent dpy ty text e