----------------------------------------------------------------------------- -- -- 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))