{-
   DrawF.hs  (adapted from drawf.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>

   Draws the bitmapped letter F on the screen (several times).
   This demonstrates use of the bitmap call.
-}

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

import GL
import Graphics.UI.GLUT

myInit :: IO (Ptr GLubyte)
myInit = do
   pixelStore Unpack (Alignment 1)
   clearColor (Color4 0 0 0 0)
   newArray [
      0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00,
      0xff, 0x00, 0xff, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00,
      0xff, 0xc0, 0xff, 0xc0 ]

display :: Ptr GLubyte -> DisplayCallback
display rasters = do
   clear [ ColorBufferBit ]
   color (Color3 1 1 (1 :: GLfloat))
   rasterPos (RasterPos2 20 (20 :: GLint))
   bitmap (10, 12) (Vertex2 0 0) (Vector2 11 0) rasters
   bitmap (10, 12) (Vertex2 0 0) (Vector2 11 0) rasters
   bitmap (10, 12) (Vertex2 0 0) (Vector2 11 0) rasters
   flush

reshape :: ReshapeCallback
reshape (WindowSize w h) = do
   viewport (0, 0) (fromIntegral w, fromIntegral h)
   matrixMode Projection
   loadIdentity
   ortho 0 (fromIntegral w) 0 (fromIntegral h) (-1) 1
   matrixMode Modelview

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

-- Main Loop
-- 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 100 100)
   setInitialWindowPosition (WindowPosition 100 100)
   createWindow progName
   rasters <- myInit
   setReshapeCallback (Just reshape)
   setKeyboardMouseCallback (Just keyboard)
   setDisplayCallback (display rasters)
   mainLoop
