{-
   Smooth.hs (adapted from smooth.c which is (c) Silicon Graphics, Inc)
   This file is part of HOpenGL - a binding of OpenGL and GLUT for Haskell.
   Copyright (C) 2000  Sven Panne <Sven.Panne@informatik.uni-muenchen.de>

   This program demonstrates vertex arrays.
-}

import Data.IORef  ( IORef, newIORef, readIORef, modifyIORef )
import System.Exit ( exitWith, ExitCode(ExitSuccess) )

import GL
import GLU
import Graphics.UI.GLUT

data SetupMethod = Pointer   | Interleaved                   deriving (Enum, Bounded)
data DerefMethod = DrawArray | ArrayElement | DrawElements   deriving (Enum, Bounded)

setupPointers :: IO ()
setupPointers = do
   vertices <- newArray [
      Vertex2 25 25,
      Vertex2 100  325,
      Vertex2 175   25,
      Vertex2 175  325,
      Vertex2 250   25,
      Vertex2 325 (325 :: GLint) ]
   colors <- newArray [
      Color3 1.0  0.2   0.2,
      Color3 0.2  0.2   1.0,
      Color3 0.8  1.0   0.2,
      Color3 0.75 0.75  0.75,
      Color3 0.35 0.35  0.35,
      Color3 0.5  0.5  (0.5 :: GLfloat) ]

   mapM_ enableClientState [ VertexArray, ColorArray ]

   vertexPointer 2 Int   0 vertices
   colorPointer  3 Float 0 colors

setupInterleave :: IO ()
setupInterleave = do
   intertwined <- newArray [
      1.0, 0.2, 1.0, 100.0, 100.0,  0.0,
      1.0, 0.2, 0.2,   0.0, 200.0,  0.0,
      1.0, 1.0, 0.2, 100.0, 300.0,  0.0,
      0.2, 1.0, 0.2, 200.0, 300.0,  0.0,
      0.2, 1.0, 1.0, 300.0, 200.0,  0.0,
      0.2, 0.2, 1.0, 200.0, 100.0, (0.0 :: GLfloat) ]
   interleavedArrays C3fV3f 0 (castPtr intertwined)

myInit :: IO ()
myInit = do
   clearColor (Color4 0.0 0.0 0.0 0.0)
   shadeModel GL.Smooth
   setupPointers

display :: IORef DerefMethod -> DisplayCallback
display derefMethod = do
   clear [ ColorBufferBit ]

   dm <- readIORef derefMethod
   case dm of
      DrawArray    -> drawArrays Triangles 0 6
      ArrayElement -> beginEnd Triangles $ do
                         arrayElement 2
                         arrayElement 3
                         arrayElement 5
      DrawElements -> withArray [ 0, 1, 3, 4 :: GLuint ] $
                      drawElements Polygon 4 UnsignedInt . castPtr
   flush

reshape :: ReshapeCallback
reshape (WindowSize w h) = do
   viewport (0, 0) (fromIntegral w, fromIntegral h)
   matrixMode Projection
   ortho2D 0.0 (fromIntegral w) 0.0 (fromIntegral h)

next :: (Enum a, Bounded a) => a -> a
next x = toEnum . (`mod` (fromEnum (maxBound `asTypeOf` x) + 1)) . (+1) . fromEnum $ x

keyboardMouse :: IORef SetupMethod -> IORef DerefMethod -> KeyboardMouseCallback
keyboardMouse setupMethod _ (MouseButton LeftButton) Down _ _ = do
   modifyIORef setupMethod next
   sm <- readIORef setupMethod
   case sm of
      Pointer     -> setupPointers
      Interleaved -> setupInterleave
   postRedisplay
keyboardMouse _ derefMethod (MouseButton MiddleButton) Down _ _ = do
   modifyIORef derefMethod next
   postRedisplay
keyboardMouse setupMethod derefMethod (MouseButton RightButton) Down m p =
   keyboardMouse setupMethod derefMethod (MouseButton MiddleButton) Down m p
keyboardMouse _ _ (Char '\27') Down _ _ = exitWith ExitSuccess
keyboardMouse _ _ _ _ _ _ = return ()

main :: IO ()
main = do
   (progName, _args) <- getArgsAndInitialize
   setInitialDisplayMode [ Single, RGB ]
   setInitialWindowSize (WindowSize 350 350)
   setInitialWindowPosition (WindowPosition 100 100)
   createWindow progName
   myInit
   setupMethod <- newIORef Pointer
   derefMethod <- newIORef DrawArray
   setDisplayCallback (display derefMethod)
   setReshapeCallback (Just reshape)
   setKeyboardMouseCallback (Just (keyboardMouse setupMethod derefMethod))
   mainLoop
