{-
   Robot.hs (adapted from robot.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 shows how to composite modeling transformations
   to draw translated and rotated hierarchical models.
   Interaction:  pressing the s and e keys (shoulder and elbow)
   alters the rotation of the robot arm.
-}

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

import GL
import GLU
import Graphics.UI.GLUT

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

display :: IORef Int -> IORef Int -> DisplayCallback
display shoulder elbow = do
   clear [ColorBufferBit]
   pushMatrix
   translate (Vector3 (-1) 0 0 :: Vector3 GLfloat)
   s <- readIORef shoulder
   rotate (fromIntegral s :: GLfloat) (Vector3 0 0 1)
   translate (Vector3 1 0 0 :: Vector3 GLfloat)
   pushMatrix
   scale (2.0 :: GLfloat) 0.4 1.0
   renderObject Wireframe (Cube 1.0)
   popMatrix

   translate (Vector3 1 0 0 :: Vector3 GLfloat)
   e <- readIORef elbow
   rotate (fromIntegral e :: GLfloat) (Vector3 0 0 1)
   translate (Vector3 1 0 0 :: Vector3 GLfloat)
   pushMatrix
   scale (2.0 :: GLfloat) 0.4 1.0
   renderObject Wireframe (Cube 1.0)
   popMatrix

   popMatrix
   swapBuffers

reshape :: ReshapeCallback
reshape (WindowSize w h) = do
   viewport (0, 0) (fromIntegral w, fromIntegral h)
   matrixMode Projection
   loadIdentity
   perspective 65.0 (fromIntegral w / fromIntegral h) 1.0 20.0
   matrixMode Modelview
   loadIdentity
   translate (Vector3 0 0 (-5) :: Vector3 GLfloat)

keyboard :: IORef Int -> IORef Int -> KeyboardMouseCallback
keyboard shoulder _     (Char 's')   Down _ _ = do modifyIORef shoulder (\s -> (s+5) `mod` 360); postRedisplay
keyboard shoulder _     (Char 'S')   Down _ _ = do modifyIORef shoulder (\s -> (s-5) `mod` 360); postRedisplay
keyboard _        elbow (Char 'e')   Down _ _ = do modifyIORef elbow    (\e -> (e+5) `mod` 360); postRedisplay
keyboard _        elbow (Char 'E')   Down _ _ = do modifyIORef elbow    (\e -> (e-5) `mod` 360); postRedisplay
keyboard _        _     (Char '\27') Down _ _ = exitWith ExitSuccess
keyboard _        _     _            _    _ _ = return ()

main :: IO ()
main = do
   (progName, _args) <- getArgsAndInitialize
   setInitialDisplayMode [ Graphics.UI.GLUT.Double, RGB ]
   setInitialWindowSize (WindowSize 500 500)
   setInitialWindowPosition (WindowPosition 100 100)
   createWindow progName
   myInit
   shoulder <- newIORef 0
   elbow    <- newIORef 0
   setDisplayCallback (display shoulder elbow)
   setReshapeCallback (Just reshape)
   setKeyboardMouseCallback (Just (keyboard shoulder elbow))
   mainLoop
