{-
   Clip.hs (adapted from clip.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 arbitrary clipping planes.
-}

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 :: DisplayCallback
display = do
   clear [ColorBufferBit]
   color (Color3 1.0 1.0 1.0 :: Color3 GLfloat)
   pushMatrix
   translate (Vector3 0 0 (-5) :: Vector3 GLfloat)

   -- clip lower half -- y < 0
   clipPlane (ClipPlane 0) (Plane 0 1 0 0)
   enable (ClipPlane 0)
   -- clip left half -- x < 0
   clipPlane (ClipPlane 1) (Plane 1 0 0 0)
   enable (ClipPlane 1)

   rotate (90 :: GLfloat) (Vector3 1 0 0)
   renderObject Wireframe (Graphics.UI.GLUT.Sphere 1 20 16)
   popMatrix
   flush

reshape :: ReshapeCallback
reshape (WindowSize w h) = do
   viewport (0, 0) (fromIntegral w, fromIntegral h)
   matrixMode Projection
   loadIdentity
   perspective 60.0 (fromIntegral w / fromIntegral h) 1.0 20.0
   matrixMode Modelview

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

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