{-
   DList.hs (adapted from list.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 how to make and execute a 
   display list.  Note that attributes, such as current 
   color and matrix, are changed.
-}

import Control.Monad ( liftM )
import System.Exit   ( exitWith, ExitCode(ExitSuccess) )

import GL
import GLU
import Graphics.UI.GLUT

myInit :: IO DisplayList
myInit = do
   listName <- liftM head (genLists 1)
   newEndList listName Compile $ do
      color (Color3 1 0 (0 :: GLfloat)) -- current color red
      beginEnd Triangles $ do
         vertex (Vertex2 0.0 (0.0 :: GLfloat))
         vertex (Vertex2 1.0 (0.0 :: GLfloat))
         vertex (Vertex2 0.0 (1.0 :: GLfloat))
      translate (Vector3 1.5 0.0 (0.0 :: GLfloat)) -- move position
   shadeModel GL.Flat
   return listName

drawLine :: IO ()
drawLine =
   beginEnd Lines $ do
      vertex (Vertex2  0.0 (0.5 :: GLfloat))
      vertex (Vertex2 15.0 (0.5 :: GLfloat))

display :: DisplayList -> DisplayCallback
display listName = do
   clear [ ColorBufferBit ]
   color (Color3 0 1 (0 :: GLfloat)) -- current color green
   sequence_ (replicate 10 (callList listName)) -- draw 10 triangles
   drawLine -- is this line green? NO!
            -- where is the line drawn?
   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 0.0 2.0 (-0.5*hf/wf) (1.5*hf/wf)
      else ortho2D 0.0 (2.0*wf/hf) (-0.5) 1.5
   matrixMode Modelview
   loadIdentity

keyboard :: KeyboardMouseCallback
keyboard (Char '\27') Down _ _ = exitWith ExitSuccess
keyboard _            _    _ _ = return ()

-- Open window with initial window size, title bar, 
-- RGBA display mode, and handle input events.
main :: IO ()
main = do
   (progName, _args) <- getArgsAndInitialize
   setInitialDisplayMode [ Single, RGB ]
   setInitialWindowSize (WindowSize 650 50)
   createWindow progName
   listName <- myInit
   setReshapeCallback (Just reshape)
   setDisplayCallback (display listName)
   setKeyboardMouseCallback (Just keyboard)
   mainLoop
