Clear all warnings

app/Main.hs

@@ -1,8 +1,6 @@
 module Main where
 import Loop
-import Shader
 import LoadConfig
-import Dodge.Default
 import Dodge.Data
 import Dodge.Initialisation
 import Dodge.Update
@@ -21,11 +19,10 @@ import Preload
 import Sound.Data
 import Music
 
-import Control.Concurrent
 import Control.Lens
-import Foreign (Word32)
+--import Foreign (Word32)
 import Control.Monad
-import System.Random
+--import System.Random
 import qualified Data.Map                  as M
 import qualified Data.IntMap               as IM
 import Graphics.Rendering.OpenGL hiding (color, rotate, scale, translate)
@@ -35,20 +32,20 @@ import qualified SDL.Mixer                 as Mix
 main :: IO ()
 main = do
     (sizex,sizey) <- loadConfig
-    keyConfig <- loadKeyConfig
+    theKeyConfig <- loadKeyConfig
     dodgeConfig <- loadDodgeConfig
     setupLoop
         (sizex,sizey)
         (SDL.cursorVisible $= False >> doPreload >>= applyWorldConfig dodgeConfig)
         (\x -> (SDL.cursorVisible $= True) >> cleanUpPreload x)
-        (fmap (setWindowSize sizex sizey keyConfig . (config .~ dodgeConfig)) firstWorld)
+        (fmap (setWindowSize sizex sizey theKeyConfig . (config .~ dodgeConfig)) firstWorld)
         doSideEffects
         handleEvent
         (Just . update)
 
 doSideEffects :: PreloadData SoundOrigin -> World -> IO (PreloadData SoundOrigin)
 doSideEffects preData w = do
-    startTicks <- SDL.ticks
+    --startTicks <- SDL.ticks
     void $ doDrawing (_renderData preData) w
     playPositionalSoundQueue (_loadedChunks $ _soundData preData) (_soundQueue w)
     newPlayingSounds <- playAndUpdate (_soundData preData) (_sounds w)

src/Dodge/Creature/Action/UseItem.hs

@@ -1,13 +1,11 @@
 module Dodge.Creature.Action.UseItem
     where
 import Dodge.Data
-
 import Dodge.Inventory
 
 import qualified Data.IntMap as IM
-
 import Control.Lens
-import Data.Maybe (maybe)
+--import Data.Maybe (maybe)
 
 useItem :: Int -> World -> World
 useItem n w = itemEffect n it w

src/Dodge/Creature/ChooseTarget.hs

@@ -5,7 +5,7 @@ import Dodge.Base
 import Dodge.Creature.AlertLevel.Data
 
 import Control.Lens
-import qualified Data.IntMap.Strict as IM
+--import qualified Data.IntMap.Strict as IM
 
 targetYouLOS :: Creature -> World -> Maybe Creature
 {-# INLINE targetYouLOS #-}

src/Dodge/Creature/Rationality.hs

@@ -184,13 +184,13 @@ performAction cr w ac = case ac of
     UseAheadPos f -> performAction cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
     ArbitraryAction f -> performAction cr w (f cr w)
     DoImpulsesAlongside sideImp mainAc -> case performAction cr w mainAc of
-        (imp, Just ac) -> (sideImp ++ imp, Just $ DoImpulsesAlongside sideImp ac)
+        (imp, Just nxtac) -> (sideImp ++ imp, Just $ DoImpulsesAlongside sideImp nxtac)
         (imp, _) -> (sideImp ++ imp, Nothing)
-    DoReplicate t ac -> performAction cr w $ DoReplicatePartial ac t ac
+    DoReplicate t nxtac -> performAction cr w $ DoReplicatePartial nxtac t nxtac
-    DoReplicatePartial _  0 ac' -> performAction cr w ac'
+    DoReplicatePartial _  0 pac -> performAction cr w pac
-    DoReplicatePartial ac t ac' -> case performAction cr w ac' of
+    DoReplicatePartial sac t pac -> case performAction cr w pac of
-        (imps , Just ac'') -> (imps, Just $ DoReplicatePartial ac t ac'')
+        (imps , Just nac) -> (imps, Just $ DoReplicatePartial sac t nac)
-        (imps , _)         -> (imps, Just $ DoReplicatePartial ac (t-1) ac)
+        (imps , _)         -> (imps, Just $ DoReplicatePartial sac (t-1) sac)
     _ -> ([], Nothing)
   where
     cpos = _crPos cr 

src/Dodge/Creature/Test.hs

@@ -25,7 +25,7 @@ onBoth :: (a -> b -> c) -> (d -> a) -> (d -> b) -> d -> c
 onBoth f g h x = f (g x) (h x)
 
 crIsReloading :: (World, Creature) -> Bool
-crIsReloading (w,cr) = case cr ^? crInv . ix (_crInvSel cr) . wpReloadState of
+crIsReloading (_,cr) = case cr ^? crInv . ix (_crInvSel cr) . wpReloadState of
     Just t -> t > 0
     _ -> False
 
@@ -69,12 +69,12 @@ crHasTargetLOSR cr = reader $ \w -> case cr ^? crTarget . _Just of
     Nothing -> False
 
 crSafeDistFromTarg :: Float -> (World,Creature) -> Bool
-crSafeDistFromTarg d (w,cr) = case cr ^? crTarget . _Just of
+crSafeDistFromTarg d (_,cr) = case cr ^? crTarget . _Just of
     Just tcr -> dist (_crPos cr) (_crPos tcr) > d
     Nothing -> True
 
 crSafeDistFromTargR :: Float -> Creature -> Reader World Bool
-crSafeDistFromTargR d cr = reader $ \w -> case cr ^? crTarget . _Just of
+crSafeDistFromTargR d cr = return $ case cr ^? crTarget . _Just of
     Just tcr -> dist (_crPos cr) (_crPos tcr) > d
     Nothing -> True
 
@@ -86,16 +86,16 @@ crStratConMatchesR strat cr = return $ eqConstr strat (_crStrategy $ _crActionPl
 
 crAwayFromPost :: (World,Creature) -> Bool
 crAwayFromPost (_,cr) = case find sentinelGoal $ _crGoal $ _crActionPlan cr of
-    Just (SentinelAt p dir) -> dist p (_crPos cr) > 15
+    Just (SentinelAt p _) -> dist p (_crPos cr) > 15
     _ -> False
   where
-    sentinelGoal (SentinelAt p dir) = True
+    sentinelGoal (SentinelAt _ _) = True
     sentinelGoal _ = False
 
 crAwayFromPostR :: Creature -> Reader World Bool
 crAwayFromPostR cr = return $ case find sentinelGoal $ _crGoal $ _crActionPlan cr of
-    Just (SentinelAt p dir) -> dist p (_crPos cr) > 15
+    Just (SentinelAt p _) -> dist p (_crPos cr) > 15
     _ -> False
   where
-    sentinelGoal (SentinelAt p dir) = True
+    sentinelGoal (SentinelAt _ _) = True
     sentinelGoal _ = False

src/Dodge/Layout/Tree/GenerateStructure.hs

@@ -10,17 +10,11 @@ import Dodge.RandomHelp
 import Data.Tree
 import Control.Monad.State
 import System.Random
-
+{- Single branched tree (a trunk).  -}
-{-
-Single branched tree (a trunk).
--}
 treePath :: Int -> Tree ()
 treePath 0 = Node () []
 treePath x = Node () [treePath (x-1)]
-
+{- Adds a branch at a certain point down a trunk.  -}
-{-
-Adds a branch at a certain point down a trunk.
--}
 addBranchAt 
     :: Int      -- ^ Depth to add branch at
     -> Tree ()  -- ^ Branch to add
@@ -29,10 +23,8 @@ addBranchAt
 addBranchAt 0 b (Node () xs) = Node () (xs ++ [b])
 addBranchAt i b (Node () (x:xs))
     = Node () (addBranchAt (i-1) b x : xs)
-
+addBranchAt _ _ _ = error "Trying to add a branch too far along a tree"
-{-
+{- Randomly generate a tree containing a maximum of three nodes.  -}
-Randomly generate a tree containing a maximum of three nodes.
--}
 smallBranch :: RandomGen g => State g (Tree ())
 smallBranch = takeOne
     [ treePath 0

src/Dodge/Layout/Tree/Polymorphic.hs

@@ -40,6 +40,8 @@ Applies a function to the root of a tree.
 applyToRoot :: (a -> a) -> Tree a -> Tree a
 applyToRoot f (Node t ts) = Node (f t) ts
 
+-- | Consider defining this using generalised recursion patterns
+treeSize :: Tree a -> Int
 treeSize = length . flatten
 
 {- |
@@ -72,7 +74,7 @@ treeChildNums :: Tree a -> Tree Int
 treeChildNums = setRoot 0
   where 
     setRoot :: Int -> Tree a -> Tree Int
-    setRoot i (Node x xs) = Node i (zipWith setRoot [0..] xs)
+    setRoot i (Node _ xs) = Node i (zipWith setRoot [0..] xs)
 
 {- |
 Makes each node into its path, i.e. the list of indices that, 
@@ -109,7 +111,7 @@ Find the depth of a tree along the trunk.
 -}
 trunkDepth :: Tree a -> Int
 trunkDepth (Node _ []) = 0
-trunkDepth (Node _ (x:xs)) = trunkDepth x + 1
+trunkDepth (Node _ (x:_)) = trunkDepth x + 1
 
 {- |
 Split a tree at a given point along its trunk.
@@ -121,6 +123,7 @@ splitTrunkAt 0 (Node x xs) = (Node x [],xs)
 splitTrunkAt i (Node y (x:xs)) = 
     let (t, ts) = splitTrunkAt (i-1) x
     in (Node y (t : xs) , ts)
+splitTrunkAt _ (Node _ []) = error "Trying to split to short a trunk"
 
 {- |
 Split a tree at a random point along its trunk.

src/Dodge/RandomHelp.hs

@@ -3,7 +3,7 @@ Helpers for random generation.
 -}
 module Dodge.RandomHelp where
 import Geometry
-import Geometry.Data
+--import Geometry.Data
 
 import System.Random
 import Control.Monad.State
@@ -20,15 +20,15 @@ takeOne xs = state (randomR (0,length xs - 1)) >>= (\i -> return (xs !! i))
 
 takeOneWeighted :: (RandomGen g, Random b, Ord b, Num b) => [b] -> [a] -> State g a
 takeOneWeighted ws xs = state (randomR (0, sum ws))
-                            >>= (\w -> return (xs !! i w ws))
+    >>= (\w -> return (xs !! i w ws))
   where 
     i y (z:zs) 
         | y <= z = 0
         | otherwise = 1 + i (y-z) zs
-    i y _ = 0
+    i _ _ = 0
 
 takeOneMore :: RandomGen g => ([a],[a]) -> State g ([a],[a])
-takeOneMore (xs,[]) = error "trying to takeOneMore from empty list"
+takeOneMore ( _,[]) = error "trying to takeOneMore from empty list"
 takeOneMore (xs,ys) = do
     i <- state $ randomR (0,length ys - 1)
     let (zs, w:ws) = splitAt i ys
@@ -38,7 +38,7 @@ takeNMore :: RandomGen g => Int -> ([a],[a]) -> State g ([a],[a])
 takeNMore n p = foldr (const (>>= takeOneMore)) (return p) [1..n]
 
 takeN :: RandomGen g => Int -> [a] -> State g [a]
-takeN 0 xs = return []
+takeN 0  _ = return []
 takeN i xs = fst <$> takeNMore i ([],xs)
 
 -- | Randomly shuffle a list.
@@ -54,6 +54,7 @@ shuffle xs = do
 -- | Randomly shuffle the tail of a list, not safe.
 shuffleTail :: RandomGen g => [a] -> State g [a]
 shuffleTail (x:xs) = (x :) <$> shuffle xs
+shuffleTail _ = undefined
 
 randomSelectionFromList :: RandomGen g => Float -> [a] -> State g [a]
 randomSelectionFromList p = filterM $ const $ randProb p

src/Dodge/Render/PerspectiveMatrix.hs

@@ -24,11 +24,11 @@ perspectiveMatrix rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy) =
                 (V4 (sin rot) (cos rot)    0 0)
                 (V4 0             0        1 0)
                 (V4 0             0        0 1)
-        tranMat3 = Linear.Matrix.transpose $
+        --tranMat3 = Linear.Matrix.transpose $
-            V4 (V4 1        0        0 0)
+        --    V4 (V4 1        0        0 0)
-                (V4 0        1        0 0)
+        --        (V4 0        1        0 0)
-                (V4 0        0        1 0)
+        --        (V4 0        0        1 0)
-                (V4 (-tranx) (-trany) 0 1)
+        --        (V4 (-tranx) (-trany) 0 1)
         tranMat2 = Linear.Matrix.transpose $
             V4 (V4 1        0        0 0)
                 (V4 0        1        0 0)

src/Dodge/Update/UsingInput.hs

@@ -18,30 +18,30 @@ updateUsingInput w =
     else updatePressedButtons (_mouseButtons w) w
 
 updatePressedButtons :: S.Set MouseButton -> World -> World
-updatePressedButtons keys w 
+updatePressedButtons pkeys w 
     | lbPressed && rbPressed 
                 = useItem (_yourID w) w
     | mbPressed = w & clickMousePos .~ _mousePos w 
                     & cameraRot     -~ rotation
     | otherwise = w
   where 
-    lbPressed = ButtonLeft `S.member` keys
+    lbPressed = ButtonLeft `S.member` pkeys
-    rbPressed = ButtonRight `S.member` keys
+    rbPressed = ButtonRight `S.member` pkeys
-    mbPressed = ButtonMiddle `S.member` keys
+    mbPressed = ButtonMiddle `S.member` pkeys
     rotation  = angleBetween (_mousePos w) (_clickMousePos w)
 
 updatePressedButtonsCarte :: S.Set MouseButton -> World -> World
-updatePressedButtonsCarte keys w 
+updatePressedButtonsCarte pkeys w 
     | rbPressed = w & clickMousePos .~ _mousePos w 
                     & carteCenter   %~ (-.- trans)
     | lbPressed = w & clickMousePos .~ _mousePos w 
                     & carteRot      -~ rot
-                    & carteZoom     *~ zoom
+                    & carteZoom     *~ czoom
     | otherwise = w
   where 
-    lbPressed = ButtonLeft `S.member` keys
+    lbPressed = ButtonLeft `S.member` pkeys
-    rbPressed = ButtonRight `S.member` keys
+    rbPressed = ButtonRight `S.member` pkeys
-    mbPressed = ButtonMiddle `S.member` keys
+    --mbPressed = ButtonMiddle `S.member` pkeys
     rot     = angleBetween (_mousePos w) (_clickMousePos w)
-    zoom    = magV (_mousePos w) / magV (_clickMousePos w)
+    czoom    = magV (_mousePos w) / magV (_clickMousePos w)
     trans   = rotateV (_carteRot w) $ (1 / _carteZoom w) *.* (_mousePos w -.- _clickMousePos w)

src/Geometry.hs

@@ -24,7 +24,7 @@ import Geometry.Vector
 import Data.Function
 import Data.List
 import Data.Maybe
-import Control.Applicative
+--import Control.Applicative
 -- | Return a point a distance away from a first point towards a second point.
 -- Does not go past the second point.
 alongSegBy :: Float -> Point2 -> Point2 -> Point2
@@ -68,11 +68,12 @@ rectWdthHght w h = rectNSWE h (-h) (-w) w
 -- polygon are listed in anticlockwise order.
 pointInOrOnPolygon :: Point2 -> [Point2] -> Bool
 pointInOrOnPolygon !p (x:xs) = all (\l -> not (uncurry isRHS l p)) $ zip (x:xs) (xs ++ [x])
+pointInOrOnPolygon _ _ = undefined
 -- | Test whether a point is strictly inside a polygon.
 -- Supposes the points in the polygon are listed in anticlockwise order.
 pointInPolygon :: Point2 -> [Point2] -> Bool
-pointInPolygon !p [] = False
 pointInPolygon !p (x:xs) = all (\l -> uncurry (errorIsLHS 1) l p) $ zip (x:xs) (xs ++ [x])
+pointInPolygon _ [] = False
 -- | Debug version of 'pointInPolygon'.
 errorPointInPolygon :: Int -> Point2 -> [Point2] -> Bool
 errorPointInPolygon !i !p xs 
@@ -83,12 +84,12 @@ 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 !p = normalizeV p
+errorNormalizeV _ !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 !p !p' = angleVV p p'
+errorAngleVV _  !p !p' = angleVV p p'
 -- | Debug version of 'isLHS'.
 errorIsLHS :: Int -> Point2 -> Point2 -> Point2 -> Bool
 errorIsLHS !i !x !y 
@@ -101,9 +102,9 @@ errorClosestPointOnLine !i !x !y
     | otherwise = closestPointOnLine x y
 -- | Debug version of 'closestPointOnLineParam'
 errorClosestPointOnLineParam :: Int -> Point2 -> Point2 -> Point2 -> Float
-errorClosestPointOnLineParam  !i !x! y! z 
+errorClosestPointOnLineParam  _ !x! y! z 
     | x == y    = dist x z
-    | otherwise = closestPointOnLineParam  x y z
+    | otherwise = closestPointOnLineParam x y z
 -- | Test whether a point is on the LHS of a line.
 -- Returns False if the line is of zero length.
 isLHS 
@@ -250,9 +251,6 @@ diffAngles x y
     | otherwise  = diffAngles (x + 2*pi) y
   where 
     diff = x-y
-
-differenceAngles = diffAngles
-angleDifference = diffAngles
 -- | Given a triangle where we know the length of a first side,
 -- the length of a second side, and the angle between the first side and the
 -- third side, finds the length of the third side.
@@ -358,7 +356,7 @@ divideLine x a b = take 5000
   where 
     d = dist a b
     numPoints = max 1 $ ceiling $ d / x
-    ns = [0 .. numPoints]
+    ns = [0 :: Int .. numPoints]
 -- | As 'divideLine', but must return an odd number of points.
 divideLineOddNumPoints :: Float -> Point2 -> Point2 -> [Point2]
 --divideLine x a b = map (\i -> a +.+ (i / (fromIntegral numPoints)) *.* (b -.- a)) 
@@ -371,7 +369,7 @@ divideLineOddNumPoints x a b = take 5000
     numPoints
         | even numPoints' = numPoints'
         | otherwise       = numPoints' + 1
-    ns = [0 .. numPoints]
+    ns = [0 .. numPoints] :: [Int]
 -- | Given two pairs of Ints, returns a list of pairs of Ints that form 
 -- a digital line between them.
 digitalLine :: (Int,Int) -> (Int,Int) -> [(Int,Int)]
@@ -386,7 +384,7 @@ digitalLine (x1,y1) (x2,y2)
         | y <- intervalList y1 y2 
         ]
   where 
-    rdiv a b = round $ fromIntegral a / fromIntegral b
+    rdiv a b = round $ fromIntegral a / (fromIntegral b :: Float)
 -- | Given two pairs of 'Int's, create a list of pairs of 'Int's that form a
 -- rectangle between them.
 digitalRect :: (Int,Int) -> (Int,Int) -> [(Int,Int)]
@@ -447,7 +445,7 @@ arcStepwisePositive ssize a cen v = (cen +.+) . (`rotateV` v) <$> rots
 -- loop.
 makeLoopPairs :: [Point2] -> [(Point2,Point2)]
 makeLoopPairs [] = error "tried to make loop with empty list of points"
-makeLoopPairs [x] = error "tried to make loop with singleton list of points"
+makeLoopPairs [_] = error "tried to make loop with singleton list of points"
 makeLoopPairs (x:xs) = zip (x:xs) (xs ++ [x])
 -- | Test whether a point is in a cone.
 -- Note the pair is ordered.

src/Geometry/Intersect.hs

@@ -8,7 +8,6 @@ import Geometry.Data
 import Control.Applicative
 
 import Data.Maybe (isNothing)
-
 -- | If two lines intersect, return 'Just' that point.
 intersectLineLine' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
 {-# INLINE intersectLineLine' #-}
@@ -18,7 +17,6 @@ intersectLineLine' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
   where 
     den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
     t'  = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
-
 -- | If two segments intersect, return 'Just' that point.
 intersectSegSeg' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
 {-# INLINE intersectSegSeg' #-}
@@ -33,7 +31,6 @@ intersectSegSeg' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
     den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
     t'  = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
     u'  = (y1-y2)*(x1-x3) - (x1-x2)*(y1-y3)
-
 -- | Intended to intersect a segment with a half-line-segment, ie a segment
 -- extending infinitely in one direction.
 intersectSegLineFrom' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
@@ -49,7 +46,6 @@ intersectSegLineFrom' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
     den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
     t'  = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
     u'  = (y1-y2)*(x1-x3) - (x1-x2)*(y1-y3)
-
 -- | Similar to 'intersectSegLineFrom'', but this version is probably not correct...
 intersectSegLineext :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
 {-# INLINE intersectSegLineext #-}
@@ -64,7 +60,6 @@ intersectSegLineext (x1,y1) (x2,y2) (x3,y3) (x4,y4)
     den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
     t'  = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
     u'  = (y1-y2)*(x1-x3) - (x1-x2)*(y1-y3)
-
 -- | Intersect a segment with a line.
 intersectSegLine' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
 {-# INLINE intersectSegLine' #-}
@@ -78,8 +73,7 @@ intersectSegLine' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
   where 
     den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
     t'  = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
-    u'  = (y1-y2)*(x1-x3) - (x1-x2)*(y1-y3)
+    --u'  = (y1-y2)*(x1-x3) - (x1-x2)*(y1-y3)
-
 -- | Due to floating point issues, 'intersectSegSeg'' is not always 
 -- accurate---'myIntersectSegSeg'
 -- fixes at least some of
@@ -87,20 +81,25 @@ intersectSegLine' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
 -- intersection.
 -- This version is, probably, slower---both testing and benchmarking should be
 -- done.
+myIntersectSegSeg 
+    :: Point2
+    -> Point2
+    -> Point2
+    -> Point2
+    -> Maybe Point2
 myIntersectSegSeg a@(ax,ay) b@(bx,by) c@(cx,cy) d@(dx,dy) = case ratIntersectLineLine a b c d of
-        Nothing    -> Nothing
+    Nothing    -> Nothing
-        Just (x,y) -> if inbetween x && inbetween' y 
+    Just (x,y) -> if inbetween x && inbetween' y 
-                        then Just (x,y)
+        then Just (x,y)
-                        else Nothing
+        else Nothing
   where 
     inbetween  x = ((ax <= x && x <= bx) || (bx <= x && x <= ax)) 
         &&  ((cx <= x && x <= dx) || (dx <= x && x <= cx))
     inbetween' y = ((ay <= y && y <= by) || (by <= y && y <= ay)) 
         &&  ((cy <= y && y <= dy) || (dy <= y && y <= cy))
-
 -- | Polymorphic intersection of fractional line points.
 myIntersectLineLine :: (Eq a,Fractional a) => (a,a) -> (a,a) -> (a,a) -> (a,a) -> Maybe (a,a)
-myIntersectLineLine a@(ax,ay) b c@(cx,cy) d
+myIntersectLineLine a@(ax,_) b c@(cx,_) d
     | isNothing (linGrad a b) = (ax ,) <$> axisInt (c *-* (ax,0)) (d *-* (ax,0))
     | isNothing (linGrad c d) = (cx ,) <$> axisInt (a *-* (cx,0)) (b *-* (cx,0))
     | otherwise              
@@ -113,8 +112,7 @@ myIntersectLineLine a@(ax,ay) b c@(cx,cy) d
     (^/^) = liftA2 (/)
     (^*^) = liftA2 (*)
     newx  = (axisInt c d ^-^ axisInt a b) ^/^ (linGrad a b ^-^ linGrad c d)
-    (*-*) (ax,ay) (bx,by) = (ax-bx,ay-by)
+    (*-*) (ax',ay) (bx,by) = (ax'-bx,ay-by)
-
 -- | Transforms floating points to rationals then performs line intersection.
 ratIntersectLineLine :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
 ratIntersectLineLine a b c d = toNumPoint2 
@@ -122,8 +120,6 @@ ratIntersectLineLine a b c d = toNumPoint2
   where 
     toRatPoint2 (x,y) = (toRational x, toRational y)
     toNumPoint2 (x,y) = (fromRational x, fromRational y)
-    f = toRatPoint2 . roundPoint2
-
 {- | Round the floats within a 'Point2' to the nearest integer.
 __Examples__
 Rounding jumps after intervals of .5:
@@ -138,24 +134,21 @@ but is symmetric around 0:
 
 -}
 roundPoint2 :: Point2 -> Point2
-roundPoint2 (x,y) = (fromIntegral $ round x,fromIntegral $ round y)
+roundPoint2 (x,y) = (fromIntegral $ (round x :: Int),fromIntegral $ (round y :: Int))
-
 -- | Given two points, finds the linear gradient if it is non-infinite.
 linGrad :: (Eq a,Fractional a) => (a,a) -> (a,a) -> Maybe a
-linGrad (x,y) (a,b) | x-a == 0  = Nothing
+linGrad (x,y) (a,b) 
-                    | otherwise = Just $ (y-b)/(x-a)
+    | x-a == 0  = Nothing
-
+    | otherwise = Just $ (y-b)/(x-a)
 -- | Given two points, finds the intersection with the y axis if it exists.
 axisInt :: (Eq a,Fractional a) => (a,a) -> (a,a) -> Maybe a
 axisInt p (a,b) =  pure b ^-^ (pure a ^*^ linGrad p (a,b))
-    where (^-^) = liftA2 (-)
+  where 
-          (^*^) = liftA2 (*)
+    (^-^) = liftA2 (-)
-
+    (^*^) = liftA2 (*)
 -- | Placeholder, undefined.
 intersectSegsSeg :: [Point2] -> Point2 -> Point2 -> Maybe Point2
 intersectSegsSeg = undefined
-
 -- | Placeholder: should intersect a segment with a bezier curve.
 intersectSegBezquad :: Point2 -> Point2 -> Point2 -> Point2 -> Point2 -> [Point2]
 intersectSegBezquad = undefined
-

src/Geometry/Vector.hs

@@ -174,7 +174,7 @@ safeNormalizeV p = (1/magV p ) *.* p
  -}
 magV :: Point2 -> Float
 {-# INLINE magV #-}
-magV (x,y) = sqrt $ x^2 + y^2
+magV (x,y) = sqrt $ x^(2::Int) + y^(2::Int)
 
 {- | Magnitude of the cross product of two vectors.
 Identical to detV.

src/LoadConfig.hs

@@ -1,15 +1,12 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE OverloadedStrings #-}
-
 module LoadConfig where
-
 import Data.Aeson
-import Foreign.C.Types
+--import Foreign.C.Types
 import GHC.Generics
-import qualified GHC.Int
+--import qualified GHC.Int
-import qualified SDL
+--import qualified SDL
-
+--import System.Directory
-import System.Directory
 
 data Configuration = Configuration
   { windowxsize :: Int,

src/Loop.hs

@@ -12,12 +12,10 @@ import Control.Concurrent
 import Control.Exception
 import Control.Monad
 import System.Mem
-import Foreign.C
+--import Foreign.C
 import SDL
 import qualified Graphics.Rendering.OpenGL as GL
-
+--import Control.Lens ((.~),(&),(+~))
-import Control.Lens ((.~),(&),(+~))
-
 -- | Create a game loop with an SDL window.
 setupLoop
     :: (Int,Int)            -- ^ The window size.
@@ -78,19 +76,12 @@ doLoop
             performGC
             endTicks <- ticks -- it might be better to use System.Clock (monotonic)
 
-            let delay = max 0 (20 + fromIntegral startTicks - fromIntegral endTicks)
+            let theDelay = max 0 (20 + fromIntegral startTicks - fromIntegral endTicks)
-            threadDelay (delay * 1000 )
+            threadDelay (theDelay * 1000 )
 
             doLoop window updatedWorld worldSideEffects eventFn worldUpdate newParams
         Nothing -> return ()
 
-applyEventsIO 
-    :: (world -> Event -> Maybe world)
-    -> world
-    -> [Event]
-    -> IO (Maybe world)
-applyEventsIO fn w = foldM (applyEventIO fn) (Just w)
-
 -- | Handle quit events in a manner to exit the loop. Other events handled as
 -- determined by the custom function, although resize events also change the viewport.
 applyEventIO :: (world -> Event -> Maybe world) -> Maybe world -> Event -> IO (Maybe world)

src/MatrixHelper.hs

@@ -18,11 +18,11 @@ perspectiveMatrix rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy) =
                 (V4 (sin rot) (cos rot)    0 0)
                 (V4 0             0        1 0)
                 (V4 0             0        0 1)
-        tranMat3 = Linear.Matrix.transpose $
+        --tranMat3 = Linear.Matrix.transpose $
-            V4 (V4 1        0        0 0)
+        --    V4 (V4 1        0        0 0)
-                (V4 0        1        0 0)
+        --        (V4 0        1        0 0)
-                (V4 0        0        1 0)
+        --        (V4 0        0        1 0)
-                (V4 (-tranx) (-trany) 0 1)
+        --        (V4 (-tranx) (-trany) 0 1)
         tranMat2 = Linear.Matrix.transpose $
             V4 (V4 1        0        0 0)
                 (V4 0        1        0 0)

src/Picture.hs

@@ -46,16 +46,13 @@ module Picture
     )
   where
 import Geometry
-import Geometry.Data
+--import Geometry.Data
-
 import Picture.Data
 
-import Data.Bifunctor
+--import Data.Bifunctor
-import qualified Data.DList as DL
+--import qualified Data.DList as DL
-
+--import Graphics.Rendering.OpenGL (lineWidth, ($=))
-import Graphics.Rendering.OpenGL (lineWidth, ($=))
+--import Control.Lens
-
-import Control.Lens
 
 black :: RGBA
 black = (0,0,0,1)
@@ -205,11 +202,19 @@ thickCircle :: Float -> Float -> Picture
 {-# INLINE thickCircle #-}
 thickCircle = thickArc 0 (2*pi)
 
-arcSolid :: Float -> Float -> Float -> Picture
+arcSolid
+    :: Float -- ^ Start angle
+    -> Float -- ^ End angle
+    -> Float -- ^ Radius
+    -> Picture
 {-# INLINE arcSolid #-}
-arcSolid startA endA rad
+arcSolid startA endA rad = polygon $ (0,0) : makeArc rad (startA,endA)
-    = polygon $ (0,0) : makeArc rad (startA,endA)
 
+arc
+    :: Float -- ^ Start angle
+    -> Float -- ^ End angle
+    -> Float -- ^ Radius
+    -> Picture
 arc startA endA rad = thickArc startA endA rad 1
 {-# INLINE arc #-}
 
@@ -241,7 +246,7 @@ mixColors rata ratb (r0,g0,b0,a0) (r2,g2,b2,a2) =
     let fullrat = rata + ratb
         normrata = rata / fullrat
         normratb = ratb / fullrat
-        f x y = sqrt $ normrata * x^2 + normratb * y^2
+        f x y = sqrt $ normrata * x^(2::Int) + normratb * y^(2::Int)
     in  (f r0 r2 , f g0 g2 , f b0 b2 , normrata * a0 + normratb * a2)
 
 light :: Color -> Color

src/Picture/Data.hs

@@ -4,14 +4,14 @@ module Picture.Data
     where
 import Geometry.Data
 
-import Data.Monoid
+--import Data.Monoid
-import Data.Traversable
+--import Data.Traversable
-import qualified Data.Foldable as F
+--import qualified Data.Foldable as F
-import qualified Data.Sequence as Se
+--import qualified Data.Sequence as Se
-import qualified Data.DList as DL
+--import qualified Data.DList as DL
-import qualified Data.Vector as V
+--import qualified Data.Vector as V
-import Control.Lens
+--import Control.Lens
-import Control.Monad 
+--import Control.Monad 
 
 data RenderType
     = RenderPoly [(Point3,Point4)]
@@ -58,8 +58,11 @@ instance Functor (RTree a) where
     fmap f (RBranches i ts) = RBranches i $ fmap (fmap f) ts
     fmap f (RLeaf x)      = RLeaf (f x)
 
-flat2 (x,y)     = [x,y]
+flat2 :: (a,a) -> [a]
-flat3 (x,y,z)   = [x,y,z]
+flat2 (x,y) = [x,y]
+flat3 :: (a,a,a) -> [a]
+flat3 (x,y,z) = [x,y,z]
+flat4 :: (a,a,a,a) -> [a]
 flat4 (x,y,z,w) = [x,y,z,w]
 {-# INLINE flat2 #-}
 {-# INLINE flat3 #-}

src/Picture/Tree.hs

@@ -42,7 +42,7 @@ picToLTree mx (LineCol i vs)
   where (ps,cs) = unzip vs
 picToLTree mx (Text i s) 
     = filtB mx i $ LLeaf $ RenderText $ stringToList s
-picToLTree j Blank = LBranches []
+picToLTree _ Blank = LBranches []
 picToLTree j (Pictures pics) = LBranches $ map (picToLTree j) pics
 picToLTree j (OverPic f f' r f'' (OverPic g g' s g'' pic)) 
     = picToLTree j $ OverPic (f . g) (f' . g') (r + s) (f'' . g'') pic
@@ -64,6 +64,7 @@ doubleLine :: [a] -> [a]
 doubleLine (x:y:xs) = concat $ zipWith (:) (init (x:y:xs)) $ map (: []) (y:xs)
 doubleLine _ = []
 
+white, black :: Color
 white = (1,1,1,1)
 black = (0,0,0,1)
 
@@ -102,7 +103,7 @@ overCol f (RenderArc (a,b,c)) = RenderArc (a,f b,c)
 overSca :: (Point2 -> Point2) -> RenderType -> RenderType
 {-# INLINE overSca #-}
 overSca f (RenderText vs) = RenderText $ map (scaleT (f (1,1))) vs
-overSca f p = p
+overSca _ p = p
 
 stringToList :: String -> [(Point3,Point4,Point3)]
 {-# INLINE stringToList #-}
@@ -123,12 +124,11 @@ translate3 :: Float -> Float -> Point3 -> Point3
 {-# INLINE translate3 #-}
 translate3 a b (x,y,z) = (x+a,y+b,z)
 {- Scale a 3D vector in the x and y directions. -}
-scale3 :: Float -> Float -> Point3 -> Point3
+--scale3 :: Float -> Float -> Point3 -> Point3
-{-# INLINE scale3 #-}
+--{-# INLINE scale3 #-}
-scale3 a b (x,y,z) = (x*a,y*b,z)
+--scale3 a b (x,y,z) = (x*a,y*b,z)
-{- Rotate a 3D vector in the x-y plane. -}
+--{- Rotate a 3D vector in the x-y plane. -}
-rotate3 :: Float -> Point3 -> Point3
+--rotate3 :: Float -> Point3 -> Point3
-{-# INLINE rotate3 #-}
+--{-# INLINE rotate3 #-}
-rotate3 a (x,y,z) = (x',y',z)
+--rotate3 a (x,y,z) = (x',y',z)
-    where (x',y') = rotateV a (x,y)
+--    where (x',y') = rotateV a (x,y)
-

src/Shader.hs

@@ -19,29 +19,22 @@ module Shader
     , module Shader.Data
     )
   where
+import Geometry
 import Shader.Data
 
 import Foreign
 import Codec.Picture
-
-import qualified Data.Vector.Storable as V
-
-import Control.Monad (when, unless, forM, zipWithM_, forM_, foldM)
-import Control.Lens
-
 import Data.Maybe (fromMaybe)
-
-import qualified Control.Foldl as F
-
-import Graphics.Rendering.OpenGL hiding (Point (..),translate,scale,imageHeight,imageWidth)
---import Text.RawString.QQ
 import qualified Data.ByteString as BS
-
+import qualified Data.Vector.Storable as V
+import Control.Monad (unless, forM, zipWithM_, forM_, foldM)
+import Control.Lens
+import qualified Control.Foldl as F
+import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
+--import Text.RawString.QQ
 import Linear.Matrix
 import Linear.V4
 
-import Geometry
-
 extractProgAndUnis :: FullShader a -> (Program,[UniformLocation])
 extractProgAndUnis s = (_shaderProgram s, _shaderUniforms s)
 
@@ -51,8 +44,7 @@ pokeShaders = traverse pokeShader
 pokeShader :: FullShader a -> F.FoldM IO a Int
 pokeShader fs = F.FoldM (pokeRender fls (zip ptrs nAtss))  (return 0) return
   where 
-    vao = _shaderVAO fs
+    (_,ptrs,nAtss) = unzip3 $ _vaoBufferTargets $ _shaderVAO fs
-    (_,ptrs,nAtss) = unzip3 $ _vaoBufferTargets vao
     fls = _shaderPokeStrategy fs
 
 pokeRender :: (a -> [[[Float]]])
@@ -93,8 +85,8 @@ drawShader fs i = do
     currentProgram $= Just (_shaderProgram fs)
     bindVertexArrayObject $= Just (_vao $ _shaderVAO fs)
     case _shaderTexture fs of 
-        Just ShaderTexture{_textureObject = to}
+        Just ShaderTexture{_textureObject = txo}
-            -> textureBinding Texture2D $= Just to
+            -> textureBinding Texture2D $= Just txo
         _   -> return ()
     drawArrays (_shaderDrawPrimitive fs) 0 (fromIntegral i)
 
@@ -129,16 +121,16 @@ makeShader
     -> IO (FullShader a)
 makeShader s shaderlist alocs pm renStrat = do
     (prog,unis)  <- makeSourcedShader s shaderlist
-    vao        <- setupVAO alocs
+    vaob        <- setupVAO alocs
     return $ FullShader { _shaderProgram = prog
                         , _shaderUniforms = unis
-                        , _shaderVAO = vao
+                        , _shaderVAO = vaob
                         , _shaderPokeStrategy = renStrat
                         , _shaderDrawPrimitive = pm
                         , _shaderTexture = Nothing
                         , _shaderCustomUnis = Nothing
                         }
-
+floatSize :: Int
 floatSize = sizeOf (0.5 :: GLfloat)
 {-# INLINE floatSize #-}
 
@@ -171,7 +163,7 @@ setupArrayBuffer (aloc,i) = do
         , VertexArrayDescriptor (fromIntegral i) 
                                 Float 
                                 (fromIntegral $ floatSize * i) 
-                                (bufferOffset 0)
+                                (bufferOffset (0::Int))
         )
     vertexAttribArray (AttribLocation aloc) $= Enabled
     return vbo
@@ -197,30 +189,31 @@ shaderTypeExt :: ShaderType -> String
 shaderTypeExt VertexShader   = ".vert"
 shaderTypeExt GeometryShader = ".geom"
 shaderTypeExt FragmentShader = ".frag"
+shaderTypeExt _ = undefined
 
 makeShaderProgram :: String -> [(ShaderType,BS.ByteString)] -> IO Program
 makeShaderProgram str sources = do
-    shaderProgram <- createProgram
+    theShaderProgram <- createProgram
     shaders <- mapM (compileAndCheckShader str) sources
-    mapM_ (attachShader shaderProgram) shaders
+    mapM_ (attachShader theShaderProgram) shaders
 
-    linkProgram shaderProgram
+    linkProgram theShaderProgram
-    linkingSuccess <- linkStatus shaderProgram
+    linkingSuccess <- linkStatus theShaderProgram
     unless linkingSuccess $ do
-        infoLog <- get (programInfoLog shaderProgram)
+        infoLog <- get (programInfoLog theShaderProgram)
         putStrLn $ str ++ ": Program Linking" ++ infoLog
 
-    return shaderProgram
+    return theShaderProgram
 
 compileAndCheckShader :: String -> (ShaderType,BS.ByteString) -> IO Shader
-compileAndCheckShader str (shaderType,sourceCode) = do
+compileAndCheckShader str (theShaderType,sourceCode) = do
-    theShader <- createShader shaderType
+    theShader <- createShader theShaderType
     shaderSourceBS theShader $= sourceCode
     compileShader theShader
     success <- compileStatus theShader
     unless success $ do
         infoLog <- get (shaderInfoLog theShader)
-        putStrLn $ str ++ ": Shader compile: " ++ show shaderType ++ " : " ++ show infoLog
+        putStrLn $ str ++ ": Shader compile: " ++ show theShaderType ++ " : " ++ show infoLog
     return theShader
 
 resetShaderUniforms :: [(Program, [UniformLocation])] -> IO ()
@@ -229,10 +222,10 @@ resetShaderUniforms = setShaderUniforms 0 1 (0,0) (2,2)
 
 setShaderUniforms :: Float -> Float -> Point2 -> Point2 -> [(Program,[UniformLocation])] -> IO ()
 {-# INLINE setShaderUniforms #-}
-setShaderUniforms rot zoom (tranx,trany) (winx,winy) fss = do
+setShaderUniforms rot czoom (tranx,trany) (winx,winy) fss = do
     let scalMat = Linear.Matrix.transpose $
-            V4 (V4 (2*zoom/winx) 0             0 (0::GLfloat))
+            V4 (V4 (2*czoom/winx) 0             0 (0::GLfloat))
-                (V4 0             (2*zoom/winy) 0 0)
+                (V4 0             (2*czoom/winy) 0 0)
                 (V4 0             0             1 0)
                 (V4 0             0             0 1)
     let rotMat = Linear.Matrix.transpose $
@@ -252,7 +245,7 @@ setShaderUniforms rot zoom (tranx,trany) (winx,winy) fss = do
     forM_ fss $ \shad -> do
         currentProgram $= Just (fst shad)
         uniform (snd shad !! 0) $= Vector2 winx winy
-        uniform (snd shad !! 1) $= zoom
+        uniform (snd shad !! 1) $= czoom
         uniform (snd shad !! 2) $= rot
         uniform (snd shad !! 3) $= Vector2 tranx trany
         uniform (snd shad !! 4) $= wmata

src/Sound.hs

@@ -78,17 +78,17 @@ initialisePlaying sd s = case _soundStatus s of
 tryPlay :: IM.IntMap Mix.Chunk -> Sound -> MaybeT IO Sound
 tryPlay sd s = do
     i <- tryGetChannel s
-    liftIO $ do
+    _ <- liftIO $ do
         Mix.halt i
         Mix.playOn i Mix.Once (sd IM.! _soundChunkID s)
     return $ s 
         & soundChannel  ?~ i
         & soundStatus   .~ Playing
 
-repetitions :: Sound -> Mix.Times
+--repetitions :: Sound -> Mix.Times
-repetitions s = case _soundTime s of
+--repetitions s = case _soundTime s of
-    Nothing -> Mix.Once
+--    Nothing -> Mix.Once
-    _       -> Mix.Forever
+--    _       -> Mix.Forever
 
 tryGetChannel :: Sound -> MaybeT IO Mix.Channel
 tryGetChannel s = case _soundChannel s of
@@ -110,9 +110,12 @@ applyPosition s = case _soundPos s of
     Just (a,d)  -> Mix.effectPosition (fromJust $ _soundChannel s) a d
                     >> return (s & soundPos .~ Nothing)
 
-fadeOutMaybe :: Maybe Mix.Channel -> Int -> IO ()
+fadeOutMaybe 
+    :: Maybe Mix.Channel 
+    -> Int -- ^ fade out time: UNUSED, Mix.fadeOut is buggy
+    -> IO ()
 --fadeOutMaybe (Just x) fadeT = Mix.fadeOut (fromIntegral fadeT + 1) x
-fadeOutMaybe (Just x) fadeT = Mix.halt x
+fadeOutMaybe (Just x) _ = Mix.halt x
 fadeOutMaybe _ _ = return ()
 
 cleanupHalted :: Sound -> MaybeT IO Sound
@@ -149,7 +152,7 @@ playPositionalSoundQueue chunkMap ns = forM_ ns $ \(n,a) ->
 
 setChannelPos :: Int16 -> Mix.Channel -> MaybeT IO Mix.Channel
 setChannelPos a i = do
-    liftIO $ Mix.effectPosition i a 0 
+    _ <- liftIO $ Mix.effectPosition i a 0 
     return i
 
 

src/Sound/Data.hs

@@ -5,7 +5,7 @@ import qualified SDL.Mixer as Mix
 import qualified Data.IntMap as IM
 import qualified Data.Map as M
 import Control.Lens
-import Geometry
+--import Geometry
 import Data.Word (Word8)
 import Data.Int (Int16)