{-
   Unproject.hs (adapted from unproject.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>

   When the left mouse button is pressed, this program 
   reads the mouse position and determines two 3D points 
   from which it was transformed.  Very little is displayed.
-}

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

import GL
import GLU
import Graphics.UI.GLUT

display :: DisplayCallback
display = do
   clear [ColorBufferBit]
   flush

-- Change these values for a different transformation
reshape :: ReshapeCallback
reshape (WindowSize w h) = do
   viewport (0, 0) (fromIntegral w, fromIntegral h)
   matrixMode Projection
   loadIdentity
   perspective 45.0 (fromIntegral w / fromIntegral h) 1.0 100.0
   matrixMode Modelview
   loadIdentity

keyboardMouse :: KeyboardMouseCallback
keyboardMouse (MouseButton LeftButton) Down _ (WindowPosition x y) = do
   (pos@(_::GLint,_::GLint), size@(_::GLsizei, height::GLsizei)) <- get VarViewport
   mvMatrix   <- get VarModelviewMatrix
   projMatrix <- get VarProjectionMatrix
   let realY = fromIntegral height - y - 1
   putStrLn ("Coordinates at cursor are " ++ show (x, realY))
   Just (wx1,wy1,wz1) <- unProject (fromIntegral x, fromIntegral realY, 0) mvMatrix projMatrix pos size
   putStrLn ("World coords at z=0.0 are " ++ show (wx1,wy1,wz1))
   Just (wx2,wy2,wz2) <- unProject (fromIntegral x, fromIntegral realY, 1) mvMatrix projMatrix pos size
   putStrLn ("World coords at z=1.0 are " ++ show (wx2,wy2,wz2))
keyboardMouse (MouseButton RightButton) Down _ _ = exitWith ExitSuccess
keyboardMouse (Char '\27')              Down _ _ = exitWith ExitSuccess
keyboardMouse _                         _    _ _ = return ()

-- Open window, register input callback functions
main :: IO ()
main = do
   (progName, _args) <- getArgsAndInitialize
   setInitialDisplayMode [ Single, RGB ]
   setInitialWindowSize (WindowSize 500 500)
   setInitialWindowPosition (WindowPosition 100 100)
   createWindow progName
   setDisplayCallback display
   setReshapeCallback (Just reshape)
   setKeyboardMouseCallback (Just keyboardMouse)
   mainLoop
