module Main where

import Data.Bits
import System.IO
import Control.Monad.State
import Foreign.C
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras

data WmState = WmState {
	display :: Display,
	root :: Window,
	width :: Int,
	height :: Int,
	windows :: [Window]
} deriving (Show)

type X = StateT WmState IO

cwx = 0x1
cwy = 0x2
cwwidth = 0x4
cwheight = 0x8

reorganize :: X ()
reorganize = do
	s <- get
	lift $ mapM_ (\(i, w) -> configureWindow (display s) w
	    (cwx .|. cwy .|. cwwidth .|. cwheight) $ wc s i w)
	    (zip [0..] $ windows s)
		where wc s i w = WindowChanges {
			wc_x = fromIntegral $ i * (width s) `div`
			    (length $ windows s),
			wc_y = 0,
			wc_width = fromIntegral $ (width s) `div`
			    (length $ windows s),
			wc_height = fromIntegral $ height s,
			wc_border_width = 0,
			wc_sibling = 0,
			wc_stack_mode = 0
		}

handle :: Event -> X ()
handle (MapNotifyEvent { ev_window = win }) = do
	s <- get
	put (s { windows = win : windows s })
	reorganize
handle (UnmapEvent { ev_window = win }) = do
	s <- get
	put (s { windows = filter (/= win) $ windows s })
	reorganize
handle e = lift $ putStrLn $ "got event " ++ show e

mainLoop :: XEventPtr -> X ()
mainLoop e = do
	s <- get
	lift (nextEvent (display s) e) >> lift (getEvent e) >>= handle >>
	    mainLoop e

main :: IO ()
main = do
	display <- openDisplay ":1"
	let screen = defaultScreen display
	    width = displayWidth display screen
	    height = displayHeight display screen
	root <- rootWindow display screen
        putStrLn $ show width ++ "x" ++ show height
	selectInput display root substructureNotifyMask
	allocaXEvent $ \e ->
		evalStateT (mainLoop e)
		    (WmState display root (fromIntegral width)
		    (fromIntegral height) [])