-----------------------------------------------------------------------------
-- |
-- Module      :  Window
-- Copyright   :  (c) 2011-13 Jose A. Ortega Ruiz
--             :  (c) 2012 Jochen Keil
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Jose A. Ortega Ruiz <jao@gnu.org>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Window manipulation functions
--
-----------------------------------------------------------------------------

module Window where

import Prelude
import Control.Monad (when, unless)
import Graphics.X11.Xlib hiding (textExtents, textWidth)
import Graphics.X11.Xlib.Extras
import Graphics.X11.Xinerama
import Foreign.C.Types (CLong)

import Data.Maybe(fromMaybe)
import System.Posix.Process (getProcessID)

import Config
import XUtil

-- $window

-- | The function to create the initial window
createWin :: Display -> XFont -> Config -> IO (Rectangle,Window)
createWin d fs c = do
  let dflt = defaultScreen d
  srs <- getScreenInfo d
  rootw <- rootWindow d dflt
  (as,ds) <- textExtents fs "0"
  let ht = as + ds + 4
      r = setPosition (position c) srs (fi ht)
  win <- newWindow  d (defaultScreenOfDisplay d) rootw r (overrideRedirect c)
  setProperties c d win
  setStruts r c d win srs
  when (lowerOnStart c) $ lowerWindow d win
  unless (hideOnStart c) $ showWindow r c d win
  return (r,win)

-- | Updates the size and position of the window
repositionWin :: Display -> Window -> XFont -> Config -> IO Rectangle
repositionWin d win fs c = do
  srs <- getScreenInfo d
  (as,ds) <- textExtents fs "0"
  let ht = as + ds + 4
      r = setPosition (position c) srs (fi ht)
  moveResizeWindow d win (rect_x r) (rect_y r) (rect_width r) (rect_height r)
  setStruts r c d win srs
  return r

setPosition :: XPosition -> [Rectangle] -> Dimension -> Rectangle
setPosition p rs ht =
  case p' of
    Top -> Rectangle rx ry rw h
    TopP l r -> Rectangle (rx + fi l) ry (rw - fi l - fi r) h
    TopW a i -> Rectangle (ax a i) ry (nw i) h
    TopSize a i ch -> Rectangle (ax a i) ry (nw i) (mh ch)
    Bottom -> Rectangle rx ny rw h
    BottomW a i -> Rectangle (ax a i) ny (nw i) h
    BottomP l r -> Rectangle (rx + fi l) ny (rw - fi l - fi r) h
    BottomSize a i ch  -> Rectangle (ax a i) (ny' ch) (nw i) (mh ch)
    Static cx cy cw ch -> Rectangle (fi cx) (fi cy) (fi cw) (fi ch)
    OnScreen _ p'' -> setPosition p'' [scr] ht
  where
    (scr@(Rectangle rx ry rw rh), p') =
      case p of OnScreen i x -> (fromMaybe (head rs) $ safeIndex i rs, x)
                _ -> (head rs, p)
    ny = ry + fi (rh - ht)
    center i = rx + fi (div (remwid i) 2)
    right  i = rx + fi (remwid i)
    remwid i = rw - pw (fi i)
    ax L = const rx
    ax R = right
    ax C = center
    pw i = rw * min 100 i `div` 100
    nw = fi . pw . fi
    h = fi ht
    mh h' = max (fi h') h
    ny' h' = ry + fi (rh - mh h')
    safeIndex i = lookup i . zip [0..]

setProperties :: Config -> Display -> Window -> IO ()
setProperties c d w = do
  let mkatom n = internAtom d n False
  card <- mkatom "CARDINAL"
  atom <- mkatom "ATOM"

  setTextProperty d w "xmobar" wM_CLASS
  setTextProperty d w "xmobar" wM_NAME

  wtype <- mkatom "_NET_WM_WINDOW_TYPE"
  dock <- mkatom "_NET_WM_WINDOW_TYPE_DOCK"
  changeProperty32 d w wtype atom propModeReplace [fi dock]

  when (allDesktops c) $ do
    desktop <- mkatom "_NET_WM_DESKTOP"
    changeProperty32 d w desktop card propModeReplace [0xffffffff]

  pid  <- mkatom "_NET_WM_PID"
  getProcessID >>= changeProperty32 d w pid card propModeReplace . return . fi

setStruts' :: Display -> Window -> [Foreign.C.Types.CLong] -> IO ()
setStruts' d w svs = do
  let mkatom n = internAtom d n False
  card <- mkatom "CARDINAL"
  pstrut <- mkatom "_NET_WM_STRUT_PARTIAL"
  strut <- mkatom "_NET_WM_STRUT"
  changeProperty32 d w pstrut card propModeReplace svs
  changeProperty32 d w strut card propModeReplace (take 4 svs)

setStruts :: Rectangle -> Config -> Display -> Window -> [Rectangle] -> IO ()
setStruts r c d w rs = do
  let svs = map fi $ getStrutValues r (position c) (getRootWindowHeight rs)
  setStruts' d w svs

getRootWindowHeight :: [Rectangle] -> Int
getRootWindowHeight srs = maximum (map getMaxScreenYCoord srs)
  where
    getMaxScreenYCoord sr = fi (rect_y sr) + fi (rect_height sr)

getStrutValues :: Rectangle -> XPosition -> Int -> [Int]
getStrutValues r@(Rectangle x y w h) p rwh =
  case p of
    OnScreen _ p'   -> getStrutValues r p' rwh
    Top             -> [0, 0, st,  0, 0, 0, 0, 0, nx, nw,  0,  0]
    TopP    _ _     -> [0, 0, st,  0, 0, 0, 0, 0, nx, nw,  0,  0]
    TopW    _ _     -> [0, 0, st,  0, 0, 0, 0, 0, nx, nw,  0,  0]
    TopSize      {} -> [0, 0, st,  0, 0, 0, 0, 0, nx, nw,  0,  0]
    Bottom          -> [0, 0,  0, sb, 0, 0, 0, 0,  0,  0, nx, nw]
    BottomP _ _     -> [0, 0,  0, sb, 0, 0, 0, 0,  0,  0, nx, nw]
    BottomW _ _     -> [0, 0,  0, sb, 0, 0, 0, 0,  0,  0, nx, nw]
    BottomSize   {} -> [0, 0,  0, sb, 0, 0, 0, 0,  0,  0, nx, nw]
    Static       {} -> getStaticStrutValues p rwh
  where st = fi y + fi h
        sb = rwh - fi y
        nx = fi x
        nw = fi (x + fi w - 1)

-- get some reaonable strut values for static placement.
getStaticStrutValues :: XPosition -> Int -> [Int]
getStaticStrutValues (Static cx cy cw ch) rwh
    -- if the yPos is in the top half of the screen, then assume a Top
    -- placement, otherwise, it's a Bottom placement
    | cy < (rwh `div` 2) = [0, 0, st,  0, 0, 0, 0, 0, xs, xe,  0,  0]
    | otherwise = [0, 0,  0, sb, 0, 0, 0, 0,  0,  0, xs, xe]
    where st = cy + ch
          sb = rwh - cy
          xs = cx -- a simple calculation for horizontal (x) placement
          xe = xs + cw
getStaticStrutValues _ _ = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]

drawBorder :: Border -> Display -> Drawable -> GC -> Pixel
              -> Dimension -> Dimension -> IO ()
drawBorder b d p gc c wi ht =  case b of
  NoBorder -> return ()
  TopB       -> drawBorder (TopBM 0) d p gc c w h
  BottomB    -> drawBorder (BottomBM 0) d p gc c w h
  FullB      -> drawBorder (FullBM 0) d p gc c w h
  TopBM m    -> sf >> drawLine d p gc 0 (fi m) (fi w) 0
  BottomBM m -> let rw = fi h - fi m in
                 sf >> drawLine d p gc 0 rw (fi w) rw
  FullBM m   -> let pad = 2 * fi m; mp = fi m in
                 sf >> drawRectangle d p gc mp mp (w - pad) (h - pad)
  where sf = setForeground d gc c
        (w, h) = (wi - 1, ht - 1)

hideWindow :: Display -> Window -> IO ()
hideWindow d w = do
    setStruts' d w (replicate 12 0)
    unmapWindow d w >> sync d False

showWindow :: Rectangle -> Config -> Display -> Window -> IO ()
showWindow r c d w = do
    mapWindow d w
    getScreenInfo d >>= setStruts r c d w
    sync d False

isMapped :: Display -> Window -> IO Bool
isMapped d w = fmap ism $ getWindowAttributes d w
    where ism (WindowAttributes { wa_map_state = wms }) = wms /= waIsUnmapped