diff --git a/src/Dodge/Config/Data.hs b/src/Dodge/Config/Data.hs index 3bc10d12f..969c86392 100644 --- a/src/Dodge/Config/Data.hs +++ b/src/Dodge/Config/Data.hs @@ -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 } diff --git a/src/Dodge/Config/Update.hs b/src/Dodge/Config/Update.hs index 5d23679d4..75c848e70 100644 --- a/src/Dodge/Config/Update.hs +++ b/src/Dodge/Config/Update.hs @@ -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 diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index fc54d7865..a030d7b12 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -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 diff --git a/src/Dodge/Event/Menu.hs b/src/Dodge/Event/Menu.hs index a76f15fec..bbb9fa54e 100644 --- a/src/Dodge/Event/Menu.hs +++ b/src/Dodge/Event/Menu.hs @@ -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 diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 2166b3654..2b2f234e3 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -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 diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index b487f9005..e53605e40 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -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 diff --git a/src/Dodge/Render/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs index 086b9965c..2436225cb 100644 --- a/src/Dodge/Render/MenuScreen.hs +++ b/src/Dodge/Render/MenuScreen.hs @@ -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 diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 4f0ce5cba..f245bf769 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -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) diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index e6a0543dd..1c72acbf5 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -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