{-
   Lines.hs (adapted from lines.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 geometric primitives and
   their attributes.
-}

import System.Exit ( exitWith, ExitCode(ExitSuccess) )

import GL
import GLU
import Graphics.UI.GLUT

drawOneLine :: Vertex2 GLfloat -> Vertex2 GLfloat -> IO ()
drawOneLine p1 p2 = beginEnd Lines $ do vertex p1; vertex p2

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

display :: DisplayCallback
display = do
   clear [ColorBufferBit]

   -- select white for all lines
   color (Color3 1.0 1.0 1.0 :: Color3 GLfloat)

   -- in 1st row, 3 lines, each with a different stipple
   enable LineStipple
   
   lineStipple 1 0x0101  --  dotted
   drawOneLine (Vertex2  50 125) (Vertex2 150 125)
   lineStipple 1 0x00FF  --  dashed
   drawOneLine (Vertex2 150 125) (Vertex2  50 125)
   lineStipple 1 0x1C47  --  dash/dot/dash
   drawOneLine (Vertex2 250 125) (Vertex2 350 125)

   -- in 2nd row, 3 wide lines, each with different stipple
   lineWidth 5.0
   lineStipple 1 0x0101  --  dotted
   drawOneLine (Vertex2  50 100) (Vertex2 150 100)
   lineStipple 1 0x00FF  --  dashed
   drawOneLine (Vertex2 150 100) (Vertex2 250 100)
   lineStipple 1 0x1C47  --  dash/dot/dash
   drawOneLine (Vertex2 250 100) (Vertex2 350 100)
   lineWidth 1.0

   -- in 3rd row, 6 lines, with dash/dot/dash stipple
   -- as part of a single connected line strip
   lineStipple 1 0x1C47  --  dash/dot/dash
   beginEnd LineStrip $ mapM_ vertex [ Vertex2 (50+(i*50)) (75 :: GLint) | i <- [0..6] ]

   -- in 4th row, 6 independent lines with same stipple
   sequence_ [ drawOneLine (Vertex2 (50+( i   *50)) 50)
                           (Vertex2 (50+((i+1)*50)) 50) | i <- [0..5] ]

   -- in 5th row, 1 line, with dash/dot/dash stipple
   -- and a stipple repeat factor of 5
   lineStipple 5 0x1C47  --  dash/dot/dash
   drawOneLine (Vertex2 50 25) (Vertex2 350 25)

   disable LineStipple
   flush

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

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

main :: IO ()
main = do
   (progName, _args) <- getArgsAndInitialize
   setInitialDisplayMode [ Single, RGB ]
   setInitialWindowSize (WindowSize 400 150)
   setInitialWindowPosition (WindowPosition 100 100)
   createWindow progName
   myInit
   setDisplayCallback display
   setReshapeCallback (Just reshape)
   setKeyboardMouseCallback (Just keyboard)
   mainLoop
