Add num_shadow_casters graphics parameter, allow cycle down enum options

src/Dodge/Data/Config.hs

@@ -10,6 +10,30 @@ import qualified Data.Set as S
 
 {-# ANN module "HLint: ignore Use camelCase" #-}
 
+data NumShadowCasters
+    = NumShadowCasters0
+    | NumShadowCasters1
+    | NumShadowCasters2
+    | NumShadowCasters3
+    | NumShadowCasters4
+    | NumShadowCasters5
+    | NumShadowCasters6
+    | NumShadowCasters7
+    | NumShadowCasters8
+    | NumShadowCasters9
+    | NumShadowCasters10
+    | NumShadowCasters11
+    | NumShadowCasters12
+    | NumShadowCasters13
+    | NumShadowCasters14
+    | NumShadowCasters15
+    | NumShadowCasters16
+    | NumShadowCasters17
+    | NumShadowCasters18
+    | NumShadowCasters19
+    | NumShadowCasters20
+    deriving (Show,Eq,Bounded,Ord,Enum)
+
 data Configuration = Configuration
     { _volume_master :: Float
     , _volume_sound :: Float
@@ -18,6 +42,7 @@ data Configuration = Configuration
     , _graphics_cloud_shadows :: Bool
     , _graphics_object_shadows :: ObjectShadows
     , _graphics_resolution_factor :: ResFactor
+    , _graphics_num_shadow_casters :: NumShadowCasters
     , _windowX :: Float
     , _windowY :: Float
     , _windowPosX :: Int
@@ -81,7 +106,8 @@ defaultConfig =
         , _graphics_wall_textured = True
         , _graphics_cloud_shadows = True
         , _graphics_object_shadows = GeoObjShads
-        , _graphics_resolution_factor = FullRes
+        , _graphics_resolution_factor = QuarterRes
+        , _graphics_num_shadow_casters = toEnum 10
         , _windowX = 800
         , _windowY = 600
         , _windowPosX = 0
@@ -95,6 +121,7 @@ debugOn :: DebugBool -> Configuration -> Bool
 debugOn db = S.member db . _debug_booleans
 
 makeLenses ''Configuration
+deriveJSON defaultOptions ''NumShadowCasters
 deriveJSON defaultOptions ''ResFactor
 deriveJSON defaultOptions ''ObjectShadows
 deriveJSON defaultOptions ''RoomClipping

src/Dodge/Menu.hs

@@ -186,6 +186,7 @@ graphicsMenuOptions =
     , makeBoolOption graphics_wall_textured "WALL TEXTURES"
     , makeEnumOption graphics_object_shadows "OBJECT SHADOWS" id
     , makeBoolOption graphics_cloud_shadows "CLOUD SHADOWS"
+    , makeEnumOption graphics_num_shadow_casters "SHADOW CASTERS" id
     ]
 
 gameOverMenu :: Universe -> ScreenLayer

src/Dodge/Menu/OptionType.hs

@@ -11,8 +11,9 @@ makeBoolOption lns t =
         (\u -> MODStringOption t (show (u ^# uvConfig . lns)))
 
 makeEnumOption lns str sideeff =
-    Toggle
+    Toggle2
         (\u -> sideeff (u & uvConfig . lns #%~ cycleEnum))
+        (\u -> sideeff (u & uvConfig . lns #%~ cycleDownEnum))
         (\u -> MODStringOption str (show (u ^# uvConfig . lns)))
 
 makeSubmenuOption submenu t = Toggle (pushScreen submenu) (const t)
@@ -21,3 +22,8 @@ cycleEnum :: (Eq a, Enum a, Bounded a) => a -> a
 cycleEnum x
     | x == maxBound = minBound
     | otherwise = succ x
+
+cycleDownEnum :: (Eq a, Enum a, Bounded a) => a -> a
+cycleDownEnum x
+    | x == minBound = maxBound
+    | otherwise = pred x

src/Dodge/Render.hs

@@ -21,7 +21,7 @@ import Graphics.GL.Core43
 import Graphics.Rendering.OpenGL hiding (color, rotate, scale, translate)
 import MatrixHelper
 import Render
-import qualified SDL
+--import qualified SDL
 import Shader
 import Shader.Bind
 import Shader.Data
@@ -29,9 +29,9 @@ import Shader.ExtraPrimitive
 import Shader.Parameters
 import Shader.Poke
 
-doDrawing :: RenderData -> Universe -> IO Word32
+doDrawing :: RenderData -> Universe -> IO ()
 doDrawing pdata u = do
-    sTicks <- SDL.ticks
+--    sTicks <- SDL.ticks
     let w = _uvWorld u
         cfig = _uvConfig u
         rot = w ^. cWorld . camPos . camRot
@@ -293,8 +293,8 @@ doDrawing pdata u = do
     renderLayer FixedCoordLayer shadV layerCounts
     renderFoldable shadV $ fixedCoordPictures u
     depthMask $= Enabled
-    eTicks <- SDL.ticks
-    return (eTicks - sTicks)
+--    eTicks <- SDL.ticks
+--    return (eTicks - sTicks)
 
 --------------------------------------------------------------------------------
 -- note: currently assume there is only one UBO, we only bind it once at setup

src/Dodge/Render/Lights.hs

@@ -2,6 +2,7 @@ module Dodge.Render.Lights (
     lightsToRender,
 ) where
 
+import Data.List (sortOn)
 import Data.Maybe
 import Dodge.Data.LWorld
 import Dodge.Data.CamPos
@@ -11,7 +12,9 @@ import qualified IntMapHelp as IM
 import Control.Lens
 
 lightsToRender :: Configuration -> CamPos -> LWorld -> [(Point3, Float, Point3)]
-lightsToRender cfig campos w =
+{-# INLINE lightsToRender #-}
+lightsToRender cfig campos w =  take (fromEnum $ cfig ^. graphics_num_shadow_casters) $
+    sortOn (\(_,x,_) -> negate x) $
     mapMaybe getLS (IM.elems $ w ^. lightSources)
         ++ mapMaybe getTLS (w ^. tempLightSources)
   where

src/Dodge/TestString.hs

@@ -1,5 +1,7 @@
 module Dodge.TestString where
 
+import Dodge.Render.ShapePicture
+import Dodge.Render.Lights
 import Data.Aeson (ToJSON)
 import Data.ByteString.Lazy.Char8 (unpack)
 import qualified Data.Aeson.Encode.Pretty as AEP
@@ -10,7 +12,11 @@ import Dodge.Data.Universe
 --import qualified Data.Map.Strict as M
 --import qualified IntMapHelp as IM
 testStringInit :: Universe -> [String]
-testStringInit u = [show $ u ^? uvWorld . hud . hudElement . diSections . sssExtra . sssSelPos . _Just]
+testStringInit u = [show $ length $ lightsToRender (u ^. uvConfig) (u ^. uvWorld . cWorld . camPos) 
+        (u ^. uvWorld . cWorld . lWorld)
+        , show $ length $ fst $ worldSPic (u ^. uvConfig) (u ^. uvWorld)
+        , show $ length $ snd $ worldSPic (u ^. uvConfig) (u ^. uvWorld) ]
+    --[show $ u ^? uvWorld . hud . hudElement . diSections . sssExtra . sssSelPos . _Just]
 --    [show $ fmap IM.keys $ u ^? uvWorld . hud . hudElement . subInventory . ciSections . sssSections]
 
 getPretty :: ToJSON a => a -> [String]