Fix laser targeting draw when creature offscreen
This commit is contained in:
@@ -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
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user