From 700ab8d9300897b4eaec90cff29e1882fa13a771 Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 10 Feb 2022 10:50:29 +0000 Subject: [PATCH] Minor cleanups --- src/Dodge/Creature/Impulse/UseItem.hs | 9 +-------- src/Dodge/Update/UsingInput.hs | 3 ++- src/Picture.hs | 10 +++++----- src/Polyhedra.hs | 2 +- src/Render.hs | 6 +++--- src/Shader.hs | 2 +- src/Shape.hs | 15 +++++---------- src/Sound.hs | 15 ++++++++------- 8 files changed, 26 insertions(+), 36 deletions(-) diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index 7592b8453..46c507d23 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -1,6 +1,5 @@ module Dodge.Creature.Impulse.UseItem - ( useItem - , tryUseItem + ( tryUseItem , useLeftItem ) where import Dodge.Data @@ -10,12 +9,6 @@ import qualified Data.IntMap.Strict as IM import Control.Lens import Data.Maybe -useItem :: Int -> World -> World -useItem cid w = tryUseItem cr w -- itemEffect cr it w - where - cr = _creatures w IM.! cid - --it = _crInv cr IM.! _crInvSel cr - tryUseItem :: Creature -> World -> World tryUseItem cr' w = fromMaybe w $ do cr <- w ^? creatures . ix (_crID cr') diff --git a/src/Dodge/Update/UsingInput.hs b/src/Dodge/Update/UsingInput.hs index 99930f308..2748ae8d5 100644 --- a/src/Dodge/Update/UsingInput.hs +++ b/src/Dodge/Update/UsingInput.hs @@ -3,6 +3,7 @@ module Dodge.Update.UsingInput ( updateUsingInput ) where import Dodge.Data +import Dodge.Base.You import Dodge.Creature.Impulse.UseItem import Geometry @@ -17,7 +18,7 @@ updateUsingInput w = if _carteDisplay w updatePressedButtons :: S.Set MouseButton -> World -> World updatePressedButtons pkeys w - | lbPressed && rbPressed = useItem (_yourID w) w + | lbPressed && rbPressed = tryUseItem (you w) w | lbPressed = useLeftItem (_yourID w) w | lbPressed = w | mbPressed = w & clickMousePos .~ _mousePos w diff --git a/src/Picture.hs b/src/Picture.hs index d9e07b835..505306b88 100644 --- a/src/Picture.hs +++ b/src/Picture.hs @@ -54,7 +54,7 @@ polygonWire ps = line (ps ++ [head ps]) polygon :: [Point2] -> Picture {-# INLINE polygon #-} -polygon ps = map f $ polyToTris ps +polygon = map f . polyToTris where f (V2 x y) = Verx (V3 x y 0) black [] 0 polyNum @@ -66,7 +66,7 @@ polygonZ ps z = map (f . zeroZ) $ polyToTris ps polygonCol :: [(Point2,RGBA)] -> Picture {-# INLINE polygonCol #-} -polygonCol vs = polyToTris $ map f vs +polygonCol = polyToTris . map f where f (V2 x y,col) = Verx (V3 x y 0) col [] 0 polyNum @@ -76,7 +76,7 @@ poly3 = poly3Col . map (, black) poly3Col :: [(Point3,RGBA)] -> Picture {-# INLINE poly3Col #-} -poly3Col vs = map f $ polyToTris vs +poly3Col = map f . polyToTris where f (pos,col) = Verx pos col [] 0 polyNum @@ -225,7 +225,7 @@ centerText s = translate (25 * (negate . fromIntegral $ length s)) 0 $ text s text :: String -> Picture {-# INLINE text #-} -text s = map f $ stringToList s +text = map f . stringToList where f (pos,col,V2 a b) = Verx pos col [a,b] 0 textNum @@ -251,7 +251,7 @@ thickLine :: [Point2] -> Float -> Picture {-# INLINE thickLine #-} thickLine ps t = pictures $ f ps where - f (x:y:ys) + f (x:y:ys) | x == y = f (x:ys) | otherwise = polygon [x +.+ n x y, x -.- n x y, y -.- n x y, y +.+ n x y] : f (y:ys) f _ = [] diff --git a/src/Polyhedra.hs b/src/Polyhedra.hs index 4ac416af4..00f911f23 100644 --- a/src/Polyhedra.hs +++ b/src/Polyhedra.hs @@ -119,7 +119,7 @@ polyToPics :: Polyhedra -> [Picture] polyToPics = map helpPoly3D . _pyFaces helpPoly3D :: [(Point3, Point4)] -> Picture -helpPoly3D vs = map f $ polyToTris vs +helpPoly3D = map f . polyToTris where f (pos,col) = Verx pos col [] 0 polyNum diff --git a/src/Render.hs b/src/Render.hs index 5a2272e6a..367243e9b 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -36,9 +36,9 @@ createLightMap -> IO () createLightMap pdata lightPoints nWalls nSils nCaps toPos = do let llsShad = _lightingLineShadowShader pdata - let lcShad = _lightingCapShader pdata - let lwShad = _lightingWallShadShader pdata - let flShad = _fullLightingShader pdata + let lcShad = _lightingCapShader pdata + let lwShad = _lightingWallShadShader pdata + let flShad = _fullLightingShader pdata -- we assume that the renderbuffer's depth has been correctly set elsewhere -- we will not be changing that here depthMask $= Disabled diff --git a/src/Shader.hs b/src/Shader.hs index 0b8adc591..d0564ecc7 100644 --- a/src/Shader.hs +++ b/src/Shader.hs @@ -50,7 +50,7 @@ drawShader fs i = do (fromIntegral i) freeShaderPointers :: FullShader -> IO () -freeShaderPointers fs = free $ _vboPtr $ _vaoVBO $ _shadVAO fs +freeShaderPointers = free . _vboPtr . _vaoVBO . _shadVAO pokeBindFoldable :: MV.MVector (PrimState IO) FullShader diff --git a/src/Shape.hs b/src/Shape.hs index dc855236e..8d7acc115 100644 --- a/src/Shape.hs +++ b/src/Shape.hs @@ -55,16 +55,12 @@ upperPrismPoly -> [Point2] -> Shape {-# INLINE upperPrismPoly #-} -upperPrismPoly h ps = [ShapeObj (TopPrism n) (f upps downps)] +upperPrismPoly h ps = [ShapeObj (TopPrism n) (f ps)] where n = length ps - upps = map f' ps - downps = map f'' ps - f (a:as) (b:bs) = a:b:f as bs - f [] _ = [] - f _ [] = [] - f' (V2 x y) = pairToSV (V3 x y h, black) - f'' (V2 x y) = pairToSV (V3 x y 0, black) + g h' (V2 x y) = pairToSV (V3 x y h', black) + f (x:xs) = g h x : g 0 x : f xs + f _ = [] upperPrismPolyHalf :: Float -- ^ height, expected to be strictly positive @@ -77,8 +73,7 @@ upperPrismPolyHalf h ps = [ShapeObj (TopPrism n) (f upps downps)] upps = map f' ps downps = map f'' ps f (a:as) (b:bs) = a:b:f as bs - f [] _ = [] - f _ [] = [] + f _ _ = [] f' (V2 x y) = pairToSV (V3 (0.5 * x) (0.5 * y) h, black) f'' (V2 x y) = pairToSV (V3 x y 0, black) diff --git a/src/Sound.hs b/src/Sound.hs index 38459794a..1168364c0 100644 --- a/src/Sound.hs +++ b/src/Sound.hs @@ -56,9 +56,10 @@ playSoundAndUpdate sData oldSounds newSounds mergeSound :: Sound -> Sound -> Sound mergeSound oldS newS | _soundChunkID newS == _soundChunkID oldS && _soundStatus newS == ToContinueStart - = newS & soundChannel .~ _soundChannel oldS - & soundStatus .~ _soundStatus oldS - | otherwise = newS & soundChannel .~ _soundChannel oldS + = newOldChannel & soundStatus .~ _soundStatus oldS + | otherwise = newOldChannel + where + newOldChannel = newS & soundChannel .~ _soundChannel oldS updateSounds :: IM.IntMap Mix.Chunk -> M.Map a Sound -> IO (M.Map a Sound) updateSounds sd ss = do @@ -95,7 +96,7 @@ tryGetChannel s = case _soundChannel s of decrementTimer :: Sound -> IO Sound decrementTimer s = case _soundTime s of Just t - | t > 0 -> return $ s & soundTime ?~ t - 1 + | t > 0 -> return $ s & soundTime . _Just -~ 1 | otherwise -> do forM_ (_soundChannel s) Mix.halt return $ s & soundTime .~ Nothing @@ -120,7 +121,6 @@ cleanupHalted s = do For each index, the corresponding sound starts playing if there is a free channel. Use this if you don't care about timing, overlapping, fading, or sound positions. -} playSoundQueue :: IM.IntMap Mix.Chunk -> [Int] -> IO () ---playSoundQueue chunkMap ns = forM_ ns $ \n -> runMaybeT $ playIfFree (chunkMap IM.! n) Mix.Once playSoundQueue chunkMap = mapM_ $ \n -> runMaybeT $ playIfFree (chunkMap IM.! n) Mix.Once {- | Given a chunk, attempt to play this on a free channel a given number of @@ -134,8 +134,9 @@ playIfFree c times = do {- | Play sounds from a list of index/position pairs. As for 'playSoundQueue', but with positional information in the form of an Int16. -} playPositionalSoundQueue :: IM.IntMap Mix.Chunk -> [(Int,Int16)] -> IO () -playPositionalSoundQueue chunkMap = VS.mapM_ ( \(n,a) -> - runMaybeT $ playIfFree (chunkMap IM.! n) Mix.Once >>= setChannelPos a ) +playPositionalSoundQueue chunkMap + = VS.mapM_ ( \(n,a) -> + runMaybeT $ playIfFree (chunkMap IM.! n) Mix.Once >>= setChannelPos a ) . VS.fromList setChannelPos :: Int16 -> Mix.Channel -> MaybeT IO Mix.Channel