Fix laser targeting draw when creature offscreen

This commit is contained in:
2022-03-06 22:58:05 +00:00
parent f82bd3f788
commit 1364e7c8c8
14 changed files with 108 additions and 138 deletions
+43 -29
View File
@@ -20,12 +20,13 @@ import Dodge.Item.Weapon.LaserPath
--import Dodge.Item.Attachment.Data
import Dodge.Picture.Layer
import Dodge.Creature.Test
import Dodge.WorldEvent.HelperParticle
import Picture
import Geometry.Vector
import Geometry.Data
import LensHelp
import Data.Maybe
import Control.Lens
import qualified Data.Set as S
import qualified SDL
{- | Automatically send out radar pulses that detect walls. -}
@@ -52,7 +53,7 @@ autoSonarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 }
defaultTargeting :: Targeting
defaultTargeting = TargetingOnHeld
{ _tgPos = Nothing
, _tgUpdate = \_ _ _ -> id
, _tgUpdate = \_ _ w t -> (w,t)
, _tgDraw = \_ _ _ _ -> mempty
, _tgID = Nothing
, _tgActive = False
@@ -100,28 +101,31 @@ targetRBCreatureDraw _ it _ w = fromMaybe mempty $ do
thecolor | _tgActive $ _itTargeting it = red
| otherwise = blue
targetCursorUpdate :: Item -> Creature -> World -> Targeting -> Targeting
targetCursorUpdate :: Item -> Creature -> World -> Targeting -> (World,Targeting)
targetCursorUpdate _ _ w t
| SDL.ButtonRight `S.member` _mouseButtons w = t
| SDL.ButtonRight `S.member` _mouseButtons w = (,) w $ t
& tgPos . _Just .~ mouseWorldPos w
& tgActive .~ True
| otherwise = t & tgPos %~ const Nothing
| otherwise = (,) w $ t & tgPos %~ const Nothing
& tgActive .~ False
targetRBPressUpdate :: Item -> Creature -> World -> Targeting -> Targeting
targetRBPressUpdate :: Item -> Creature -> World -> Targeting -> (World,Targeting)
targetRBPressUpdate _ _ w t
| SDL.ButtonRight `S.member` _mouseButtons w = t
| SDL.ButtonRight `S.member` _mouseButtons w = (w,t
& tgPos %~ maybe (Just $ mouseWorldPos w) Just
& tgActive .~ True
| otherwise = t & tgPos %~ const Nothing
)
| otherwise = (w,t & tgPos %~ const Nothing
& tgActive .~ False
)
targetRBCreatureUpdate :: Item -> Creature -> World -> Targeting -> Targeting
targetRBCreatureUpdate :: Item -> Creature -> World -> Targeting -> (World,Targeting)
targetRBCreatureUpdate _ _ w t
| SDL.ButtonRight `S.member` _mouseButtons w && isJust (t ^? tgID . _Just)
= t & updatePos
= (w,t & updatePos
& tgActive .~ True
| otherwise = t & tgID .~ fmap _crID (creatureNearPointI 3 mwp w)
)
| otherwise = (,) w $ t & tgID .~ fmap _crID (creatureNearPointI 3 mwp w)
& updatePos
& tgActive .~ False
where
@@ -131,30 +135,40 @@ targetRBCreatureUpdate _ _ w t
posFromMaybeID (Just i) = w ^? creatures . ix i . crPos
targetLaserDraw :: Int -> Item -> Creature -> World -> Picture
targetLaserDraw _ it _ _ = 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 -> Targeting
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
| crIsAiming cr = t
| crIsAiming cr = (addLaserPic w,t
& tgPos .~ fmap fst mp
& tgPoints .~ sp:ps
& tgActive .~ True
| otherwise = t & tgPos %~ const Nothing
)
| otherwise = (w,t & tgPos %~ const Nothing
& tgPoints .~ []
& tgActive .~ False
)
where
(mp, ps) = reflectLaserAlong 0.2 [] sp ep w
sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
ep = sp +.+ 1000 *.* normalizeV (mouseWorldPos w -.- sp)
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)
]
, _ptUpdate = ptSimpleTime 1
}