-----------------------------------------------------------------------------
--
-- Example     :  Render a green sphere
-- 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,
                             ($=))
    
    rectGrid :: Int -> Int -> PrimitiveStream Triangle (Vec3 (Vertex Float))
    rectGrid w h = toGPUStream TriangleList $
            foldr (sphericalCoordGrid w h) [] nodes
        where nodes = [ (i,j) | i <- [1..w], j <- [1..h] ]

    sphericalCoordGrid w h (i,j) tris =
            tris ++ [ x1:.y1:.0:.(), x2:.y1:.0:.(), x1:.y2:.0:.(),
                      x2:.y1:.0:.(), x2:.y2:.0:.(), x1:.y2:.0:.() ]
        where x1 = 2*pi*(fromIntegral i) / (fromIntegral w)
              x2 = 2*pi*(fromIntegral i+1) / (fromIntegral w)
              y1 = (2*pi*(fromIntegral j) / (fromIntegral h)) - pi
              y2 = (2*pi*(fromIntegral j+1) / (fromIntegral h)) - pi

    -- This renders a sphere from the grid of triangles produced by the above function
    renderSphere :: Float -> PrimitiveStream Triangle (Vec3 (Vertex Float))
                 -> PrimitiveStream Triangle (Vec4 (Vertex Float), Vec3 (Vertex Float))
    renderSphere radius grid = fmap (buildSphere (toGPU radius)) grid

    buildSphere :: Vertex Float -> Vec3 (Vertex Float) -> (Vec4 (Vertex Float), Vec3 (Vertex Float))
    buildSphere r (x:.y:._:.()) = (homPoint pos, normalize pos)
        where pos   = (r*cosx*cosy):.(r*sinx*cosy):.(r*siny):.()
              cosx  = cos x
              sinx  = sin x
              cosy  = cos y
              siny  = sin y

    lightSphere :: Vec3 Float -> PrimitiveStream Triangle (Vec4 (Vertex Float), Vec3 (Vertex Float)) 
                -> PrimitiveStream Triangle (Vec4 (Vertex Float), Vec3 (Vertex Float))
    lightSphere color sphere = fmap (cameraLight (toGPU color)) sphere
                         
    cameraLight color (pos,norm) = (pos, color * Vec.vec (norm `dot` light))
        where light = toGPU (0:.0:.(-1):.())
        
    -- This implements the fragment shader
    rastSphere :: Vec2 Int -> FragmentStream (Color RGBFormat (Fragment Float))
    rastSphere size = fmap (\(front,color) -> RGB color) $ rasterizeFrontAndBack $ litSphere
        where litSphere = lightSphere (0:.1:.0:.()) sphere
              sphere = renderSphere 0.8 grid
              grid = rectGrid 40 40

    sphereFrame :: Vec2 Int -> FrameBuffer RGBFormat () ()
    sphereFrame size = draw (rastSphere 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 Sphere" 
           (100:.100:.()) 
           (400:.400:.()) 
           (renderFrame)
           initWindow
      putStrLn "entering mainloop..."
      mainLoop

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