GPipe-Examples-0.1: src/01_green_triangle.hs

-----------------------------------------------------------------------------
--
-- Example     :  Render a green triangle
-- Copyright   :  Kree Cole-McLaughlin
-- License     :  GPL
--
-- Maintainer  :  Kree Cole-McLaughlin
-- Stability   :  Experimental
-- Portability :  Portable
--
--
-----------------------------------------------------------------------------

module Main where

    import Graphics.GPipe
    import qualified Data.Vec as Vec
    import Data.Vec.Nat
    import Data.Vec.LinAlg.Transform3D
    import Data.Monoid
    import Data.IORef
    import Graphics.UI.GLUT( Window,
                             mainLoop,
                             postRedisplay,
                             idleCallback,
                             getArgsAndInitialize,
                             ($=))
    
    triangle :: PrimitiveStream Triangle (Vec3 (Vertex Float))
    triangle = toGPUStream TriangleList $
               [ (-0.8):.0.8:.0.0:.(), 
                 0.8:.0.8:.0.0:.(),
                 0.0:.(-0.8):.0.0:.() ]

    -- This implements the vertex shader
    procTriangle :: Vec2 Int -> PrimitiveStream Triangle (Vec4 (Vertex Float), Vec3 (Vertex Float))
    procTriangle size = fmap (projTriangle size) triangle 

    projTriangle :: Vec2 Int -> Vec3 (Vertex Float) -> (Vec4 (Vertex Float), Vec3 (Vertex Float))
    projTriangle size pos = (orthoProj `multmv` homPos, toGPU $ 0:.1:.0:.())
        where homPos = homPoint pos :: Vec4 (Vertex Float)  
              orthoProj = toGPU $ orthogonal (-10) 10  (2:.2:.())

    -- This implements the fragment shader
    rastTriangle :: Vec2 Int -> FragmentStream (Color RGBFormat (Fragment Float))
    rastTriangle size = fmap (\(front,color) -> RGB color) $ rasterizeFrontAndBack $ procTriangle size 

    triangleFrame :: Vec2 Int -> FrameBuffer RGBFormat () ()
    triangleFrame size = draw (rastTriangle size) clear
        where
          draw  = paintColor NoBlending (RGB $ Vec.vec True)  
          clear = newFrameBufferColor (RGB (0.1:.0.3:.0.6:.()))

    main :: IO ()
    main = do
      getArgsAndInitialize
      putStrLn "creating window..."
      newWindow "Green Triangle" 
           (100:.100:.()) 
           (800:.600:.()) 
           (renderFrame)
           initWindow
      putStrLn "entering mainloop..."
      mainLoop

    renderFrame :: Vec2 Int -> IO (FrameBuffer RGBFormat () ())
    renderFrame size = do
              return $ triangleFrame size
 
    initWindow :: Window -> IO ()
    initWindow win = idleCallback $= Nothing --Just (postRedisplay (Just win))