Improvements to rooms and view distances

src/Dodge/Item/Weapon/ExtraEffect.hs

@@ -57,23 +57,21 @@ defaultTargeting = TargetingOnHeld
     , _tgDraw = \_ _ _ _ -> mempty
     , _tgID = Nothing
     , _tgActive = False
-    , _tgPoints = []
     }
 targetLaser :: Targeting
 targetLaser = defaultTargeting
     & tgUpdate  .~ targetLaserUpdate
-    & tgDraw    .~ targetLaserDraw
 targetRBPress :: Targeting
 targetRBPress = defaultTargeting
-    & tgUpdate  .~ targetRBPressUpdate
+    & tgUpdate  .~ targetUpdateWith targetRBPressUpdate
     & tgDraw    .~ targetSimpleDraw
 targetRBCreature :: Targeting
 targetRBCreature = defaultTargeting
-    & tgUpdate  .~ targetRBCreatureUpdate
+    & tgUpdate  .~ targetUpdateWith targetRBCreatureUpdate
     & tgDraw    .~ targetRBCreatureDraw
 targetCursor :: Targeting
 targetCursor = defaultTargeting
-    & tgUpdate  .~ targetCursorUpdate
+    & tgUpdate  .~ targetUpdateWith targetCursorUpdate
     & tgDraw    .~ targetSimpleDraw
 targetSimpleDraw :: Int -> Item -> Creature -> World -> Picture
 targetSimpleDraw _ it _ w = fromMaybe mempty $ do
@@ -101,31 +99,32 @@ targetRBCreatureDraw _ it _ w = fromMaybe mempty $ do
     thecolor | _tgActive $ _itTargeting it = red
         | otherwise = blue
 
-targetCursorUpdate :: Item -> Creature -> World -> Targeting -> (World,Targeting)
-targetCursorUpdate _ _ w t
-    | SDL.ButtonRight `S.member` _mouseButtons w = (,) w $ t
+targetUpdateWith :: (World -> Targeting -> Targeting)
+    -> Item -> Creature -> World -> Targeting -> (World,Targeting)
+targetUpdateWith f _ _ w t = (w, f w t)
+
+targetCursorUpdate :: World -> Targeting -> Targeting
+targetCursorUpdate w t
+    | SDL.ButtonRight `S.member` _mouseButtons w = t
         & tgPos . _Just .~ mouseWorldPos w
         & tgActive .~ True
-    | otherwise = (,) w $ t & tgPos %~ const Nothing
+    | otherwise = t & tgPos %~ const Nothing
         & tgActive .~ False
 
-targetRBPressUpdate :: Item -> Creature -> World -> Targeting -> (World,Targeting)
-targetRBPressUpdate _ _ w t
-    | SDL.ButtonRight `S.member` _mouseButtons w = (w,t
+targetRBPressUpdate :: World -> Targeting -> Targeting
+targetRBPressUpdate w t
+    | SDL.ButtonRight `S.member` _mouseButtons w = t
         & tgPos %~ maybe (Just $ mouseWorldPos w) Just
         & tgActive .~ True
-        )
-    | otherwise = (w,t & tgPos %~ const Nothing
+    | otherwise = t & tgPos %~ const Nothing
         & tgActive .~ False
-        )
 
-targetRBCreatureUpdate :: Item -> Creature -> World -> Targeting -> (World,Targeting)
-targetRBCreatureUpdate _ _ w t
+targetRBCreatureUpdate :: World -> Targeting -> Targeting
+targetRBCreatureUpdate w t
     | SDL.ButtonRight `S.member` _mouseButtons w && isJust (t ^? tgID . _Just)
-                = (w,t & updatePos
+                = t & updatePos
         & tgActive .~ True
-        )
-    | otherwise = (,) w $ t & tgID .~ fmap _crID (creatureNearPointI 3 mwp w)
+    | otherwise = t & tgID .~ fmap _crID (creatureNearPointI 3 mwp w)
         & updatePos
         & tgActive .~ False
   where
@@ -134,31 +133,13 @@ targetRBCreatureUpdate _ _ w t
     posFromMaybeID Nothing = Nothing
     posFromMaybeID (Just i) = w ^? creatures . ix i . crPos
 
-targetLaserDraw :: Int -> Item -> Creature -> World -> Picture
-targetLaserDraw _ it _ _ = mempty 
---  fromMaybe mempty $ do
---    ps <- it ^? itTargeting . tgPoints
---    return $ setLayer 1 $ pictures
---        [ setDepth 19   . color (brightX 0 0.5 col) $ thickLine 5 ps
---        , setDepth 19.5 . color (brightX 5 1 col)  $ thickLine 1  ps
---        ]
---  where
---    wpammo = _itConsumption it
---    reloadFrac 
---        | _ammoLoaded wpammo == 0 = 1
---        | otherwise = case _reloadState wpammo of
---            Just' rs -> fromIntegral rs / fromIntegral (_reloadTime wpammo)
---            Nothing' -> 1
---    col = mixColors reloadFrac (1-reloadFrac) red green
 targetLaserUpdate :: Item -> Creature -> World -> Targeting -> (World,Targeting)
-targetLaserUpdate _ cr w t
+targetLaserUpdate it cr w t
     | crIsAiming cr = (addLaserPic w,t
         & tgPos    .~ fmap fst mp
-        & tgPoints .~ sp:ps
         & tgActive .~ True
         )
     | otherwise = (w,t & tgPos %~ const Nothing
-        & tgPoints .~ []
         & tgActive .~ False
         )
   where
@@ -167,8 +148,15 @@ targetLaserUpdate _ cr w t
     ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos w -.- sp)
     addLaserPic = instantParticles .:~ Particle
         { _ptDraw = const $ setLayer 1 $ pictures
-            [ setDepth 19   . color (brightX 0 0.5 red) $ thickLine 5 (sp:ps)
-            , setDepth 19.5 . color (brightX 5 1 red)  $ thickLine 1  (sp:ps)
+            [ setDepth 19   . color (brightX 0 0.5 col) $ thickLine 5 (sp:ps)
+            , setDepth 19.5 . color (brightX 5 1 col)  $ thickLine 1  (sp:ps)
             ]
         , _ptUpdate = ptSimpleTime 1
         }
+    wpammo = _itConsumption it
+    reloadFrac 
+        | _ammoLoaded wpammo == 0 = 1
+        | otherwise = case _reloadState wpammo of
+            Just' rs -> fromIntegral rs / fromIntegral (_reloadTime wpammo)
+            Nothing' -> 1
+    col = mixColors reloadFrac (1-reloadFrac) blue red