Slight cleanup

2021-09-03 10:58:06 +01:00
parent 1bbeb926a5
commit 083000c103
9 changed files with 30 additions and 21 deletions
@@ -8,7 +8,7 @@ module Dodge.Config.Data (
    , volume_sound
    , volume_music
    , wall_textured
-    , shadow_resolution
+    , resolution_factor
    , windowX
    , windowY
    ) where
@@ -23,7 +23,7 @@ data Configuration = Configuration
    , _volume_sound         :: Float
    , _volume_music         :: Float
    , _wall_textured        :: Bool
-    , _shadow_resolution    :: Int -- ^ Higher values divide screen size, i.e. make the resolution worse
+    , _resolution_factor    :: Int -- ^ Higher values divide screen size, i.e. make the resolution worse
    , _windowX              :: Float
    , _windowY              :: Float
    }
@@ -42,7 +42,7 @@ defaultConfig = Configuration
    , _volume_sound         = 1
    , _volume_music         = 1
    , _wall_textured        = False
-    , _shadow_resolution    = 1
+    , _resolution_factor    = 1
    , _windowX              = 800
    , _windowY              = 600
    }
@@ -41,4 +41,4 @@ applyWorldConfig cfig pdata = do
  where
    x = round $ _windowX cfig
    y = round $ _windowY cfig
-    divRes = _shadow_resolution cfig
+    divRes = _resolution_factor cfig
@@ -71,7 +71,7 @@ handleResizeEvent sev w = Just
    x = fromIntegral x'
    y = fromIntegral y'
    V2 x' y' = windowSizeChangedEventSize sev
-    divRes = w ^. config . shadow_resolution
+    divRes = w ^. config . resolution_factor

 handlePressedMouseButton :: MouseButton -> World -> Maybe World
 handlePressedMouseButton but w 
@@ -61,7 +61,7 @@ handlePressedKeyInMenu mState scode w = case mState of
        _               -> popMenu $ w & sideEffects %~ (saveConfig (_config w) :)
    GraphicsOptionMenu -> case scode of
        ScancodeW       -> Just $ w & config . wall_textured     %~ not
-        ScancodeS       -> Just $ updateFramebufferSize $ w & config . shadow_resolution %~ cycleResolution
+        ScancodeS       -> Just $ updateFramebufferSize $ w & config . resolution_factor %~ cycleResolution
        _ -> popMenu $ w & sideEffects %~ (saveConfig (_config w) :)
    ControlList -> Just $ w & menuLayers %~ tail
    _ -> Just w
@@ -93,7 +93,7 @@ updateFramebufferSize w = w & sideEffects
    %~ (pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y : )
  where 
    (x,y) = (round $ getWindowX w, round $ getWindowY w)
-    divRes = w ^. config . shadow_resolution
+    divRes = w ^. config . resolution_factor


 cycleResolution :: (Eq a, Num a, Num p) => a -> p
@@ -295,8 +295,8 @@ withRandomDirI acc f it cr w = f it (cr & crDir +~ a) $ set randGen g w
 withOldDir
    :: Float    -- ^ The fraction of the old direction
    -> ChainEffect
-withOldDir aFrac eff item cr w 
-    = eff item (cr & crDir %~ tweenAngles aFrac (_crOldDir cr)) w
+withOldDir aFrac eff item cr
+    = eff item (cr & crDir %~ tweenAngles aFrac (_crOldDir cr))
 {- | Apply the effect to a translated creature. -}
 withRandomOffsetI
    :: Float    -- ^ Max possible translate
@@ -45,7 +45,8 @@ doDrawing pdata w = do
    let rot     = _cameraRot w
        camzoom    = _cameraZoom w
        trans = _cameraCenter w
-        wins    = V2 (getWindowX w) (getWindowY w)
+        wins@(V2 winx winy)  = V2 (getWindowX w) (getWindowY w)
+        resFact = w ^. config . resolution_factor
        (wallPointsCol,windowPoints) = wallsAndWindows w
        lightPoints     = lightsForGloom w
        viewFroms@(V2 vfx vfy) = _cameraViewFrom w
@@ -70,8 +71,9 @@ doDrawing pdata w = do
        ]
    -- set the coordinate uniform ready for drawing elements using world coordinates
    bufferUBO $ perspectiveMatrixb rot camzoom trans wins viewFroms
-    viewport $= (Position 0 0
-        , divideSize (w ^. config . shadow_resolution) $ Size (round $ fstV2 wins) (round $ sndV2 wins))
+    setViewportSize (round winx `div` resFact) (round winy `div` resFact)
+--    viewport $= (Position 0 0
+--        , divideSize (w ^. config . resolution_factor) $ Size (round $ fstV2 wins) (round $ sndV2 wins))
    bindFramebuffer Framebuffer $= fst (_fboBase pdata)
    clearColor $= Color4 0 0 0 0
    clear [ColorBuffer,DepthBuffer]
@@ -117,8 +119,9 @@ doDrawing pdata w = do
    renderLayer 1 shadV layerCounts
    --depthMask $= Enabled
    --setup downscale viewport for blurring bloom
-    viewport $= (Position 0 0
-        , divideSize (2 * (w ^. config . shadow_resolution)) $ Size (round $ fstV2 wins) (round $ sndV2 wins))
+    setViewportSize (round winx `div` (2*resFact)) (round winy `div` (2*resFact))
+--    viewport $= (Position 0 0
+--        , divideSize (2 * (w ^. config . resolution_factor)) $ Size (round $ fstV2 wins) (round $ sndV2 wins))
    bindFramebuffer Framebuffer $= fst (_fboHalf1 pdata)
    depthFunc $= Just Always
    textureBinding Texture2D $= Just (snd $ _fboBloom pdata)
@@ -126,8 +129,9 @@ doDrawing pdata w = do
    drawShader (_bloomBlurShader pdata) 4
    replicateM_ 5 $ pingPongBetween (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata)
    blend $= Enabled
-    viewport $= (Position 0 0
-        , divideSize (w ^. config . shadow_resolution) $ Size (round $ fstV2 wins) (round $ sndV2 wins))
+    setViewportSize (round winx `div` resFact) (round winy `div` resFact)
+--    viewport $= (Position 0 0
+--        , divideSize (w ^. config . resolution_factor) $ Size (round $ fstV2 wins) (round $ sndV2 wins))
    --draw clouds
    bindFramebuffer Framebuffer $= fst (_fboCloud pdata)
    depthFunc $= Just Lequal
@@ -185,7 +189,8 @@ doDrawing pdata w = do
    textureBinding Texture2D $= Just (fst $ snd $ _fboCloud pdata)
    drawShader (_fullscreenShader pdata) 4
    --set viewport for radial distortion
-    viewport $= (Position 0 0, Size (round $ fstV2 wins) (round $ sndV2 wins))
+    setViewportSize (round winx) (round winy)
+    --viewport $= (Position 0 0, Size (round $ fstV2 wins) (round $ sndV2 wins))
    depthFunc $= Just Always
    blendFunc $= (One,Zero)
    -- perform any radial distortion
@@ -228,6 +233,12 @@ bufferUBO :: [Float] -> IO ()
 bufferUBO mat = withArray mat $ \ptr ->
    bufferSubData UniformBuffer WriteToBuffer 0 64 ptr

+setViewportSize :: Int -> Int -> IO ()
+setViewportSize x y = viewport $= 
+    ( Position 0 0
+    , Size (fromIntegral x) (fromIntegral y)
+    )
+
 renderBlankWalls 
    :: RenderData 
    -> Int -- ^ number of walls
@@ -44,7 +44,7 @@ menuScreen cfig hw hh mLays = case mLays of
        ]
    (GraphicsOptionMenu : _) -> optionsList hw hh "OPTIONS:GRAPHICS" 
        ["W - WALL TEXTURES:" ++ show (_wall_textured cfig)
-        ,"S - SHADOW RESOLUTION:" ++ showShadRes (_shadow_resolution cfig)
+        ,"S - RESOLUTION: 1/" ++ show (_resolution_factor cfig)
        ]
    (ControlList : _) -> pictures 
        [color (withAlpha 0.5 black) $ polygon $ screenBox hw hh
@@ -61,7 +61,6 @@ menuScreen cfig hw hh mLays = case mLays of
    snvol = f $ _volume_sound  cfig
    muvol = f $ _volume_music  cfig
    f x = show (round $ 10 * x :: Int)
-    showShadRes i = "1/"++ show i

 displayStringList :: Float -> Float -> [String] -> Picture
 displayStringList hw hh ss = pictures
@@ -184,7 +184,7 @@ updateCloud w c
        & clTimer -~ 1
        )
  where
-    newVel@(V3 _ _ nvz) = (0.95 *.*.* springVels) +.+.+ (V3 0 0 (0.001 * vertVel))
+    newVel@(V3 _ _ nvz) = (0.95 *.*.* springVels) +.+.+ V3 0 0 (0.001 * vertVel)
    newVel2 = stripZ newVel
    vertVel = _clAlt c - opz
    springVels = foldl' (clClSpringVel c) (_clVel c) (cloudsNearPoint oldPos2 w)
@@ -103,7 +103,6 @@ zoomOutLongGun w
    wpPointer = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
    wp = _crInv (_creatures w IM.! 0) IM.! _crInvSel (_creatures w IM.! 0)
    Just currentZoom = wp ^? itAttachment . scopeZoom
-    --currentCursorDisplacement = fromJust $ _itAttachment wp

 rotCam :: World -> World
 rotCam = rotateCameraL