Minor cleanups

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')

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 

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
 

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
 

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

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
+    g h' (V2 x y) = pairToSV (V3 x y h', black)
-    downps = map f'' ps
+    f (x:xs) = g h x : g 0 x : f xs
-    f (a:as) (b:bs) = a:b:f as bs
+    f _ = []
-    f [] _ = []
-    f _ [] = []
-    f' (V2 x y) = pairToSV (V3 x y h, black)
-    f'' (V2 x y) = pairToSV (V3 x y 0, black)
 
 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)
 

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
+                = newOldChannel & soundStatus  .~ _soundStatus oldS
-                       & soundStatus  .~ _soundStatus oldS
+    | otherwise = newOldChannel
-    | otherwise = newS & soundChannel .~ _soundChannel oldS
+  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,7 +134,8 @@ 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) -> 
+playPositionalSoundQueue chunkMap 
+    = VS.mapM_ ( \(n,a) -> 
                 runMaybeT $ playIfFree (chunkMap IM.! n) Mix.Once >>= setChannelPos a )
     . VS.fromList