Remove force fields, cleanup

src/Dodge/Item/Weapon/Bullet.hs

@@ -22,7 +22,7 @@ ltBullet = BulletAmmo
 hvBullet :: Ammo
 hvBullet = BulletAmmo
     { _amString = "HVBULLET"
-    , _amBulEff = penWalls hvBulHitCr hvBulHitWall'
+    , _amBulEff = penWalls hvBulHitCr hvBulHitWall
     , _amBulWth = 6
     , _amBulVel = V2 80 0
     }

src/Dodge/Particle/Bullet/HitEffect.hs

@@ -1,5 +1,5 @@
 {- |
-Effects of bullets upon impact with walls or creatures, and possibly force fields.
+Effects of bullets upon impact with walls or creatures.
  -}
 module Dodge.Particle.Bullet.HitEffect
     where
@@ -22,9 +22,6 @@ import Picture
 import System.Random
 import Control.Lens
 import Control.Monad.State
---import Data.Maybe
---import qualified Data.IntMap.Strict as IM
---
 -- | Basic bullet hit creature effect.
 bulHitCr :: Particle -> Point2 -> Creature -> World -> World
 bulHitCr bt p cr w 
@@ -187,14 +184,13 @@ bulConWall'
 bulConWall' _ p wl = damageBlocksBy 1 wl . 
     over worldEvents ( makeShockwaveAt [] p 15 4 1 white . ) 
 
-
+hvBulHitWall 
-hvBulHitWall' 
     :: Particle 
     -> Point2   -- ^ Impact point
     -> Wall 
     -> World 
     -> World
-hvBulHitWall' bt p x w =  damageBlocksBy 5 x $ set randGen g $ foldr ($) w (sparks pOut sv)
+hvBulHitWall bt p x w =  damageBlocksBy 5 x $ set randGen g $ foldr ($) w (sparks pOut sv)
   where 
     sp = head $ _btTrail' bt
     pOut = p +.+ safeNormalizeV (sp -.- p)

src/Dodge/Particle/Bullet/Spawn.hs

@@ -1,5 +1,8 @@
 module Dodge.Particle.Bullet.Spawn
-    where
+    ( aGenBulAt
+    , aDelayedBulAt
+    , aCurveBulAt
+    ) where
 import Dodge.Data
 import Dodge.Particle.Bullet.Draw
 import Dodge.Particle.Bullet.Update

src/Dodge/Particle/Bullet/Update.hs

@@ -1,8 +1,7 @@
-{-
+{- Bullet update.  -}
-Bullet update.
- -}
 module Dodge.Particle.Bullet.Update
-    where
+    ( mvGenBullet
+    ) where
 import Dodge.Data
 --import Dodge.Base
 import Dodge.WorldEvent.ThingsHit
@@ -10,20 +9,16 @@ import Dodge.WorldEvent.ThingsHit
 import Geometry
 
 import Control.Lens
---import Data.Maybe
---import Data.List
---import Data.Bifunctor
---import qualified Data.IntMap.Strict as IM
-
 {-
 Update for a generic bullet.
 -}
 mvGenBullet :: World -> Particle -> (World, Maybe Particle)
 mvGenBullet w bt 
     | t <= 0 = (w, Nothing)
-    | t < 4  = (w, Just $ set btPassThrough' Nothing
+    | t <  4 = (w, Just $ bt
-                        $ set btTrail' (p:p:ps)
+                    & btPassThrough' .~ Nothing
-                        $ set btTimer' (t-1) bt                      
+                    & btTrail' .~ (p:p:ps)
+                    & btTimer' -~ 1                      
                )
     | otherwise = hiteff bt (thingsHitExceptCr mcr p (p +.+ vel) w) w
   where 

src/Dodge/Render/HUD.hs

@@ -27,15 +27,13 @@ hudDrawings w = pictures
     , selectionText
     ]
   where
-    selectionText = 
+    selectionText = if _carteDisplay w
-        if _carteDisplay w
         then drawLocations w
         else drawInventory w
 
 
 drawInventory :: World -> Picture
-drawInventory w = subInventoryDisplay w 
+drawInventory w = subInventoryDisplay w `appendPic` displayInv 0 w
-    `appendPic` displayInv 0 w
 
 subInventoryDisplay :: World -> Picture
 subInventoryDisplay w = case _inventoryMode w of

src/Dodge/Render/List.hs

@@ -1,4 +1,8 @@
 module Dodge.Render.List
+    ( renderListAt
+    , dShadCol
+    , winScale
+    )
     where
 import Dodge.Data
 import Dodge.Base.Window
@@ -21,6 +25,7 @@ listPairAt xoff yoff w yint (s,col)
     . scale 0.1 0.1
     . dShadCol col
     $ text s
+--TODO put the following functions in an appropriate place
 {- | Colour picture and add black drop shadow. -}
 dShadCol :: Color -> Picture -> Picture
 {-# INLINE dShadCol #-}

src/Dodge/Render/MenuScreen.hs

@@ -1,6 +1,4 @@
-{-
+{- The menu picture.  -}
-The menu picture.
- -}
 module Dodge.Render.MenuScreen
     ( menuScreen
     )

src/Dodge/Render/Picture.hs

@@ -1,6 +1,10 @@
 --{-# LANGUAGE TupleSections #-}
 module Dodge.Render.Picture
-  where
+    ( worldPictures
+    , wallsAndWindows
+    , lightsForGloom
+    , fixedCoordPictures
+    ) where
 import Dodge.Data
 --import Dodge.Update.Camera
 --import Dodge.GameRoom
@@ -126,6 +130,15 @@ wallFloorsToDraw w = filter isVisible $ IM.elems $ wallsOnScreen w
         | wl ^? wlDraw == Just False = False
         | otherwise = onScreen wl
 
+lineOnScreen :: World -> Point2 -> Point2 -> Bool
+lineOnScreen w p1 p2 = pointInPolygon p1 sp 
+    || pointInPolygon p2 sp 
+    || any (isJust . uncurry (intersectSegSeg p1 p2)) sps
+  where 
+    sp = screenPolygon w
+    sps = zip sp (tail sp ++ [head sp])
+
+
 drawWallFloor :: Wall -> Picture
 drawWallFloor wl = if _wlIsSeeThrough wl
     then setDepth 0.9 . color c $ polygon [x,x +.+ n2,y+.+n2, y]
@@ -139,77 +152,6 @@ errorNormalizeVDR :: Point2 -> Point2
 errorNormalizeVDR (V2 0 0) = error "problem with function: errorNormalizeVDR in DodgeRendering"
 errorNormalizeVDR p = normalizeV p
 
-printPoint :: Point2 -> Picture
-printPoint p = color white $ uncurryV translate p $ pictures [circle 3 ,scale 0.05 0.05 $ text (show p)]
-
-printRotPoint :: Float -> Point2 -> Picture
-printRotPoint r p = color white 
-    . uncurryV translate p 
-    $ pictures [circle 3 , rotate (negate r) $ scale 0.1 0.1 $ text (show p)]
-
-outsideScreenPolygon :: World -> [Point2]
-outsideScreenPolygon w = [tr,tl,bl,br]
-  where 
-    scRot  = rotateV (_cameraRot w)
-    scZoom p | _cameraZoom w /= 0 = (1/_cameraZoom w) *.* p
-             | otherwise = error "Trying to set screen zoom to zero"
-    scTran p = p +.+ _cameraCenter w
-    tr = scTran $ scRot $ scZoom $ V2 (  3*halfWidth w  ) ( 3* halfHeight w) 
-    tl = scTran $ scRot $ scZoom $ V2 (- (3*halfWidth w)) ( 3* halfHeight w) 
-    br = scTran $ scRot $ scZoom $ V2 (   3*halfWidth w ) (- (3* halfHeight w))
-    bl = scTran $ scRot $ scZoom $ V2 (- (3*halfWidth w)) (- (3* halfHeight w))
-
--- cannot only test if walls are on screen, but also if they are on the cone
--- towards the center of sight
-lineOnScreenCone :: World -> Point2 -> Point2 -> Bool
-lineOnScreenCone w p1 p2 = pointInPolygon p1 sp 
-    || pointInPolygon p2 sp 
-    || any (isJust . uncurry (intersectSegSeg p1 p2)) sps
-  where 
-    sp' = screenPolygon w
-    vp = _cameraViewFrom w
-    sp | pointInPolygon vp sp' = sp'
-       | otherwise = orderPolygon (_cameraViewFrom w : sp')
-    sps = zip sp (tail sp ++ [head sp])
-
-
-lineOnScreen :: World -> Point2 -> Point2 -> Bool
-lineOnScreen w p1 p2 = pointInPolygon p1 sp 
-    || pointInPolygon p2 sp 
-    || any (isJust . uncurry (intersectSegSeg p1 p2)) sps
-  where 
-    sp = screenPolygon w
-    sps = zip sp (tail sp ++ [head sp])
-
-drawWallFace :: World -> Wall -> Picture
-drawWallFace w wall
-    | isRHS sightFrom x y || _wlIsSeeThrough wall = blank
-    | otherwise = setDepth (-1) . color (withAlpha 0 black) . polygon $ points
-  where 
-    (x,y) = _wlLine wall 
-    points = extendConeToScreenEdge w sightFrom (x,y)
-    sightFrom = _cameraViewFrom w
-
--- the following assumes that the point a is inside the screen
--- it still works otherwise, but it might intersect two points:
--- it is not obvious which will be returned
-intersectLinefromScreen :: World -> Point2 -> Point2 -> Maybe Point2
-intersectLinefromScreen w a b = listToMaybe 
-    . mapMaybe (\(x,y) -> intersectSegLineFrom' x y b (b +.+ b -.- a))
-    . makeLoopPairs 
-    $ screenPolygon w
-
-extendConeToScreenEdge :: World -> Point2 -> (Point2,Point2) -> [Point2]
-extendConeToScreenEdge w c (x,y) = orderPolygon $ wallScreenIntersect ++ [x,y] ++ borderPs ++ cornerPs
-  where 
-    borderPs = mapMaybe (intersectLinefromScreen w c) [x,y]
-    cornerPs = filter (pointIsInCone c (x,y)) $ screenPolygon w
-    wallScreenIntersect = mapMaybe (uncurry $ intersectSegSeg y ((2*.*y) -.- x)) 
-                              . makeLoopPairs $ screenPolygon w
-
-rectangleSolid :: Float -> Float -> Picture
-rectangleSolid x y = polygon $ map toV2 [(x,y),(x,-y),(-x,-y),(-x,y)]
-
 wallsAndWindows
     :: World
     -> ( [((Point2,Point2),Point4)]  ,[((Point2,Point2),Point4)] )
@@ -219,9 +161,6 @@ wallsAndWindows w
     f wl = (_wlLine wl, _wlColor wl)
     (wins,wls) = partition _wlIsSeeThrough . IM.elems . IM.filter _wlDraw $ wallsDoubleScreen w
 
-wallsToList :: [((Point2,Point2),Point4)] -> [Float]
-wallsToList = concatMap (\((V2 a b,V2 c d),V4 e f g h) -> [a,b,c,d,e,f,g,h])
-
 lightsForGloom :: World -> [(Point3,Float,Point3)]
 lightsForGloom w = mapMaybe getLS (IM.elems $ _lightSources w) ++ mapMaybe getTLS (_tempLightSources w)
   where 

src/Dodge/Render/Shape.hs

@@ -1,5 +1,6 @@
 module Dodge.Render.Shape
-  where
+    ( worldShape
+    ) where
 import Dodge.Data
 import Dodge.Base
 import Shape

src/Dodge/Render/ShapePicture.hs

@@ -1,11 +1,16 @@
 module Dodge.Render.ShapePicture
+    ( floorItemSPic
+    )
     where
 import Dodge.Data
 import Geometry
 import ShapePicture
+--import Shape
+--import Picture
 
 floorItemSPic :: FloorItem -> SPic
 floorItemSPic flit 
     = uncurryV translateSPf (_flItPos flit) 
     $ rotateSP (_flItRot flit)  (_itFloorPict (_flIt flit) (_flIt flit))
 
+--TODO combine worldShape and worldPicture here

src/Dodge/SoundLogic/LoadSound.hs

@@ -1,4 +1,5 @@
-module Dodge.SoundLogic.LoadSound where
+module Dodge.SoundLogic.LoadSound 
+    where
 import Sound.Data
 
 import qualified Data.IntMap.Strict as IM