{-
   BlendEqn.hs  (adapted from blendeqn.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>

   Demonstrate the different blending functions available with the
   OpenGL imaging subset.  This program demonstrates use of the
   glBlendEquation() call.
 
   The following keys change the selected blend equation function:
 
       'a'  ->  GL_FUNC_ADD
       's'  ->  GL_FUNC_SUBTRACT
       'r'  ->  GL_FUNC_REVERSE_SUBTRACT
       'm'  ->  GL_MIN
       'x'  ->  GL_MAX
-}

import Data.Char   ( toLower )
import System.Exit ( exitWith, ExitCode(ExitSuccess) )

import GL
import Graphics.UI.GLUT

myInit :: IO ()
myInit = do
   clearColor (Color4 1 1 0 0)

   blendFunc One One
   enable Blend'

display :: DisplayCallback
display = do
   clear [ ColorBufferBit ]

   color (Color3 0 0 (1 :: GLfloat))
   rect (Vertex2 (-0.5) (-0.5 :: GLfloat)) (Vertex2 0.5 (0.5 :: GLfloat))

   flush

reshape :: ReshapeCallback
reshape (WindowSize w h) = do
   let aspect = fromIntegral w / fromIntegral h

   viewport (0, 0) (fromIntegral w, fromIntegral h)
   matrixMode Projection
   loadIdentity
   if (aspect < 1.0)
      then ortho (-recip aspect) (recip aspect) (-1.0) 1.0 (-1.0) 1.0
      else ortho (-1.0) 1.0 (-aspect) aspect (-1.0) 1.0
   matrixMode Modelview

keyboard :: KeyboardMouseCallback
keyboard (Char c) Down _ _ = case toLower c of
   'a'   -> -- Colors are added as: (1, 1, 0) + (0, 0, 1) = (1, 1, 1)
            -- which will produce a white square on a yellow background.
            do blendEquation FuncAdd; postRedisplay

   's'   -> -- Colors are subtracted as: (0, 0, 1) - (1, 1, 0) = (-1, -1, 1)
            -- which is clamped to (0, 0, 1), producing a blue square on a
            -- yellow background
            do blendEquation FuncSubtract; postRedisplay

   'r'   -> -- Colors are subtracted as: (1, 1, 0) - (0, 0, 1) = (1, 1, -1)
            -- which is clamed to (1, 1, 0).  This produces yellow for both
            -- the square and the background.
            do blendEquation FuncReverseSubtract; postRedisplay

   'm'   -> -- The minimum of each component is computed, as
            -- [min(1, 0), min(1, 0), min(0, 1)] which equates to (0, 0, 0).
            -- This will produce a black square on the yellow background.
            do blendEquation Min; postRedisplay

   'x'   -> -- The minimum of each component is computed, as
            -- [max(1, 0), max(1, 0), max(0, 1)] which equates to (1, 1, 1)
            -- This will produce a white square on the yellow background.
            do blendEquation Max; postRedisplay

   '\27' -> exitWith ExitSuccess

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