Cleanup, haddocks

app/Main.hs

@@ -7,7 +7,6 @@ import Dodge.Data
 import Dodge.Initialisation
 import Dodge.Rooms
 import Dodge.Layout
-import Dodge.LoadSound
 import Dodge.Update
 import Dodge.Event
 import Dodge.Render

bench/Bench.hs

@@ -5,13 +5,15 @@ import Dodge.RandomHelp
 import Geometry
 
 import System.Random
+import Control.Monad (replicateM)
+import Data.Functor ((<&>))
 import Control.Monad.State
 import Data.List (zip4)
 
 main :: IO ()
 main = do
     [ps1, ps2, ps3, ps4] <- mapM randomPoints [500,500,500,500]
-    fs <- sequence $ replicate 500 (randomRIO (1,20))
+    fs <- replicateM 500 (randomRIO (1,20))
     defaultMain
         [ bgroup "circLine tests"
             [ bench "circLine" $ nf (map $ uncurry4 circOnLine) (zip4 ps1 ps2 ps3 fs)           
@@ -22,4 +24,4 @@ main = do
 uncurry4 f (a,b,c,d) = f a b c d
 
 randomPoints :: Int -> IO [Point2]
-randomPoints i = getStdGen >>= return . evalState (sequence $ replicate i $ randInCirc 500)
+randomPoints i = getStdGen <&> evalState (replicateM i $ randInCirc 500)

src/Dodge/Creature.hs

@@ -14,6 +14,7 @@ import Dodge.Item.Consumable
 import Dodge.WorldEvent.Cloud
 import Dodge.Creature.YourControl
 import Dodge.Creature.Inanimate
+import Dodge.Item
 
 import Picture
 import Geometry
@@ -255,13 +256,9 @@ startCr = defaultCreature
         [pistol
         ,blinkGun
         ,spawnGun lamp
-        ,flameGrenade
+        ,poisonSprayer
-        ,teslaGrenade
         ,autoGun
         ,launcher
-        ,flameLauncher
-        ,poisonLauncher
-        ,teslaLauncher
         ,lasGun
         ,grenade
         ,ltAutoGun,flamer,multGun,spreadGun,remoteLauncher
@@ -272,7 +269,6 @@ startCr = defaultCreature
         ,miniGun
         ,medkit 50
         ,bezierGun
-        ,poisonSprayer
         ] 
           ++ repeat NoItem)) 
     , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ pictures [color (greyN 0.8) $ circleSolid 10, circLine 10]

src/Dodge/Item/Weapon.hs

@@ -1578,28 +1578,6 @@ jetPack = defaultEquipment
     , _itID = Nothing
     }
 
-latchkey :: Int -> Item
-latchkey n = defaultEquipment
-    { _itIdentity = Generic
-    , _itName = "KEY "++show n
-    , _itMaxStack = 1
-    , _itAmount = 1
-    , _itFloorPict = onLayer FlItLayer $ latchkeyPic
-    , _itEquipPict = \cr _ -> onLayer PtLayer $ translate (-5) (-5) $ rotate (pi/2.5) latchkeyPic
-    , _itEffect = NoItEffect
-    , _itHammer = HammerUp
-    , _itID = Nothing
-    , _itAimingSpeed = 1
-    , _itAimingRange = 0
-    , _itZoom = defaultItZoom
-    , _itInvColor = yellow
-    , _itInvDisplay = _itName
-    }
-latchkeyPic = color yellow $
-              pictures [translate (-4) 0 $ thickCircle 4 2
-                       ,lineOfThickness 2 [(0,0),(8,0),(8,-4)]
-                       ,lineOfThickness 2 [(4,0),(4,-4)]
-                       ]
 
 
 -- }}}

src/Geometry.hs

@@ -90,13 +90,13 @@ errorPointInPolygon !i !p xs
 
 -- | Debug version of 'normalizeV'.
 errorNormalizeV :: Int -> Point2 -> Point2
-errorNormalizeV !i !(0,0) = error $ "problem with function: errorNormalizeV "++show i
+errorNormalizeV !i (0,0) = error $ "problem with function: errorNormalizeV "++show i
 errorNormalizeV !i !p = normalizeV p
 
 -- | Debug version of 'angleVV'.
 errorAngleVV :: Int -> Point2 -> Point2 -> Float
-errorAngleVV !i !(0,0) _ = error $ "problem with function: errorAngleVV "++show i
+errorAngleVV !i (0,0) _ = error $ "problem with function: errorAngleVV "++show i
-errorAngleVV !i _ !(0,0) = error $ "problem with function: errorAngleVV "++show i
+errorAngleVV !i _ (0,0) = error $ "problem with function: errorAngleVV "++show i
 errorAngleVV !i !p !p' = angleVV p p'
 
 -- | Debug version of 'isLHS'.
@@ -126,9 +126,9 @@ isLHS
     -> Bool
 {-# INLINE isLHS #-}
 isLHS 
-    !(x,y)      
+    (x,y)      
-    !(x',y')   
+    (x',y')   
-    !(x'',y'') 
+    (x'',y'') 
     | (x,y) == (x',y')  = False
     | otherwise = a1 * b2 - a2 * b1 > 0
   where 
@@ -146,9 +146,9 @@ isRHS
     -> Bool
 {-# INLINE isRHS #-}
 isRHS 
-    !(x,y)       
+    (x,y)       
-    !(x',y')    
+    (x',y')    
-    !(x'',y'')  
+    (x'',y'')  
     | (x,y) == (x',y')  = False
     | otherwise = a1 * b2 - a2 * b1 < 0
   where 

src/LoadConfig.hs

@@ -8,7 +8,6 @@ import Foreign.C.Types
 import GHC.Generics
 import qualified GHC.Int
 import qualified SDL
-import SDL.Internal.Numbered as SDL.Internal.Numbered
 
 import System.Directory
 

src/Loop.hs

@@ -1,6 +1,6 @@
 {-|
 Module      : Loop
-Description : A minimal game loop
+Description : Minimal game loop
 
 This module sets up an SDL window which may be updated using a simple game loop.
 -}

src/Sound.hs

@@ -1,45 +1,64 @@
+{-|
+Module      : Sound
+Description : Channel selection and storage
+
+This module checks for empty channels and plays sounds on them, using data chunks loaded into an IntMap,
+and sound specifications of type 'Sound' loaded into a Map.
+Uses SDL.Mixer.
+-}
 module Sound
     where
 import Sound.Preload
 
-import Control.Monad
-
 import qualified SDL.Mixer as Mix
-
 import Data.Maybe
 import qualified Data.IntMap as IM
 import qualified Data.Map as M
-
+import Control.Monad
 import Control.Lens
 
+{- | Play sounds from a list of indices.
+Each sound is played once if there is a free channel.
+-}
 playSoundQueue :: SoundData a -> [Int] -> IO ()
 playSoundQueue sd ns = forM_ ns $ \n -> playIfFree (_loadedChunks sd IM.! n) Mix.Once
 
--- this can be cleaned up
+{- | Given a chunk, attempt to play this on a free channel a given number of
+times. Returns 'Just' the channel if succeeds.
+-}
 playIfFree :: Mix.Chunk -> Mix.Times -> IO (Maybe Mix.Channel)
 playIfFree c times = do
     mayChan <- Mix.getAvailable Mix.DefaultGroup
     case mayChan of
         Nothing -> return Nothing
         Just i  -> Just <$> Mix.playOn i times c
-
+{- | Given a chunk and sound specification, play the chunk according to the specification
+if there is a free channel.
+On success return 'Just' an updated sound specification.
+-}
 playSoundIfFree :: Mix.Chunk -> Sound -> IO (Maybe Sound)
 playSoundIfFree c s = case _soundTime s of
-    Just _  -> (playIfFree c Mix.Forever) >>= return . f
+    Just _  -> playIfFree c Mix.Forever >>= return . f
     Nothing -> playIfFree c Mix.Once    >>= return . f
   where 
     f :: Maybe Mix.Channel -> Maybe Sound
-    f = fmap (\chan -> (s & soundChannel .~ Just chan))
+    f = fmap ( \chan -> s & soundChannel ?~ chan)
 
+{- Stop a channel if it was playing.
+Always returns 'IO' 'Nothing'.
+-}
 haltMaybe :: Maybe Mix.Channel -> IO (Maybe Sound)
 haltMaybe (Just x) = Mix.halt x >> return Nothing
 haltMaybe Nothing = return Nothing
 
--- logic: check if sound is playing:
+{- Play a sound according to it's specification.
---   if so, decrement timers, and/or stop playing and remove
+Logic: check if sound is playing:
---   if not, check if there is free channel:
+
---     if so, start playing
+    - If so, decrement timers, and/or stop playing and remove 
---     if not, remove sound
+    - If not, check if there is free channel:
+        - If so, start playing
+        - If not, remove sound.
+-}
 playSound :: SoundData a -> Sound -> IO (Maybe Sound)
 playSound sd s = case _soundChannel s of
     Just i  -> case _soundTime s of
@@ -51,15 +70,22 @@ playSound sd s = case _soundChannel s of
                                     )
     Nothing -> playSoundIfFree (_loadedChunks sd IM.! _soundType s) s
 
+{- Play all sounds and create new sound data.
+ -}
 playSounds :: SoundData a -> IO (SoundData a)
 playSounds sd = do
     newSounds <- mapM (playSound sd) (_playingSounds sd)
     return $ sd & playingSounds .~ M.mapMaybe id newSounds
 
+{- Update sound specifications by overwriting an old Map with a new Map.
+Copies any information about channels from the old Map to the new Map.
+-} 
 updatePlaying :: Ord a => M.Map a Sound -> M.Map a Sound -> M.Map a Sound
 updatePlaying new old = M.unionWith f new old
   where 
     f newSound oldSound = newSound {_soundChannel = _soundChannel oldSound}
 
+{- Start playing new sounds and update sound specifications.
+ -}
 playAndUpdate :: Ord a => M.Map a Sound -> SoundData a -> IO (SoundData a)
 playAndUpdate new sd = playSounds $ over playingSounds (updatePlaying new) sd