Add concept of GameRoom, check viewing distance based on rooms

src/Dodge/Base/Collide.hs

@@ -11,6 +11,7 @@ import FoldableHelp
 import Data.Maybe
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
+import qualified FoldlHelp as L
 
 hasLOS :: Point2 -> Point2 -> World -> Bool
 {-# INLINE hasLOS #-}
@@ -71,12 +72,36 @@ furthestPointWalkable p1 p2 ws
     . safeMinimumOn (dist p1) 
     $ IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine) ws
 
+collideDirectionIndirect 
+    :: Float    -- ^max distance to look
+    -> Point2   -- ^start point
+    -> Point2   -- ^point in direction
+    -> IM.IntMap Wall 
+    -> Float
+{-# INLINE collideDirectionIndirect #-}
+collideDirectionIndirect d p1 p2 wls
+    = fromMaybe d
+    $
+    ( L.fold
+    . L.prefilter (not . _wlIsSeeThrough)
+    . L.premapMaybe (fmap (dist p1) . uncurry (intersectSegSeg p1 p3) . _wlLine)
+    ) L.minimum 
+    wls
+  where
+    p3 = p1 +.+ d *.* safeNormalizeV (p2 -.- p1)
+
 collidePointIndirect :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
 {-# INLINE collidePointIndirect #-}
-collidePointIndirect p1 p2
-    = safeMinimumOn (dist p1) 
-    . IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine) 
-    . IM.filter (not . _wlIsSeeThrough)
+collidePointIndirect  p1 p2
+    = L.fold
+    . L.prefilter (not . _wlIsSeeThrough)
+    . L.premapMaybe (uncurry (intersectSegSeg p1 p2) . _wlLine)
+    $ L.minimumOn (dist p1)
+--collidePointIndirect p1 p2
+--    = safeMinimumOn (dist p1) 
+--    . IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine) 
+--    . IM.filter (not . _wlIsSeeThrough)
+
 {- | Checks to see whether someone can fire bullets effectively between two points. 
  - Not sure if this needs vision as well, need to make this uniform. -}
 collidePointFire :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2

src/Dodge/Creature/ShadowBox.hs

@@ -5,22 +5,12 @@ import Polyhedra
 import Geometry
 
 import qualified Data.IntMap as IM
-crToBox :: Creature -> [[Point3]]
-crToBox cr = map (map f . polyToTris) $ boxXYZ 8 8 15
-  where
-    f = (+ V3 (x-4) (y-4) 1)
-    V2 x y = _crPos cr
 youBox' :: World -> [[Point3]]
 youBox' w = crToBox' $ _creatures w IM.! 0
-
-youBox :: World -> [Point3]
-youBox = concat . youBox'
-
 crToBox' :: Creature -> [[Point3]]
 crToBox' cr = map (map f . polyToTris) $ boxXYZ 12 12 15
   where
     f = (+ V3 (x-6) (y-6) 0)
     V2 x y = _crPos cr
-
 youSil :: World -> [Point3]
 youSil = constructEdgesList . youBox'

src/Dodge/Creature/Silhouette.hs

@@ -14,13 +14,8 @@ creatureSilhouettes w = concatMap f . IM.elems $ _creatures w
   where
     f cr = _crSilhouette cr cr
 
-crBox :: [Point3]
-crBox = constructEdgesList . map (map f . polyToTris) $ boxXYZ 12 12 15
-  where
-    f = (+ V3 (-6) (-6) 0)
-
 basicCrSilhouette :: Creature -> [Point3]
-basicCrSilhouette cr = map theTrans crBox
+basicCrSilhouette cr = constructEdgesList . map (map f . polyToTris) $ boxXYZ 12 12 15
   where
-    theTrans = (+ V3 x y 0)
+    f = (+ V3 (x-6) (y-6) 0)
     V2 x y = _crPos cr

src/Dodge/Creature/YourControl.hs

@@ -50,7 +50,7 @@ wasdWithAiming w speed i cr
     isAiming = _posture (_crStance cr) == Aiming
     mouseDir = case w ^? creatures . ix i . crInv . ix (_crInvSel (_creatures w IM.! i))
                               . itAttachment of
-        Just (Just ItScope{_scopePos = p}) -> normalizeAngle $ argV
+        Just ItScope{_scopePos = p} -> normalizeAngle $ argV
                                 $ p +.+ 2 / _cameraZoom w 
                                     *.* rotateV (_cameraRot w) (_mousePos w)
         _ -> normalizeAngle $ argV (_mousePos w) + _cameraRot w

src/Dodge/Data.hs

@@ -33,6 +33,7 @@ import Geometry.Data
 import Polyhedra.Data
 import Sound.Data
 import qualified DoubleStack as DS
+import Dodge.GameRoom
 
 import GHC.Generics
 import Control.Lens
@@ -107,6 +108,7 @@ data World = World
     , _inventoryMode        :: InventoryMode
     , _lClickHammer         :: HammerPosition
     , _radDistortion        :: [(Point2,Point2,Point2,Float)]
+    , _gameRooms            :: [GameRoom]
     }
 data InventoryMode
     = TopInventory
@@ -239,11 +241,12 @@ data Item
         , _itAmount :: Int
         , _itAimingSpeed :: Float
         , _itAimingRange :: Float
-        , _itZoom :: ItZoom
+        , _itZoom    :: ItZoom
+        , _itAimZoom :: ItZoom
         , _itEquipPict :: Creature -> Int -> Picture
         , _itScroll :: Float -> Creature -> World -> World
         , _itIdentity :: ItemIdentity
-        , _itAttachment :: Maybe ItAttachment
+        , _itAttachment :: ItAttachment
         , _itID :: Maybe Int
         , _itEffect :: ItEffect
         , _itInvDisplay :: Item -> String
@@ -292,6 +295,7 @@ data Item
         , _itAimingSpeed :: Float
         , _itAimingRange :: Float
         , _itZoom :: ItZoom
+        , _itAimZoom :: ItZoom
         , _itInvDisplay :: Item -> String
         , _itInvColor :: Color
         , _itHammer :: HammerPosition
@@ -311,10 +315,11 @@ data Item
         , _itAimingSpeed :: Float
         , _itAimingRange :: Float
         , _itZoom :: ItZoom
+        , _itAimZoom :: ItZoom
         , _itEquipPict :: Creature -> Int -> Picture
         , _itIdentity :: ItemIdentity
         , _itID :: Maybe Int
-        , _itAttachment :: Maybe ItAttachment
+        , _itAttachment :: ItAttachment
         , _itInvDisplay :: Item -> String
         , _itInvColor :: Color
         , _itEffect :: ItEffect
@@ -339,12 +344,9 @@ data ItEffect = NoItEffect
         ,_itEffectCounter   :: Int
         }
 data ItZoom = ItZoom 
-    {_itAimZoomMax :: Float
-    ,_itAimZoomMin :: Float
-    ,_itAimZoomFac :: Float
-    ,_itZoomMax    :: Float
-    ,_itZoomMin    :: Float
-    ,_itZoomFac    :: Float 
+    { _itZoomMax    :: Float
+    , _itZoomMin    :: Float
+    , _itZoomFac    :: Float 
     }
 data IntID a = IntID Int a
 {- Objects without ids.

src/Dodge/Default.hs

@@ -77,13 +77,14 @@ defaultEquipment = Equipment
     , _itID = Nothing
     , _itAimingSpeed = 1
     , _itAimingRange = 0
-    , _itZoom = defaultItZoom
+    , _itZoom    = defaultItZoom
+    , _itAimZoom = defaultItZoom
     , _itInvColor = yellow
     , _itInvDisplay = _itName
     , _itAimStance = LeaveHolstered
     }
 defaultItZoom :: ItZoom
-defaultItZoom = ItZoom 20 0.2 1 20 0.2 1
+defaultItZoom = ItZoom 20 0.2 1
 defaultConsumable :: Item
 defaultConsumable = Consumable
     { _itIdentity = Generic

src/Dodge/Default/Weapon.hs

@@ -3,6 +3,7 @@ module Dodge.Default.Weapon
 import Dodge.Data
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Item.Weapon.InventoryDisplay
+import Dodge.Item.Attachment.Data
 import Dodge.Item.Data
 import Picture
 defaultGun :: Item
@@ -32,10 +33,11 @@ defaultGun = Weapon
     , _itMaxStack = 1
     , _itAimingSpeed = 1
     , _itAimingRange = 0
-    , _itZoom = ItZoom 20 0.2 1 20 0.2 1
+    , _itZoom    = ItZoom 20 0.2 1
+    , _itAimZoom = ItZoom 20 0.2 1
     , _itEquipPict = \_ _ -> blank
     , _itScroll = \_ _ -> id
-    , _itAttachment = Nothing
+    , _itAttachment = NoItAttachment
     , _itID = Nothing
     , _itEffect = wpRecock
     , _itInvDisplay = basicWeaponDisplay

src/Dodge/Default/World.hs

@@ -82,6 +82,7 @@ defaultWorld = World
     , _foregroundDecorations = []
     , _foregroundEdgeVerx = []
     , _radDistortion = []
+    , _gameRooms = []
     }
 defaultDebugFlags :: DebugFlags
 defaultDebugFlags = DebugFlags

src/Dodge/GameRoom.hs

@@ -0,0 +1,10 @@
+{- | GameRooms contain information about given positions in the world
+ -}
+module Dodge.GameRoom
+    where
+import Geometry
+
+data GameRoom = GameRoom
+    { _grViewpoints :: [Point2]
+    , _grBound :: [Point2]
+    }

src/Dodge/Item/Attachment.hs

@@ -34,12 +34,12 @@ incCharMode
     :: Int      -- ^ Inventory selection
     -> World 
     -> World
-incCharMode i = creatures . ix 0 . crInv . ix i . itAttachment . _Just %~ incCharMode'
+incCharMode i = creatures . ix 0 . crInv . ix i . itAttachment %~ incCharMode'
 decCharMode 
     :: Int      -- ^ Inventory selection
     -> World 
     -> World
-decCharMode i = creatures . ix 0 . crInv . ix i . itAttachment . _Just %~ decCharMode'
+decCharMode i = creatures . ix 0 . crInv . ix i . itAttachment %~ decCharMode'
 
 charFiringStrat 
     :: [(Char, Creature -> World -> World)] -- ^ Different firing effects for different characters
@@ -47,7 +47,7 @@ charFiringStrat
     -> World 
     -> World
 charFiringStrat strats cr w = case w ^? creatures . ix cid . crInv 
-        . ix (_crInvSel $ _creatures w IM.! cid) . itAttachment . _Just . itCharMode of
+        . ix (_crInvSel $ _creatures w IM.! cid) . itAttachment . itCharMode of
     Just (c :<| _) -> fromJust (Prelude.lookup c strats) cr w
     _ -> w
   where
@@ -60,7 +60,7 @@ charFiringStratI
     -> World 
     -> World
 charFiringStratI strats eff item cr w = case w ^? creatures . ix cid . crInv 
-        . ix (_crInvSel $ _creatures w IM.! cid) . itAttachment . _Just . itCharMode of
+        . ix (_crInvSel $ _creatures w IM.! cid) . itAttachment . itCharMode of
     Just (c :<| _) -> fromJust (Prelude.lookup c strats) eff item cr w
     _ -> w
   where
@@ -75,8 +75,8 @@ increaseFuse fuse itid w = w
     & creatures . ix 0 . crInv . ix itid %~ 
           ( itScrollUp .~ decreaseFuse newTime )
         . (itScrollDown .~ increaseFuse newTime )
-        . ( itAttachment ?~ ItFuse newTime )
-        . ( itZoom .~ defaultItZoom{_itAimZoomMax = zm, _itAimZoomMin = zm} )
+        . ( itAttachment .~ ItFuse newTime )
+        . ( itAimZoom .~ defaultItZoom{_itZoomMax = zm, _itZoomMin = zm} )
   where 
     newTime = min (fuse + 5) 90
     zm = 50 / fromIntegral newTime
@@ -89,8 +89,8 @@ decreaseFuse fuse itid w = w
     & creatures . ix 0 . crInv . ix itid %~ 
         ( itScrollUp .~ decreaseFuse newTime )
         . ( itScrollDown .~ increaseFuse newTime )
-        . ( itAttachment ?~ ItFuse newTime )
-        . ( itZoom .~ defaultItZoom {_itAimZoomMax = zm, _itAimZoomMin = zm} )
+        . ( itAttachment .~ ItFuse newTime )
+        . ( itAimZoom .~ defaultItZoom {_itZoomMax = zm, _itZoomMin = zm} )
   where 
     newTime = max (fuse - 5) 20
     zm = 50 / fromIntegral newTime

src/Dodge/Item/Attachment/Data.hs

@@ -9,15 +9,16 @@ import qualified Data.Sequence as Seq
 
 data ItAttachment 
     = ItScope 
-        {_scopePos        :: Point2
+        {_scopePos        :: Point2 -- ^ a camera offset
         ,_scopeZoomChange :: Int
         ,_scopeZoom       :: Float 
-        ,_scopeIsCamera   :: Bool
+        ,_scopeIsCamera   :: Bool   -- ^ if the camera offset is also the center of vision
         }
     | ItFuse {_itFuseTime :: Int}
     | ItMode {_itMode :: Int}
     | ItCharMode {_itCharMode :: Seq.Seq Char }
     | ItTargetPos { _itTargetPos :: Point2 }
     | ItInt { _itInt :: Int }
+    | NoItAttachment
 
 makeLenses ''ItAttachment

src/Dodge/Item/Weapon.hs

@@ -24,10 +24,11 @@ import Dodge.Item.Weapon.Laser
 import Dodge.Item.Weapon.Shell
 import Dodge.Item.Weapon.Bullet
 import Dodge.Item.Weapon.AmmoParams
+import Dodge.Item.Attachment.Data
 import Dodge.Default.Weapon
 import Dodge.Item.Weapon.Booster
 import Dodge.Item.Weapon.Grenade
-import Dodge.Item.Attachment.Data
+--import Dodge.Item.Attachment.Data
 import Dodge.Item.Attachment
 import Geometry
 import Geometry.Vector3D
@@ -80,7 +81,7 @@ pistol = defaultGun
     , _itAimingRange = 0
     , _itZoom = defaultItZoom
     , _itEquipPict = pictureWeaponOnAim pistolPic
-    , _itAttachment = Nothing
+    , _itAttachment = NoItAttachment
     , _itID = Nothing
     , _itEffect = wpRecock
     , _itInvDisplay = basicWeaponDisplay
@@ -187,7 +188,7 @@ lasGun = defaultAutoGun
     , _itAimingSpeed = 0.4
     , _itAimingRange = 1
     , _itEquipPict = pictureWeaponOnAim lasGunPic
-    , _itAttachment = Just $ ItCharMode $ Seq.fromList "/VZ"
+    , _itAttachment = ItCharMode $ Seq.fromList "/VZ"
     , _itScroll   = scrollCharMode
     , _itInvDisplay = basicWeaponDisplay
     }
@@ -253,7 +254,7 @@ tractorGun = defaultAutoGun
 
 
 removeItAttachment :: Int -> Int -> World -> World
-removeItAttachment i _ w = w & creatures . ix i . crInv . ix itRef . itAttachment .~ Nothing
+removeItAttachment i _ w = w & creatures . ix i . crInv . ix itRef . itAttachment .~ NoItAttachment
   where 
     cr = _creatures w IM.! i
     itRef = _crInvSel cr
@@ -278,7 +279,7 @@ remoteLauncher = defaultGun
     , _itAimingSpeed = 0.2
     , _itAimingRange = 0.5
     , _itEquipPict = pictureWeaponOnAim $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
-    , _itAttachment = Just $ ItScope (V2 0 0) 0 1 True
+    , _itAttachment = ItScope (V2 0 0) 0 1 True
     }
 hvAutoGun :: Item
 hvAutoGun = defaultAutoGun 
@@ -470,7 +471,8 @@ multGun = defaultGun
     , _itFloorPict = onLayer FlItLayer multGunPic
     , _itAimingSpeed = 0.4
     , _itAimingRange = 1
-    , _itZoom = defaultItZoom {_itAimZoomFac = 1.5}
+    , _itZoom       = defaultItZoom
+    , _itAimZoom    = defaultItZoom {_itZoomFac = 1.5}
     , _itEquipPict = pictureWeaponOnAim multGunPic
     , _itAimStance = TwoHandTwist
     , _wpAmmo = basicBullet
@@ -514,10 +516,11 @@ longGun = defaultGun
     , _itFloorPict = onLayer FlItLayer longGunPic
     , _itAimingSpeed = 0.2
     , _itAimingRange = 1
-    , _itZoom = defaultItZoom {_itAimZoomMax = 0.5, _itAimZoomMin = 0.5}
+    , _itZoom       = defaultItZoom 
+    , _itAimZoom    = defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5}
     , _itEquipPict = pictureWeaponOnAim longGunPic
     , _itScroll = zoomLongGun
-    , _itAttachment = Just $ ItScope (V2 0 0) 0 1 False
+    , _itAttachment = ItScope (V2 0 0) 0 1 False
     , _itEffect = itemLaserScopeEffect
     , _wpAmmo = hvBullet
     , _itAimStance = TwoHandTwist
@@ -533,10 +536,10 @@ zoomLongGun x cr
 
 startZoomInLongGun :: Int -> World -> World
 startZoomInLongGun  _ w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
-                                . itAttachment . _Just . scopeZoomChange %~ \x -> max 5 (x + 5)
+                                . itAttachment . scopeZoomChange %~ \x -> max 5 (x + 5)
 startZoomOutLongGun :: Int -> World -> World
 startZoomOutLongGun  _ w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
-                                . itAttachment . _Just . scopeZoomChange %~ \x -> min (-5) (x-5)
+                                . itAttachment . scopeZoomChange %~ \x -> min (-5) (x-5)
 poisonSprayer :: Item
 poisonSprayer = defaultAutoGun 
     { _itName = "POISON"
@@ -586,9 +589,10 @@ flamer = defaultAutoGun
     , _itFloorPict = onLayer FlItLayer flamerPic
     , _itAimingSpeed = 0.5
     , _itAimingRange = 0
-    , _itZoom = defaultItZoom {_itAimZoomMax = 5, _itAimZoomMin = 1.5}
+    , _itZoom       = defaultItZoom
+    , _itAimZoom    = defaultItZoom {_itZoomMax = 5, _itZoomMin = 1.5}
     , _itEquipPict = pictureWeaponOnAim flamerPic
-    , _itAttachment = Nothing
+    , _itAttachment = NoItAttachment
     }
 flamerPic :: Picture
 flamerPic = color yellow $ pictures
@@ -709,7 +713,7 @@ pointToItem (OnFloor flid) = floorItems . ix flid . flIt
 
 retireRemoteRocket :: Int -> Int -> Int -> World -> World
 retireRemoteRocket itid 0 pjid w = 
-    set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos) (V2 0 0)
+    set (pointToItem (_itemPositions w IM.! itid) . itAttachment . scopePos) (V2 0 0)
     $ set (pointToItem (_itemPositions w IM.! itid) . itUse) (const fireRemoteLauncher)
     (w & projectiles %~ IM.delete pjid)
 retireRemoteRocket itid t pjid w = setScope w 
@@ -718,13 +722,13 @@ retireRemoteRocket itid t pjid w = setScope w
     setScope w' = case _itemPositions w' IM.! itid of
         InInv cid invid -> w' 
             & creatures . ix cid . crInv . ix invid . itAttachment 
-                    . _Just . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid))
+                    . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid))
         _   -> w'
     pos = fromMaybe (V2 0 0) $ w ^? projectiles . ix pjid . pjPos
 retireRemoteBomb :: Int -> Int -> Int -> World -> World
 retireRemoteBomb itid 0 pjid w = w
     & pointToItem (_itemPositions w IM.! itid) %~ 
-        ( (itAttachment . _Just . scopePos .~ V2 0 0)
+        ( (itAttachment . scopePos .~ V2 0 0)
         . (itZoom .~ defaultItZoom)
         . (itUse .~ const throwRemoteBomb)
         )
@@ -735,7 +739,7 @@ retireRemoteBomb itid t pjid w = setScope w
     setScope w' = case _itemPositions w' IM.! itid of
         InInv cid invid -> w' 
             & creatures . ix cid . crInv . ix invid . itAttachment 
-                    . _Just . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid))
+                    . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid))
         _   -> w'
     pos = fromMaybe (V2 0 0) $ w ^? projectiles . ix pjid . pjPos
 
@@ -782,16 +786,16 @@ setRemoteScope :: Int -> Projectile -> World -> World
 setRemoteScope itid pj w' = case w' ^? itemPositions . ix itid of
     Just (InInv cid' invid )
         -> w' & creatures . ix cid' . crInv . ix invid . itAttachment 
-                . _Just . scopePos .~ (_pjPos pj -.- _crPos (_creatures w' IM.! cid'))
+                . scopePos .~ (_pjPos pj -.- _crPos (_creatures w' IM.! cid'))
     _   -> w'
 
 setRemoteBombScope :: Int -> Projectile -> World -> World
 setRemoteBombScope itid pj w' = case _itemPositions w' IM.! itid of
     InInv cid invid 
         -> w' & creatures . ix cid . crInv . ix invid . itAttachment 
-                . _Just . scopePos .~ (_pjPos pj -.- _crPos (_creatures w' IM.! cid))
-              & creatures . ix cid . crInv . ix invid . itZoom 
-                    .~ (defaultItZoom {_itAimZoomMax = 0.5, _itAimZoomMin = 0.5})
+                . scopePos .~ (_pjPos pj -.- _crPos (_creatures w' IM.! cid))
+              & creatures . ix cid . crInv . ix invid . itAimZoom 
+                    .~ (defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5})
     _   -> w'
                         
 grenade :: Item
@@ -809,12 +813,13 @@ grenade = Throwable
         ]
     , _itAimingSpeed = 1
     , _itAimingRange = 0
-    , _itZoom = defaultItZoom {_itAimZoomMax = f fuseTime, _itAimZoomMin = f fuseTime}
+    , _itZoom       = defaultItZoom
+    , _itAimZoom    = defaultItZoom {_itZoomMax = f fuseTime, _itZoomMin = f fuseTime}
     , _itEquipPict = pictureWeaponOnAim $ grenadePic fuseTime
     , _itID = Nothing
     , _itUseRate = 25 
     , _itUseTime = 0
-    , _itAttachment = Just $ ItFuse fuseTime
+    , _itAttachment = ItFuse fuseTime
     , _itInvColor = white
     , _itInvDisplay = basicWeaponDisplay
     , _itEffect = wpRecock
@@ -860,7 +865,7 @@ remoteBomb = defaultThrowable
     , _itUseModifiers =
         [ hammerCheckI
         ]
-    , _itAttachment = Just $ ItScope (V2 0 0) 0 1 True
+    , _itAttachment = ItScope (V2 0 0) 0 1 True
     , _itEquipPict = pictureWeaponOnAim remoteBombUnarmedPic
     }
 
@@ -1062,7 +1067,8 @@ radar = defaultGun
     , _itAmount = 1
     , _itMaxStack = 1
     , _itAimingRange = 1
-    , _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1}
+    , _itZoom       = defaultItZoom { _itZoomMax = 1}
+    , _itAimZoom    = defaultItZoom { _itZoomMax = 1}
     , _itEquipPict = pictureWeaponOnAim $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
     }
 {- |
@@ -1087,7 +1093,8 @@ sonar = defaultGun
     , _itAmount = 1
     , _itMaxStack = 1
     , _itAimingRange = 1
-    , _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1}
+    , _itZoom       = defaultItZoom {_itZoomMax = 1}
+    , _itAimZoom    = defaultItZoom {_itZoomMax = 1}
     , _itEquipPict = pictureWeaponOnAim $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
     }
 {- |
@@ -1104,7 +1111,8 @@ autoSonar = defaultEquipment
     , _itID = Nothing
     , _itAimingSpeed = 1
     , _itAimingRange = 0
-    , _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1}
+    , _itZoom = defaultItZoom {_itZoomMax = 1}
+    , _itAimZoom = defaultItZoom {_itZoomMax = 1}
     }
 {- |
 Automatically sends out pulses that display walls.  -}
@@ -1120,7 +1128,8 @@ autoRadar = defaultEquipment
     , _itID = Nothing
     , _itAimingSpeed = 1
     , _itAimingRange = 0
-    , _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1}
+    , _itZoom = defaultItZoom {_itZoomMax = 1}
+    , _itAimZoom = defaultItZoom {_itZoomMax = 1}
     }
 {- |
 Creates a creature next to the creature using the item.  -}

src/Dodge/Item/Weapon/AutoGun.hs

@@ -48,10 +48,11 @@ autoGun = defaultAutoGun
     , _itFloorPict = onLayer FlItLayer autoGunPic
     , _itAimingSpeed = 0.4
     , _itAimingRange = 1
-    , _itZoom = defaultItZoom {_itAimZoomFac = 1.5}
+    , _itZoom = defaultItZoom 
+    , _itAimZoom = defaultItZoom {_itZoomFac = 1.5}
     , _itEquipPict = pictureWeaponOnAim autoGunPic
     , _itEffect = wpRecock
-    , _itAttachment = Just $ ItCharMode $ Seq.fromList "MS"
+    , _itAttachment = ItCharMode $ Seq.fromList "MS"
     , _itScroll   = scrollCharMode
     , _itInvDisplay = basicWeaponDisplay
     , _wpAmmo = basicBullet    

src/Dodge/Item/Weapon/Bezier.hs

@@ -8,6 +8,7 @@ import Dodge.Item.Draw
 import Dodge.Item.Weapon.Targeting
 import Dodge.Item.Weapon.TriggerType
 import Dodge.Item.Weapon.ExtraEffect
+import Dodge.Item.Attachment.Data
 import Dodge.Default
 import Dodge.Particle.Bullet.Spawn
 import Dodge.Particle.Bullet.HitEffect
@@ -35,7 +36,7 @@ bezierGun = defaultGun
         ]
     , _itFloorPict = onLayer FlItLayer bezierGunPic
     , _itEquipPict = pictureWeaponOnAim bezierGunPic
-    , _itAttachment = Nothing
+    , _itAttachment = NoItAttachment
     , _itScroll   = removeItTarget 0
     , _itHammer = HammerUp
     , _itEffect = rbSetTarget

src/Dodge/Item/Weapon/Booster.hs

@@ -41,14 +41,14 @@ boostSelfL x cr invid w = case boostPoint x cr w of
     cpos = _crPos cr
     r = _crRad cr
     pid = fromMaybe (IM.newKey $ _projectiles w) 
-        (cr ^? crInv . ix invid . itAttachment . _Just . itInt)
+        (cr ^? crInv . ix invid . itAttachment . itInt)
     crEff p ammoEff = addBoostShockwave pid p (r *.* normalizeV (p -.- cpos)) w
         & creatures . ix cid %~ 
              (crPos .~ p) 
             . (crInv . ix invid %~ 
                 ammoEff
                 . (itEffect . itEffectCounter .~ 1)
-                . (itAttachment ?~ ItInt pid)
+                . (itAttachment .~ ItInt pid)
                 )
 
 boostSelf
@@ -120,7 +120,7 @@ resetAttachmentID :: ItEffect
 resetAttachmentID = ItInvEffect f 0
   where
     f iteff cr invid w 
-        | _itEffectCounter iteff < 0 = w & pointToIt . itAttachment .~ Nothing
+        | _itEffectCounter iteff < 0 = w & pointToIt . itAttachment .~ NoItAttachment
         | otherwise = w & pointToIt . itEffect . itEffectCounter -~ 1
       where
         pointToIt = creatures . ix (_crID cr) . crInv . ix invid

src/Dodge/Item/Weapon/ExtraEffect.hs

@@ -9,7 +9,7 @@ import Dodge.Base
 import Dodge.Item.Data
 import Dodge.Item.Weapon.Decoration
 import Dodge.Item.Weapon.UseEffect
---import Dodge.Item.Attachment.Data
+import Dodge.Item.Attachment.Data
 import Dodge.WorldEvent.Flash
 import Dodge.WorldEvent.ThingsHit
 import Dodge.Picture.Layer
@@ -49,7 +49,7 @@ bezierRecock = ItInvEffect
     f _ cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust fOnIt i
     fOnIt it = case _itHammer it of
                   HammerDown -> it & itHammer .~ HammerUp
-                  _          -> it & itAttachment .~ Nothing
+                  _          -> it & itAttachment .~ NoItAttachment
 {- |
 Creates a laser scope and recocks the weapon.
  -}

src/Dodge/Item/Weapon/Grenade.hs

@@ -15,7 +15,6 @@ import Picture
 import Geometry
 
 import Control.Lens
-import Data.Maybe (fromJust)
 import qualified Data.IntMap.Strict as IM
 --import System.Random
 
@@ -90,7 +89,7 @@ throwGrenade explosion cr w = setWp $ removePict $ over projectiles addG w
     dir = argV v 
     setWp :: World -> World
     setWp w' = w' & creatures . ix n . crInv . ix j . itEffect .~ throwArmReset 20
-    fuseTime = _itFuseTime $ fromJust $ _itAttachment $ _crInv cr IM.! j
+    fuseTime = _itFuseTime $ _itAttachment $ _crInv cr IM.! j
 
 throwArmReset :: Int -> ItEffect
 throwArmReset x = ItInvEffect {_itInvEffect = f ,_itEffectCounter = x }

src/Dodge/Item/Weapon/InventoryDisplay.hs

@@ -13,7 +13,7 @@ import Control.Lens
 --import Control.Monad
 {- | Displays the item name, ammo if loaded, and any selected '_itCharMode'.  -}
 basicWeaponDisplay :: Item -> String
-basicWeaponDisplay it = case it ^? itAttachment . _Just of
+basicWeaponDisplay it = case it ^? itAttachment of
     Just ItCharMode {_itCharMode = (c :<| _)} -> midPadL 10 ' ' (_itName it) (' ' : aIfLoaded) ++ [' ',c]
     Just ItMode {_itMode = i} -> midPadL 10 ' ' (_itName it) (' ' : aIfLoaded) ++ show i
     _   -> midPadL 10 ' ' (_itName it) (' ' : aIfLoaded)

src/Dodge/Item/Weapon/Laser.hs

@@ -31,7 +31,7 @@ aLaser cr w = over particles (makeLaserAt phaseV pos dir : )
     pos = _crPos cr +.+ ((_crRad cr +3) *.* unitVectorAtAngle dir) 
     dir = _crDir cr
     phaseV = charToPhaseV 
-        $ fromMaybe '/' $ Seq.lookup 0 =<< cr ^? crInv . ix j . itAttachment . _Just . itCharMode
+        $ fromMaybe '/' $ Seq.lookup 0 =<< cr ^? crInv . ix j . itAttachment . itCharMode
     j = _crInvSel cr
 
 charToPhaseV :: Fractional p => Char -> p

src/Dodge/Item/Weapon/TriggerType.hs

@@ -272,12 +272,12 @@ withTempLight time rad col eff item cr = eff item cr
     . over tempLightSources (theTLS :)
   where
     theTLS = defaultTLS
-        { _tlsPos = V3 x y 20
+        { _tlsPos = V3 x y 10
         , _tlsRad=rad
         , _tlsIntensity = col
         , _tlsTime = time
         }
-    V2 x y = _crPos cr +.+ 5 *.* unitVectorAtAngle (_crDir cr)
+    V2 x y = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
 
 withMuzFlareI :: ChainEffect
 withMuzFlareI f it cr w = tempLightForAt 3 pos2 -- . muzzleFlashAt pos2 
@@ -346,7 +346,7 @@ torqueAfterI torque feff item cr w
     cid = _crID cr
     (rot, g) = randomR (-torque,torque) $ _randGen w
     rotateScope = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
-                          . itAttachment . _Just . scopePos %~ rotateV rot 
+                          . itAttachment . scopePos %~ rotateV rot 
 spreadNumI :: ChainEffect
 spreadNumI eff item cr w = foldr f w dirs
   where

src/Dodge/Layout.hs

@@ -6,6 +6,7 @@ import Dodge.LevelGen.StaticWalls
 --import Dodge.LevelGen.Data
 import Dodge.Base
 import Dodge.Base.Zone
+import Dodge.GameRoom
 --import Dodge.RandomHelp
 import Dodge.Graph
 import Dodge.Layout.Tree.Polymorphic (applyToRoot)
@@ -41,6 +42,7 @@ generateLevelFromRoomList gr w = updateWallZoning
 --    . addRoomLinkDecorations rs
     $ w { _walls = wallsFromRooms rs
         , _floorTiles = floorsFromRooms rs
+        , _gameRooms  = gameRoomsFromRooms rs
         }
   where
     plmnts = concatMap _rmPS rs
@@ -123,6 +125,15 @@ wallsFromRooms =
   where
     f i (x,y) = defaultWall {_wlLine = (x,y) , _wlID = i}
 
+gameRoomsFromRooms :: [Room] -> [GameRoom]
+gameRoomsFromRooms = map f
+  where
+    f rm = GameRoom
+        { _grViewpoints = (map fst . foldl' (flip cutWalls) [] $ _rmPolys rm)
+            ++ map fst (_rmLinks rm)
+        , _grBound = expandPolyByFixed 100 $ convexHullSafe $ concat $ _rmBound rm ++ _rmPolys rm
+        }
+
 floorsFromRooms :: [Room] -> [(Point3,Point3)]
 floorsFromRooms = concatMap (concatMap tToRender . _rmFloor)
 

src/Dodge/LevelGen/StaticWalls.hs

@@ -133,14 +133,21 @@ cutPoly qs wls =
     ps = orderPolygon qs
     rs = orderPolygon $ nubOrd $ zs ++ qs
 -- | Given a value and a poly, pushes the poly points out from the center by the
--- value amount.
+-- factor amount.
 expandPolyBy :: Float -> [Point2] -> [Point2]
 expandPolyBy x ps = map f ps
   where
     --cp = 1/fromIntegral (length ps) *.* foldl' (+.+) (V2 0 0) ps
     cp = centroid ps
     f p = p +.+ x *.* (p -.- cp)
-    --f p = p +.+ x *.* normalizeV (p -.- cp)
+-- | Given a value and a poly, pushes the poly points out from the center by the
+-- fixed amount.
+expandPolyByFixed :: Float -> [Point2] -> [Point2]
+expandPolyByFixed x ps = map f ps
+  where
+    --cp = 1/fromIntegral (length ps) *.* foldl' (+.+) (V2 0 0) ps
+    cp = centroid ps
+    f p = p +.+ x *.* safeNormalizeV (p -.- cp)
 -- | Given a polygon expressed as a list of points and a collection of walls,
 -- returns: 
 -- fst: points of the polygon's intersection with walls

src/Dodge/Render.hs

@@ -8,7 +8,7 @@ import Dodge.Data
 import Dodge.Config.Data
 import Dodge.Base.Window
 import Dodge.Render.Picture
-import Dodge.Creature.ShadowBox
+--import Dodge.Creature.ShadowBox
 import Dodge.Creature.Silhouette
 import Geometry
 import Render

src/Dodge/Render/Picture.hs

@@ -224,9 +224,9 @@ lightsForGloom w = mapMaybe getLS (IM.elems $ _lightSources w) ++ mapMaybe getTL
   where 
     getLS ls  
         | dist campos (fst2 $ _lsPos ls) > 1000 = Nothing
-        | otherwise = Just ( _lsPos ls,  (_lsRad ls)^2 , _lsIntensity ls)
+        | otherwise = Just ( _lsPos ls,  _lsRad ls^(2::Int) , _lsIntensity ls)
     getTLS ls 
         | dist campos (fst2 $ _tlsPos ls) > 1000 = Nothing
-        | otherwise = Just ( _tlsPos ls, (_tlsRad ls)^2, _tlsIntensity ls)
+        | otherwise = Just ( _tlsPos ls, _tlsRad ls^(2::Int), _tlsIntensity ls)
     campos = _cameraCenter w
     fst2 (V3 a b _) = V2 a b

src/Dodge/Update/Camera.hs

@@ -14,6 +14,8 @@ import Dodge.Base.Collide
 import Dodge.Config.KeyConfig
 import Dodge.Item.Attachment.Data
 import Geometry
+import Geometry.ConvexPoly
+import Dodge.GameRoom
 
 import qualified Data.List.NonEmpty as NEL
 import Control.Lens
@@ -24,14 +26,16 @@ import qualified Data.IntMap.Strict as IM
 import qualified SDL
 import Data.Monoid
 import Data.Semigroup
+import qualified Control.Foldl as L
 {- Update the screen camera rotation and position, including any in rold scope/remote camera modifiers; 
 update where your avatar's view is from.  -}
 updateCamera :: World -> World
 updateCamera = rotCam . moveCamera . updateScopeZoom 
 {- Updte the center of the screen camera center and where your avatar's view is from in world. -}
 moveCamera :: World -> World
-moveCamera w = w & cameraCenter .~ idealPos
-                 & cameraViewFrom .~ sightFrom
+moveCamera w = w 
+    & cameraCenter .~ idealPos
+    & cameraViewFrom .~ sightFrom
   where 
     aimRangeFactor 
         | _cameraZoom w == 0 = 0
@@ -40,17 +44,13 @@ moveCamera w = w & cameraCenter .~ idealPos
         | SDL.ButtonRight `S.member` _mouseButtons w = 1
         | otherwise                                  = 0
     ypos = _crPos $ you w
-    --idealOffset = rotateV (_cameraRot w) (aimRangeFactor * aimingMult *.* _mousePos w)
-    --currentOffset = currentPos -.- camCenter
-    idealPos = camCenter +.+ rotateV (_cameraRot w) 
-                                      (aimRangeFactor * aimingMult *.* _mousePos w)
-    --currentPos = _cameraCenter w
-    camCenter  = ypos +.+ scope
-    isCam :: Bool
-    isCam = fromMaybe False $ yourItem w ^? itAttachment . _Just . scopeIsCamera
-    scope = fromMaybe (V2 0 0) $ yourItem w ^? itAttachment . _Just . scopePos
+    idealPos = camCenter 
+        +.+ rotateV (_cameraRot w) (aimRangeFactor * aimingMult *.* _mousePos w)
+    camCenter  = ypos +.+ scopeOffset
+    scopeOffset = fromMaybe (V2 0 0) $ yourItem w ^? itAttachment . scopePos
     sightFrom 
-        | isCam     = camCenter
+        | fromMaybe False $ yourItem w ^? itAttachment . scopeIsCamera
+                    = camCenter
         | otherwise = ypos
 
 updateScopeZoom :: World -> World
@@ -59,49 +59,50 @@ updateScopeZoom w
         Just x 
            | x > 9     -> zoomInLongGun $ zoomInLongGun
                             $ w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
-                                . itAttachment . _Just . scopeZoomChange -~ 2
+                                . itAttachment . scopeZoomChange -~ 2
            | x > 0     -> zoomInLongGun
                             $ w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
-                                . itAttachment . _Just . scopeZoomChange -~ 1
+                                . itAttachment . scopeZoomChange -~ 1
            | x < -9    -> zoomOutLongGun $ zoomOutLongGun
                             $ w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
-                                . itAttachment . _Just . scopeZoomChange +~ 2
+                                . itAttachment . scopeZoomChange +~ 2
            | x < 0     -> zoomOutLongGun $ zoomOutLongGun
                             $ w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
-                                . itAttachment . _Just . scopeZoomChange +~ 1
+                                . itAttachment . scopeZoomChange +~ 1
            | otherwise -> w
         _                  -> w
     | otherwise = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
-                                . itAttachment . _Just %~ updateScope
-    where scppoint = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
-                                . itAttachment . _Just . scopeZoomChange
-          updateScope (ItScope _ _ _ bl) = ItScope (V2 0 0) 0 1 bl
-          updateScope otherAtt = otherAtt
+                                . itAttachment %~ updateScope
+  where 
+    scppoint = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
+                          . itAttachment . scopeZoomChange
+    updateScope (ItScope _ _ _ bl) = ItScope (V2 0 0) 0 1 bl
+    updateScope otherAtt = otherAtt
 
 zoomSpeed :: Float
 zoomSpeed = 39/40
 
 zoomInLongGun :: World -> World
 zoomInLongGun w 
-    | currentZoom < 8 = over (wpPointer . itAttachment . _Just . scopePos)
+    | currentZoom < 8 = over (wpPointer . itAttachment . scopePos)
         (\p -> p +.+ (4-(4*zoomSpeed)) / currentZoom *.* mousep) 
-        $ over (wpPointer . itAttachment . _Just . scopeZoom) (/ zoomSpeed)
+        $ over (wpPointer . itAttachment . scopeZoom) (/ zoomSpeed)
         w
     | otherwise = w
   where 
     wpPointer = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
     wp = _crInv (_creatures w IM.! 0) IM.! _crInvSel (_creatures w IM.! 0)
-    Just currentZoom = wp ^? itAttachment . _Just . scopeZoom
+    Just currentZoom = wp ^? itAttachment . scopeZoom
     mousep = rotateV (_cameraRot w) $ _mousePos w
 
 zoomOutLongGun :: World -> World
 zoomOutLongGun w 
-    | currentZoom > 0.5 = over (wpPointer . itAttachment . _Just . scopeZoom) (* zoomSpeed) w
+    | currentZoom > 0.5 = over (wpPointer . itAttachment . scopeZoom) (* zoomSpeed) w
     | otherwise = w
   where 
     wpPointer = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
     wp = _crInv (_creatures w IM.! 0) IM.! _crInvSel (_creatures w IM.! 0)
-    Just currentZoom = wp ^? itAttachment . _Just . scopeZoom
+    Just currentZoom = wp ^? itAttachment . scopeZoom
     --currentCursorDisplacement = fromJust $ _itAttachment wp
 
 rotCam :: World -> World
@@ -115,13 +116,13 @@ rotateCameraL w
     | rotateCameraPlusKey (_keyConfig w) `S.member` _keys w
         = w & cameraRot +~ 0.015
             & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
-                                . itAttachment . _Just . scopePos %~ rotateV 0.015
+                                . itAttachment . scopePos %~ rotateV 0.015
     | otherwise = w
 rotateCameraR :: World -> World
 rotateCameraR w | rotateCameraMinusKey (_keyConfig w) `S.member` _keys w
                     = w & cameraRot -~ 0.015
                         & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
-                                . itAttachment . _Just . scopePos %~ rotateV (-0.015)
+                                . itAttachment . scopePos %~ rotateV (-0.015)
                 | otherwise = w
 zoomCamIn :: World -> World
 zoomCamIn w | zoomInKey (_keyConfig w) `S.member` _keys w
@@ -132,38 +133,64 @@ zoomCamOut w | zoomOutKey (_keyConfig w) `S.member` _keys w
                     = w {_cameraZoom = max (_cameraZoom w - 0.01) 0.01}
              | otherwise = w
 
-{- 
-Automatically sets the zoom of the camera according to the surrounding walls.
- -}
+zoomFromItem 
+    :: ItZoom
+    -> Float -- ^ Furthest viewable distance
+    -> Float
+zoomFromItem ItZoom {_itZoomMax = zMax, _itZoomMin = zMin, _itZoomFac = zFac}
+    = min zMax . max zMin . (zFac *)
+zoomNoItem 
+    :: Float -- ^ Furthest viewable distance
+    -> Float
+zoomNoItem = min 20 . max 0.2
+{- Automatically sets the zoom of the camera according to the surrounding walls.  -}
 autoZoomCam :: World -> World
 autoZoomCam w = over cameraZoom changeZoom w
   where 
     camPos = _cameraViewFrom w
-    wallZoom = farWallDist camPos w
-    idealZoom | SDL.ButtonRight `S.member` _mouseButtons w 
-                  = scZoom * 
-                      min (fromMaybe 20 $ yourItem w ^? itZoom . itAimZoomMax)
-                        ( max (fromMaybe 0.2 $ yourItem w ^? itZoom . itAimZoomMin)
-                              (wallZoom * fromMaybe 1 (yourItem w ^? itZoom . itAimZoomFac))
-                        )
-              | otherwise
-                  = min (fromMaybe 20 $ yourItem w ^? itZoom . itZoomMax)
-                        $ max (fromMaybe 0.2 (yourItem w ^? itZoom . itZoomMin))
-                              (wallZoom * fromMaybe 1 (yourItem w ^? itZoom . itZoomFac))
+    wallZoom = farWallDist' camPos w
+    idealZoom 
+        | SDL.ButtonRight `S.member` _mouseButtons w 
+            = theScopeZoom * maybe zoomNoItem zoomFromItem (yourItem w ^? itAimZoom) wallZoom
+        | otherwise
+            = maybe zoomNoItem zoomFromItem (yourItem w ^? itZoom) wallZoom
     changeZoom curZoom 
       | curZoom > idealZoom + 0.01 = ((zoomOutSpeed-1)*curZoom + idealZoom) / zoomOutSpeed
-      | curZoom < idealZoom - 0.01 = ((zoomInSpeed-1)*curZoom + idealZoom) / zoomInSpeed
+      | curZoom < idealZoom - 0.01 = ((zoomInSpeed -1)*curZoom + idealZoom) / zoomInSpeed
       | otherwise                  = idealZoom
     -- these speeds are inverted, larger means slower
     zoomInSpeed  = 25
     zoomOutSpeed = 15
-    scZoom = fromMaybe 1 $ yourItem w ^? itAttachment . _Just . scopeZoom
+    theScopeZoom = fromMaybe 1 $ yourItem w ^? itAttachment . scopeZoom
 
+farWallDist' :: Point2 -> World -> Float
+farWallDist' p w = (winFac /) $ fromMaybe 800 $ L.fold L.maximum vdists
+  where
+    hw = halfWidth w
+    hh = halfHeight w
+    winFac = min hw hh
+    vdists = map (flip (collideDirectionIndirect 800 p) wos)
+        vps
+    vps = concatMap _grViewpoints grs
+    grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)
+    wos = wallsOnScreen w
+    
 
+-- | Find the furthest viewable distance from a given point in the world
 farWallDist :: Point2 -> World -> Float
 --{-# INLINE farWallDist #-}
-farWallDist cpos w = getMin . uncurry (<>) $ bimap (toScale hw) (toScale hh) $ sconcat $ NEL.map distsMaybeTo viewTestValues
+farWallDist cpos w 
+    = getMin 
+    . uncurry (<>) 
+    $ bimap (toScale hw) (toScale hh) 
+    $ sconcat 
+    $ NEL.map distsMaybeTo viewTestValues
   where
+    wos = wallsOnScreen w
+    camRot = _cameraRot w
+    hw = halfWidth w
+    hh = halfHeight w
+    toScale x = Min . (x /) . (+ 50) . maybe maxViewDistance getMax . getAp
     distsMaybeTo x = (valueAtWidth x,valueAtHeight x)
     valueAtHeight h  = cpiv (cpos +.+ x) <> cpiv (cpos -.- x)
       where
@@ -177,17 +204,9 @@ farWallDist cpos w = getMin . uncurry (<>) $ bimap (toScale hw) (toScale hh) $ s
         cpih p = Ap $ Max . verSize <$> collidePointIndirect cpos p wos
         verSize = abs . dotV rh . (-.- cpos)
         rh = rotateV camRot (V2 0 1)
-    wos = wallsOnScreen w
-    camRot = _cameraRot w
-    hw = halfWidth w
-    hh = halfHeight w
-    toScale x = Min . (x /) . (+ 50) . maybe maxViewDistance getMax . getAp
 
 viewTestValues :: NEL.NonEmpty Float
 viewTestValues = NEL.fromList [-maxViewDistance,negate $ 0.75*maxViewDistance..maxViewDistance]
 
 maxViewDistance :: Float
 maxViewDistance = 800
-
---dirRays :: Float -> [Point2]
---dirRays dir = take 11 $ iterate (rotateV (0.5 * pi / 10)) $ rotateV (dir-pi*0.25) (600,0)

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -91,18 +91,18 @@ moveFlame
 moveFlame rotd w pt 
     | time <= 0 = (smokeGen w, Nothing)
     | otherwise = case thingsHitExceptCr (_btPassThrough' pt) sp ep w of
-        ((_,E3x1 _):_)       -> (soundAndGlare damcrs        , mvPt')
+        ((_,E3x1 _):_)       -> (doSound damcrs        , mvPt')
         (thing@(p,E3x2 wl):_) -> (fst $ hiteff [thing] damcrs , rfl wl p)
-        _                     -> (glare $ soundAndGlare damcrs        , mvPt)
+        _                     -> (glare $ doSound damcrs        , mvPt)
   where 
     time = _btTimer' pt
-    soundAndGlare = soundFrom Flame fireSound 2 500 -- . over worldEvents ((.) $ flameGlareAt ep)
+    doSound = soundFrom Flame fireSound 2 500 -- . over worldEvents ((.) $ flameGlareAt ep)
     glare 
         | time `mod` 5 == 0
                     = tempLightSources %~ (theTLS :)
         | otherwise = id
     theTLS = defaultTLS
-        { _tlsPos = V3 x y 15
+        { _tlsPos = V3 x y 10
         , _tlsRad = 70
         , _tlsIntensity = V3 0.5 0 0
         }

src/FoldableHelp.hs

@@ -2,14 +2,18 @@
 module FoldableHelp
     ( safeMinimumOn
     , safeMinimumOnMaybe
+    , safeMinimumOnMaybeF
+    , safeMinimumOnMaybeL
+    , safeMinMaybeL
     , module Data.Foldable
     )
     where
 import Data.Foldable
 
+import qualified Control.Foldl as L
 -- TODO check up whether and how it is necessary to specialise this
 -- | A version of 'minimum' where the comparison is done on some extracted value.
---   Returns Nothing if the list is empty. Only calls the function once per element (not true).
+--   Returns Nothing if the list is empty.
 --
 -- > safeMinimumOn id [] == Nothing
 -- > safeMinimumOn length ["test","extra","a"] == Just "a"
@@ -21,6 +25,34 @@ safeMinimumOn f = foldl' g Nothing
         | f x < f y = Just x
         | otherwise = Just y
     g Nothing y = Just y
+safeMinimumOnMaybeF :: (Ord b) => (a -> Maybe b) -> [a] -> Maybe a
+safeMinimumOnMaybeF f = L.fold $ L.Fold step initial extract
+  where
+    initial = Nothing
+    step Nothing      x  = (x ,) <$> f x
+    step (Just (a,x)) b = case f b of
+        Just y | y < x  -> Just (b,y)
+        _               -> Just (a,x)
+    extract = fmap fst
+safeMinMaybeL :: (Ord b) => (a -> Maybe b) -> L.Fold a (Maybe b)
+safeMinMaybeL f = L.Fold step initial id
+  where
+    initial = Nothing
+    step Nothing x  = f x
+    step (Just x) b = case f b of
+        Just y | y < x  -> Just y
+        _               -> Just x
+
+safeMinimumOnMaybeL :: (Ord b) => (a -> Maybe b) -> L.Fold a (Maybe a)
+safeMinimumOnMaybeL f = L.Fold step initial extract
+  where
+    initial = Nothing
+    step Nothing      x  = (x ,) <$> f x
+    step (Just (a,x)) b = case f b of
+        Just y | y < x  -> Just (b,y)
+        _               -> Just (a,x)
+    extract = fmap fst
+
 safeMinimumOnMaybe :: (Ord b) => (a -> Maybe b) -> [a] -> Maybe a
 safeMinimumOnMaybe f ys = fst <$> go Nothing ys
   where
@@ -29,6 +61,8 @@ safeMinimumOnMaybe f ys = fst <$> go Nothing ys
         Just v | v < cmin -> go (Just (x,v)) xs
         _                 -> go (Just (y,cmin)) xs
     go m _ = m
+
+
 --{- | Partial. -}
 --minimumOn :: Ord b => (a -> b) -> [a] -> a
 --minimumOn f [] = error "tried to take minimumOn of empty list"

src/FoldlHelp.hs

@@ -0,0 +1,30 @@
+module FoldlHelp
+    ( minimumOn
+    , premapMaybe
+    , module Control.Foldl
+    )
+    where
+import Control.Foldl
+
+data Maybe' a = Just' !a | Nothing'
+data Pair a b = !a :!: !b
+
+minimumOn :: Ord b => (a -> b) -> Fold a (Maybe a)
+minimumOn f = Fold step Nothing' extract
+  where
+    extract Nothing' = Nothing
+    extract (Just' (a :!: _)) = Just a
+    step Nothing' b = Just' (b :!: f b)
+    step (Just' (a :!: x)) b
+        | y < x     = Just' (b :!: y)
+        | otherwise = Just' (a :!: x)
+      where
+        y = f b
+
+premapMaybe :: (a -> Maybe b) -> Fold b r -> Fold a r
+{-# INLINABLE premapMaybe #-}
+premapMaybe f (Fold step initial extract) = Fold step' initial extract
+  where
+    step' x a = case f a of
+        Nothing -> x
+        Just s  -> step x s

src/Geometry.hs

@@ -128,15 +128,20 @@ addPointPolygon p ps
     | pointInOrOnPolygon p ps = ps
     | otherwise = orderPolygon $ p : ps
 -- | Creates the convex hull of a set of points.
+-- Need to verify whether or not this is ordered
 convexHull :: [Point2] -> [Point2]
 convexHull (x:y:z:xs) = grahamScan $ orderAroundFirst $ sortOn (\(V2 a b) -> (b,a)) (x:y:z:xs)
 convexHull _ = error "Tried to create the convex hull of two or fewer points"
+-- | Creates the convex hull of a set of points.
+-- Need to verify whether or not this is ordered
+convexHullSafe :: [Point2] -> [Point2]
+convexHullSafe (x:y:z:xs) = grahamScan $ orderAroundFirst $ sortOn (\(V2 a b) -> (b,a)) (x:y:z:xs)
+convexHullSafe _ = []
 
 grahamScan :: [Point2] -> [Point2]
 grahamScan = foldr push []
   where
     push point stack = grahamEliminate (point:stack)
-
 -- | Remove second element if top three elements are not counterclockwise.
 -- Repeat if necessary. See 
 -- https://codereview.stackexchange.com/questions/206019/graham-scan-algorithm-in-haskell

src/Geometry/ConvexPoly.hs

@@ -8,6 +8,7 @@ module Geometry.ConvexPoly
     , centroid
     , pointsToPoly
     , convexPolysOverlap
+    , pointInPolyPoints
     ) where
 import Geometry.Data
 import Geometry.Vector