RenderQueue.hs

module Graphics.LambdaCube.RenderQueue where

import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.List
import Data.Maybe
import Control.Monad

import Graphics.LambdaCube.Types
import Graphics.LambdaCube.Utility
import Graphics.LambdaCube.Pass
import Graphics.LambdaCube.Light
import Graphics.LambdaCube.RenderOperation
import Graphics.LambdaCube.VertexIndexData
import Graphics.LambdaCube.RenderSystem
import Graphics.LambdaCube.HardwareVertexBuffer
import Graphics.LambdaCube.HardwareIndexBuffer
import Graphics.LambdaCube.Texture
import Graphics.LambdaCube.TextureUnitState
import Graphics.LambdaCube.GpuProgram

-- Standard Render Queues
constRenderQueueBackground      = 0   :: Int
constRenderQueueSkiesEarly      = 5   :: Int  -- ^ First queue (after backgrounds), used for skyboxes if rendered first
constRenderQueue1               = 10  :: Int
constRenderQueue2               = 20  :: Int
constRenderQueueWorldGeometry1  = 25  :: Int
constRenderQueue3               = 30  :: Int
constRenderQueue4               = 40  :: Int
constRenderQueueMain            = 50  :: Int  -- ^ The default render queue
constRenderQueue6               = 60  :: Int
constRenderQueue7               = 70  :: Int
constRenderQueueWorldGeometry2  = 75  :: Int
constRenderQueue8               = 80  :: Int
constRenderQueue9               = 90  :: Int
constRenderQueueSkiesLate       = 95  :: Int  -- ^ Penultimate queue(before overlays), used for skyboxes if rendered last
constRenderQueueOverlay         = 100 :: Int  -- ^ Use this queue for objects which must be rendered last e.g. overlays
constRenderQueueMax             = 105 :: Int  -- ^ Final possible render queue, don't exceed this

constRenderableDefaultPriority  = 100 :: Int

data RenderGroupOptions
    = RenderGroupOptions
    { rqoShadowsEnabled :: Bool
    }

defaultRenderGroupOptions = RenderGroupOptions
    { rqoShadowsEnabled = True
    }

-- | Struct associating a single Pass with a single Renderable. 
data (HardwareVertexBuffer vb, HardwareIndexBuffer ib, Texture t, LinkedGpuProgram lp) => RenderablePass vb ib t lp
    = RenderablePass
    { rpOperation   :: RenderOperation vb ib
    , rpPass        :: Pass t lp
    , rpMatrix      :: Matrix4
    , rpLights      :: [(Matrix4,Light)]
    }

data RenderStatistics
    = RenderStatistics
    { rsFaceCount   :: Int
    , rsVertexCount :: Int
    , rsBatchCount  :: Int
    }
    deriving Show
    
emptyRenderStatistics = RenderStatistics
    { rsFaceCount   = 0
    , rsVertexCount = 0
    , rsBatchCount  = 0
    }

--renderPassGroup :: RenderSystem -> RenderablePass -> IO ()
renderPassGroup time rs rstat r = do
    let pass = rpPass $ head r
        depthBiasConstant   = psDepthBiasConstant pass
        depthBiasPerIter    = psDepthBiasPerIteration pass
        depthBiasSlopeScale = psDepthBiasSlopeScale pass
        iterationCnt        = psPassIterationCount pass
        geomCmp a b         = rpOperation a == rpOperation b
        geomSort a b        = case geomCmp a b of
            { True  -> EQ
            ; False -> GT
            }
        renderGeomGrp pass rst r = do
            let rop     = rpOperation $ head r
                geomCnt = length r
--            print $ "  geomGrp len: " ++ (show $ length r)
            --TODO: setup object related shader parameters
            bindGeometry rs rop $ psTextureUnitStates pass
            mapM_ (renderGeom pass) r
            unbindGeometry rs rop

            -- calculate statistics
            let val     = if isNothing $ roIndexData rop then vdVertexCount $ roVertexData rop else idIndexCount $ fromJust $ roIndexData rop 
                val'    = case roOperationType rop of
                    { OT_TRIANGLE_LIST  -> val `div` 3
                    ; OT_TRIANGLE_STRIP -> val - 2
                    ; OT_TRIANGLE_FAN   -> val - 2
                    ; _ -> 0
                    }
            return RenderStatistics
                { rsFaceCount   = geomCnt * iterationCnt * val' + rsFaceCount rst
                , rsVertexCount = geomCnt * (vdVertexCount $ roVertexData rop) + rsVertexCount rst
                , rsBatchCount  = geomCnt * iterationCnt + rsBatchCount rst
                }

        renderGeom pass r = do
            setWorldMatrix rs $ rpMatrix r

            --TODO: do pass and per light iterations
            --       light list with attributes
            -- filter relevant lights
            let lights      = drop (psStartLight pass) $ take (psMaxSimultaneousLights pass) $ filter filtL $ rpLights r
                filtL (m,l) = case psOnlyLightType pass of
                    { Nothing   -> True
                    ; Just t    -> t == (lgType l)
                    }
                -- create light groups according requirement (per n light)
                lightGrp    = case psLightsPerIteration pass of
                    { Nothing   -> [lights]
                    ; Just n    -> f n lights
                    }
                f _ [] = []
                f n l = h:(f n t)
                  where
                    (h,t) = splitAt n l
            -- render n times each light group
            forM_ lightGrp $ \l -> do
                --TODO setup lights
                --TODO: useLights rs l
                --TODO: setup per light iteration shader parameters
                forM_ [1..iterationCnt] $ \pc -> do
                    -- TODO: update iteration dependent parameteres:
                        --TODO: setup pass iteration number shader parameter
                    -- Update derived depth bias
                    when (pc > 1 && depthBiasPerIter /= 0) $ setDepthBias rs (depthBiasConstant + (fromIntegral pc-1) * depthBiasPerIter) depthBiasSlopeScale
                    render rs $ rpOperation r
            
    setPass time rs pass 
--    print $ "passGrp len: " ++ (show $ length r) ++ " " ++ show [ tusFrameNames tu | tu <- psTextureUnitStates pass ]
    --TODO: setup global pass related shader parameters
    --foldM (renderGeomGrp pass) rstat $ groupBy geomCmp $ sortBy geomSort r
    foldM (renderGeomGrp pass) rstat $ groupSetBy geomCmp r
   
--[(Matrix4,r,Int,Int)]    -- ^ List of Renderable information including WorldMatrix RenderQueueID and RenderPriority
--renderCollection :: (RenderSystem rs, Renderable r) => rs -> IntMap RenderGroupOptions -> [(Matrix4,r,Int,Int)] -> IO ()
renderCollection time rs roptMap rstat rl = do

    let passCmp a b = rpPass a == rpPass b
        passSort a b = case passCmp a b of
            { True  -> EQ
            ; False -> GT
            }
        --groupPass 
        
        -- group by pass and geometry
        --passGroupRenderMethod rst a = foldM (renderPassGroup time rs) rst $ groupBy passCmp $ sortBy passSort a
        passGroupRenderMethod rst a = foldM (renderPassGroup time rs) rst $ groupSetBy passCmp a
        
        -- sort by distance
        distanceSortRenderMethod = undefined
        
        -- simple render
        simpleRenderMethod = undefined

        
        rents   = concat [r | (m,r,_,_) <- rl]
        lights  = [] -- TODO
        (_,_,grpID,_) = head rl
        ropt = fromMaybe defaultRenderGroupOptions $ IntMap.lookup grpID roptMap

    -- Do solids
    rstat1 <- passGroupRenderMethod rstat [RenderablePass ro p m lights | RenderEntity ro pl m <- rents, p <- pl]
    
    -- Do unsorted transparents
    --simpleRenderMethod $ rpgTransparentsUnsorted rpg
    
    -- Do transparents (always descending)
    --distanceSortRenderMethod $ rpgTransparents rpg
    return rstat1

-- Fast    
--renderQueue :: (RenderSystem rs, Renderable r) => rs -> IntMap RenderGroupOptions -> [(Matrix4,r,Int,Int)] -> IO ()
-- TODO: maybe we should try parallelize this code
-- HINT: Ogre uses radix sort
renderQueue time rs roptMap rstat rl = do
    let grpPriorGroupCmp (_,_,ga,pa) (_,_,gb,pb) = ga == gb && pa == pb
        grpPriorSortCmp al bl = case ga `compare` gb of
            { LT    -> LT
            ; EQ    -> pa `compare` pb
            ; GT    -> GT
            }
          where
            (_,_,ga,pa) = {-head-} al
            (_,_,gb,pb) = {-head-} bl
--    foldM (renderCollection rs roptMap) rstat $ groupBy grpPriorGroupCmp $ sortBy grpPriorSortCmp rl
    foldM (renderCollection time rs roptMap) rstat $ groupSetBy grpPriorGroupCmp rl

----------------------------------------------------------------------------------------------------------------------------
-- Slow code below  --------------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------------------------------
{-
data RenderQueue
    = RenderQueue
    { rqGroupMap :: IntMap RenderGroup
    }

data RenderGroup
    = RenderGroup
    { rgPriorityGroups  :: IntMap RenderPriorityGroup
    , rgShadowsEnabled  :: Bool -- ^ Whether shadows are enabled for this queue
    }

data RenderPriorityGroup
    = RenderPriorityGroup
    { rpgSolidsBasic            :: [RenderablePass] -- ^ Solid pass list, used when no shadows, modulative shadows, or ambient passes for additive
    , rpgSolidsDiffuseSpecular  :: [RenderablePass] -- ^ Solid per-light pass list, used with additive shadows
    , rpgSolidsDecal            :: [RenderablePass] -- ^ Solid decal (texture) pass list, used with additive shadows
    , rpgSolidsNoShadowReceive  :: [RenderablePass] -- ^ Solid pass list, used when shadows are enabled but shadow receive is turned off for these passes
    , rpgTransparentsUnsorted   :: [RenderablePass] -- ^ Unsorted transparent list
    , rpgTransparents           :: [RenderablePass] -- ^ Transparent list
    }
-}