{-
   AAIndex.hs  (adapted from aaindex.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 draws shows how to draw anti-aliased lines in color
   index mode. It draws two diagonal lines to form an X; when 'r' 
   is typed in the window, the lines are rotated in opposite directions.
-}

import Control.Monad ( liftM )
import Data.Char     ( toLower )
import Data.IORef    ( IORef, newIORef, readIORef, writeIORef, modifyIORef )
import System.Exit   ( exitWith, ExitCode(ExitSuccess) )

import GL
import GLU
import Graphics.UI.GLUT

rampSize :: GLint
rampSize = 16

ramp1Start, ramp2Start :: ColorIndex GLint
ramp1Start = ColorIndex 32
ramp2Start = ColorIndex 48

-- Initialize antialiasing for color index mode,
-- including loading a green color ramp starting
-- at ramp1Start, and a blue color ramp starting
-- at ramp2Start. The ramps must be a multiple of 16.
myInit :: IO ()
myInit = do
   let ColorIndex r1Start = ramp1Start
       ColorIndex r2Start = ramp2Start
   sequence_ [ do setColor (ColorIndex (fromIntegral (r1Start+i)))
                           (Color3 0 shade 0)
                  setColor (ColorIndex (fromIntegral (r2Start+i)))
                           (Color3 0 0 shade) |
               i <- [ 0 .. rampSize-1 ],
               let shade = fromIntegral i / fromIntegral rampSize ]

   enable LineSmooth
   hint LineSmoothHint DontCare

   clearIndex (ColorIndex (fromIntegral r1Start))

-- Draw 2 diagonal lines to form an X
display :: IORef Int -> DisplayCallback
display rotAngle = do
   angle <- liftM (fromIntegral :: Int -> GLfloat) (readIORef rotAngle)
   clear [ AccumBufferBit ]

   index ramp1Start
   pushMatrix
   rotate (-angle) (Vector3 0 0 1)
   beginEnd Lines $ do
      vertex (Vertex2 (-0.5) ( 0.5 :: GLfloat))
      vertex (Vertex2   0.5  (-0.5 :: GLfloat))
   popMatrix

   index ramp2Start
   pushMatrix
   rotate angle (Vector3 0 0 1)
   beginEnd Lines $ do
      vertex (Vertex2   0.5  ( 0.5 :: GLfloat))
      vertex (Vertex2 (-0.5) (-0.5 :: GLfloat))
   popMatrix

   flush

reshape :: ReshapeCallback
reshape (WindowSize w h) = do
   viewport (0, 0) (fromIntegral w, fromIntegral h)
   matrixMode Projection
   loadIdentity
   let wf = fromIntegral w
       hf = fromIntegral h
   if (w <= h)
      then ortho2D (-1.0) 1.0 (-1.0*hf/wf) (1.0*hf/wf)
      else ortho2D (-1.0*wf/hf) (1.0*wf/hf) (-1.0) 1.0
   matrixMode Modelview
   loadIdentity

keyboard :: IORef Int -> KeyboardMouseCallback
keyboard rotAngle (Char c) Down _ _ = case toLower c of
   'r'   -> do modifyIORef rotAngle (\a -> (a + 20) `mod` 360); postRedisplay
   '\27' -> exitWith ExitSuccess
   _     -> return ()
keyboard _ _ _ _ _ = return ()

--  Main Loop
--  Open window with initial window size, title bar, 
--  color index display mode, and handle input events.
main :: IO ()
main = do
   (progName, _args) <- getArgsAndInitialize
   setInitialDisplayMode [ Single, Index ]
   setInitialWindowSize (WindowSize 200 200)
   createWindow progName
   myInit
   setReshapeCallback (Just reshape)
   rotAngle <- newIORef 0
   setKeyboardMouseCallback (Just (keyboard rotAngle))
   setDisplayCallback (display rotAngle)
   mainLoop
