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
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]
--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