-- whim: a window manager
-- Copyright (C) 2006 Evan Martin <martine@danga.com>

-- This module will hopefully be used to test the window layout OpenGL
-- magics without actually needing to boot up a window manager.

module Whim.Playground where

import Data.IORef
import Graphics.Rendering.OpenGL hiding (normalize)
import Graphics.UI.GLUT hiding (normalize, Window)
import System.Environment
import System.Exit

import Whim.Util

-- A simulation of an X window.
data Window = Window {
  wOrigin :: Coord,
  wSize   :: Coord,
  wTitle  :: String,
  wColor  :: Color4 GLfloat
  }

data State = State {
  sPlaygroundSize :: Size,
  sWindows        :: [Window]
  }

updateView state = do
  matrixMode $= Projection
  loadIdentity
  scale 1 (-1 :: GLfloat) 1
  let (Size w h) = sPlaygroundSize state
  viewport $= (Position 0 0, sPlaygroundSize state)
  ortho2D 0 (fromIntegral w) 0 (fromIntegral h)

display :: IORef State -> DisplayCallback
display stateref = do
  state <- readIORef stateref
  clear [ColorBuffer]
  --matrixMode $= Modelview 0
  --loadIdentity

  mapM_ renderWindow (sWindows state)

  swapBuffers where

  renderWindow win = do
    let (x,y) = wOrigin win
    let (w,h) = wSize win
    currentColor $= wColor win
    renderPrimitive Quads $ do
      mapM_ (\(x,y) -> vertex $ Vertex2 ((fromIntegral x)::GLfloat) (fromIntegral y))
        [(x,y), (x,y+h), (x+w,y+h), (x+w,y)]

key :: IORef State -> KeyboardMouseCallback
key stateref key keystate mods pos = exitWith ExitSuccess

reshape :: IORef State -> ReshapeCallback
reshape rstate size@(Size w h)= do
  viewport $= (Position 0 0, size)
  modifyIORef rstate (\s -> s { sPlaygroundSize=size })
  state <- readIORef rstate
  updateView state

main :: IO ()
main = do
  (name, args) <- getArgsAndInitialize
  initialDisplayMode $= [DoubleBuffered, RGBMode]
  depthFunc $= Just Less
  let windows = [Window (10,10) (400,300) "XTerm" (Color4 0.5 0 0 0)]
  let state = State { sPlaygroundSize=(Size 640 480), sWindows=windows }
  rstate <- newIORef state
  initialWindowSize $= sPlaygroundSize state
  createWindow "whim: management test"

  clearColor $= Color4 0.0 0.0 0.0 0.0
  lineSmooth $= Enabled

  updateView state

  matrixMode $= Modelview 0

  displayCallback $= display rstate
  reshapeCallback $= Just (reshape rstate)
  keyboardMouseCallback $= Just (key rstate)
  mainLoop