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
+5 -5
View File
@@ -94,10 +94,10 @@ longCrit = defaultCreature
, _crStrategy = StrategyActions WatchAndWait [StartSentinelPost]
, _crGoal = []
}
, _crInv = IM.fromList [(0,longGun),(1,medkit 100)]
, _crInv = IM.fromList [(0,sniperRifle),(1,medkit 100)]
, _crInvSel = 0
, _crRad = 10
, _crHP = 300
, _crHP = 150
}
multGunCrit :: Creature
multGunCrit = defaultCreature
@@ -173,9 +173,9 @@ testInventory = IM.fromList $ zip [0..]
, makeTypeCraftNum 1 LIGHTER
, makeTypeCraftNum 5 TUBE
-- , makeTypeCraftNum 5 CREATURESENSOR
-- , makeTypeCraftNum 3 PRISM
, makeTypeCraftNum 3 DRUM
, makeTypeCraftNum 3 PUMP
, makeTypeCraftNum 3 PRISM
-- , makeTypeCraftNum 3 DRUM
-- , makeTypeCraftNum 3 PUMP
-- , makeTypeCraftNum 1 MAGNET
, makeTypeCraftNum 5 HARDWARE
, makeTypeCraftNum 3 SPRING
+4 -3
View File
@@ -150,10 +150,11 @@ invSideEff cr w = weaponReloadSounds cr
itpointer = creatures . ix (_crID cr) . crInv . ix i
doHeldItemTargeting :: Creature -> World -> World
doHeldItemTargeting cr w = case cr ^? crInv . ix (_crInvSel cr) . itTargeting . tgUpdate of
doHeldItemTargeting cr w = case cr ^? crInv . ix (_crInvSel cr) . itTargeting of
Nothing -> w
Just f -> w & creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . itTargeting
%~ f (_crInv cr IM.! _crInvSel cr) cr w
Just NoTargeting -> w
Just t -> let (w',t') = _tgUpdate t (_crInv cr IM.! _crInvSel cr) cr w t
in w' & creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . itTargeting .~ t'
weaponReloadSounds :: Creature -> World -> World
weaponReloadSounds cr w = case cr ^? crInv . ix (_crInvSel cr) . itConsumption of
+2 -1
View File
@@ -71,6 +71,7 @@ data World = World
, _cameraRot :: Float
, _cameraZoom :: Float
, _cameraViewFrom :: Point2
, _viewDistance :: Float
, _creatures :: IM.IntMap Creature
, _creaturesZone :: Zone (IM.IntMap Creature)
, _creatureGroups :: IM.IntMap CrGroupParams
@@ -381,7 +382,7 @@ data Targeting
= NoTargeting
| TargetingOnHeld
{ _tgPos :: Maybe Point2
, _tgUpdate :: Item -> Creature -> World -> Targeting -> Targeting
, _tgUpdate :: Item -> Creature -> World -> Targeting -> (World, Targeting)
, _tgDraw :: Int -> Item -> Creature -> World -> Picture
, _tgID :: Maybe Int
, _tgActive :: Bool
+1
View File
@@ -25,6 +25,7 @@ defaultWorld = World
, _cameraRot = 0
, _cameraZoom = 1
, _cameraViewFrom = V2 0 0
, _viewDistance = 1000
, _modifications = IM.empty
, _creatures = IM.empty
, _creaturesZone = Zone IM.empty
+2 -1
View File
@@ -34,8 +34,9 @@ import System.Random
initialAnoTree :: RandomGen g => Tree [Annotation g]
initialAnoTree = padSucWithCorridors $ treeFromTrunk
[[AnoApplyInt 0 startRoom]
, [SpecificRoom shootingRange]
, [SpecificRoom $ fmap (return . PassDown) longRoom]
, [PassthroughLockKeyLists 2 lockRoomKeyItems itemRooms]
, [SpecificRoom randomChallenges]
, [AnoApplyInt 1 lasSensorTurretTest]
-- ,[ChainAnos
-- [[SetLabel 0 $ return $ roomRectAutoLinks 200 200
+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
}
+1 -1
View File
@@ -171,7 +171,7 @@ jsps :: Point2 -> Float -> PSType -> Maybe Placement
jsps p a pst = Just $ Placement (PS p a) pst Nothing $ const Nothing
jsps0 :: PSType -> Maybe Placement
jsps0 pst = Just $ sPS (V2 0 0) 0 pst
jsps0 = Just . sPS (V2 0 0) 0
sps0 :: PSType -> Placement
sps0 = sPS (V2 0 0) 0
+1 -2
View File
@@ -13,7 +13,6 @@ lightsForGloom w = mapMaybe getLS (IM.elems $ _lightSources w) ++ mapMaybe getTL
getLS = getlsparam . _lsParam
getTLS = getlsparam . _tlsParam
getlsparam ls
| dist campos (fst2 $ _lsPos ls) > 1000 = Nothing
| dist (_cameraCenter w) (fst2 $ _lsPos ls) > _viewDistance w + _lsRad ls = Nothing
| otherwise = Just ( _lsPos ls, _lsRad ls^(2::Int) , _lsCol ls)
campos = _cameraCenter w
fst2 (V3 a b _) = V2 a b
+4 -4
View File
@@ -25,6 +25,7 @@ import qualified Data.Map.Strict as M
--import Control.Lens
--import Data.Maybe
-- TODO only filter out shapes outside the range of the furthest shown light source
worldSPic :: Configuration -> World -> SPic
worldSPic cfig w =
(extraShapes w, extraPics cfig w)
@@ -35,13 +36,13 @@ worldSPic cfig w =
<> foldMap mcSPic (filtOn _mcPos _machines)
where
filtOn f g = IM.filter (pointIsClose . f) (g w)
pointIsClose p = dist camCen p < winSize
winSize = 30 + max (_windowX cfig) (_windowY cfig)
pointIsClose p = dist camCen p < 30 + _viewDistance w
camCen = _cameraCenter w
extraShapes :: World -> Shape
extraShapes = _foregroundShape
-- TODO filter out pictures not in the frame
extraPics :: Configuration -> World -> Picture
extraPics cfig w = pictures (_decorations w)
<> concatMapPic (dbArg _ptDraw) (_particles w)
@@ -53,7 +54,6 @@ extraPics cfig w = pictures (_decorations w)
<> viewBoundaries cfig w
<> drawPathing cfig w
-- TODO remove duplicate!
testPic :: World -> Picture
testPic _ = []
clDraw :: Cloud -> Picture
@@ -73,7 +73,7 @@ mcSPic bt = uncurryV translateSPf (_mcPos bt)
$ rotateSP (_mcDir bt) (_mcDraw bt bt)
soundPics :: Configuration -> World -> Picture
soundPics cfig w
soundPics cfig w
| _show_sound cfig = pictures $ M.map (soundPic cfig w) $ _playingSounds w
| otherwise = []
-34
View File
@@ -14,7 +14,6 @@ module Dodge.Room.Link
, randomiseAllLinks
, shuffleLinks
, filterLinks
, changeLinkTo
, randomiseOutLinks
, chooseOneInLink
, restrictRMInLinksPD
@@ -78,43 +77,10 @@ shuffleLinks r = do
newLinks <- shuffle $ _rmLinks r
return $ r {_rmLinks = newLinks }
--randomiseLinksBy
-- :: ( [(Point2,Float)] -> State g [(Point2,Float)] )
-- -> Room
-- -> State g Room
--randomiseLinksBy f r = do
-- newLinks <- f $ _rmOutLinks r ++ _rmInLinks r
-- return $ r {_rmOutLinks = init newLinks
-- , _rmInLinks = [last newLinks]
-- }
filterLinks :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
filterLinks cond r = do
newLinks <- shuffle $ filter (cond . lnkPosDir) $ _rmLinks r
return $ r {_rmLinks = newLinks}
{- | Swaps the last link in the list with one that satisfies a given
- property (it might swap with itself). Unsafe.
- Be careful about calling this after changeLinkFrom. -}
-- TODO replace with something more sensible
changeLinkTo :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
changeLinkTo cond r = do
let alllinks = _rmLinks r
l <- takeOne $ filter (cond . lnkPosDir) alllinks
let l' = l & rlType .~ S.singleton InLink
let newLinks = delete l alllinks
return $ r & rmLinks .~ (l':newLinks)
{- | Move a room so that the first link in '_rmInLinks' lines up to
an external point and direction.
This is intended to work when the external point is an outgoing link from another room.
-}
--shiftRoomToLink :: (Point2,Float) -> Room -> Room
--shiftRoomToLink l r
-- = shiftRoomBy l
-- . shiftRoomBy (V2 0 0 , pi-a)
-- $ shiftRoomBy (V2 0 0 -.- p , 0)
-- r
-- where
-- (p,a) = lnkPosDir $ head $ _rmInLinks r
doRoomShift :: Room -> Room
doRoomShift rm = shiftRoomBy (_rmShift rm) rm & rmShift .~ _rmShift rm
+32 -50
View File
@@ -22,8 +22,8 @@ import Dodge.Room.Airlock
import Geometry
import Tile
import MonadHelp
import LensHelp
import Control.Lens
import Control.Monad.State
--import Control.Monad.Loops
import System.Random
@@ -142,40 +142,30 @@ glassSwitchBackCrits = glassSwitchBack
] ++)
miniTree2 :: RandomGen g => State g (SubCompTree Room)
miniTree2 = restrictInLinks (\p -> (sndV2 . fst) p < 70) <$> glassSwitchBackCrits
>>= randomiseAllLinks
miniTree2 = (glassSwitchBackCrits
>>= randomiseAllLinks . restrictInLinks (\p -> (sndV2 . fst) p < 70))
<&> flip branchWith (replicate 3 $ treeFromPost [door,corridor] critInDeadEnd)
miniRoom3 :: RandomGen g => State g (SubCompTree Room)
miniRoom3 = do
w <- state $ randomR (300,400)
h <- state $ randomR (300,400)
let cp = V2 0 (h/2+40)
let b = PutBlock StoneBlock 5 [20,20] baseBlockPane $ map toV2 [(-10,-60)
,( 10,-60)
,( 10,-80)
,(-10,-80)
]
let plmnts = [sPS cp 0 $ PutCrit miniGunCrit
,sPS cp 0 $ windowLineType (V2 0 (-40)) (V2 0 (-80))
,sPS cp (1*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
,sPS cp (2*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
,sPS cp (3*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
,sPS cp (4*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
,sPS cp (5*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
,sPS cp (6*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
,sPS cp (7*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
,sPS cp (pi/8) b
,sPS cp (pi/8+1*pi/4) b
,sPS cp (pi/8+2*pi/4) b
,sPS cp (pi/8+3*pi/4) b
,sPS cp (pi/8+4*pi/4) b
,sPS cp (pi/8+5*pi/4) b
,sPS cp (pi/8+6*pi/4) b
,sPS cp (pi/8+7*pi/4) b
,sPS (V2 (w/2) (h/2)) 0 putLamp
]
fmap singleUseAll $ randomiseOutLinks $ set rmPmnts plmnts $ roomRectAutoLinks w h
w <- state $ randomR (300,400)
h <- state $ randomR (300,400)
let cp = V2 0 (h/2+40)
let b = PutBlock StoneBlock 5 [20,20] baseBlockPane $ map toV2 [(-10,-60)
,( 10,-60)
,( 10,-80)
,(-10,-80)
]
let plmnts =
[ sPS cp (fromIntegral i*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
| i <- [0..7::Int]
] ++
[ sPS cp (pi/8+fromIntegral i*pi/4) b
| i <- [0..7::Int]
] ++
[ sPS cp 0 $ PutCrit miniGunCrit
, sPS (V2 (w/2) (h/2)) 0 putLamp ]
fmap singleUseAll $ randomiseOutLinks $ set rmPmnts plmnts $ roomRectAutoLinks w h
rot90Around :: Point2 -> Point2 -> Point2
rot90Around cen p = cen +.+ vNormal (p -.- cen)
@@ -371,26 +361,18 @@ longRoom = do
h <- state $ randomR (1500,1500)
let w = 75
let cond x = (sndV2 . fst) x < h - 40
let ws = map (\ps -> sPS (V2 0 0) 0 $ PutWall ps defaultCrystalWall)
[rectNSWE (h-35) (h-135) (-10) 10
,rectNSWE (h-35) (h-135) 15 35
,rectNSWE (h-35) (h-135) 40 60
,rectNSWE (h-35) (h-135) 65 85
]
let wsDefense = map (\ps -> sPS (V2 0 0) 0 $ PutWall ps defaultCrystalWall)
[rectNSWE 95 70 0 25
,rectNSWE 95 70 50 75
]
brls <- fmap (map (\p -> sPS (p +.+ V2 10 200) 0 $ PutCrit explosiveBarrel) )
$ replicateM 5 $ randInRect (w-20) 900
let rm = roomRect w (h+70) 1 1 & rmPolys %~ ([rectNSWE h (h-165) (-45) (w+45)] ++)
let wlsNSEWs wln wls listew = [sps0 $ PutWall (rectNSWE wln wls wallw walle) defaultCrystalWall
| (wallw,walle) <- listew ]
let ws = wlsNSEWs (h-35) (h-135) [(-10,10) , (15,35) , (40,60) , (65,85)]
let wsDefense = wlsNSEWs 95 70 [(0,25) , (50,75) ]
brlOffsets <- replicateM 5 $ randInRect (w-20) 900
let brls = [ sPS (p +.+ V2 10 200) 0 $ PutCrit explosiveBarrel | p <- brlOffsets ]
let rm = roomRect w (h+70) 1 1 & rmPolys .++~ [rectNSWE h (h-165) (-45) (w+45)]
& rmFloor .~ InheritFloor
return $ restrictInLinks cond $ rm & rmPmnts .~ ws ++ brls ++ wsDefense ++
[sPS (V2 12.5 (h-25)) 0 $ PutCrit longCrit
,sPS (V2 37.5 (h-25)) 0 $ PutCrit longCrit
,sPS (V2 62.5 (h-25)) 0 $ PutCrit longCrit
,sPS (V2 25 20 ) 0 putLamp
,sPS (V2 25 (h-10)) 0 putLamp
]
[sPS (V2 crx (h-25)) 0 $ PutCrit longCrit
| crx <- [12.5,37.5,62.5] ] ++
[sPS (V2 25 lampy ) 0 putLamp | lampy <- [20,h-10] ]
doubleCorridorBarrels :: RandomGen g => State g Room
doubleCorridorBarrels = do
+6 -6
View File
@@ -67,14 +67,14 @@ room2 = lasCenSensEdge
startRoom :: RandomGen g => Int -> State g (SubCompTree Room)
startRoom i = join $ uncurry takeOneWeighted $ unzip
-- [ (,) (0.5::Float) $ chainUses <$> sequence [minigunFakeout,weaponRoom]
[-- (,) one rezBoxesWp
(,) one rezBoxesThenWeaponRoom
-- , (,) 1 rezBoxThenWeaponRoom
-- , (,) one rezBoxesWpCrit
-- , (,) 1 $ runPastStart i
[ (,) one rezBoxesWp
, (,) one rezBoxesThenWeaponRoom
, (,) 1 rezBoxThenWeaponRoom
, (,) one rezBoxesWpCrit
, (,) 1 $ runPastStart i
]
where
one = (1::Float)
one = 1::Float
randomChallenges :: RandomGen g => State g (SubCompTree Room)
randomChallenges = join $ takeOne
[fmap (return . UseAll) doubleCorridorBarrels
+1 -1
View File
@@ -16,7 +16,7 @@ getLinksOfType :: RoomLinkType -> [RoomLink] -> [RoomLink]
getLinksOfType lt = filter (S.member lt . _rlType)
restrictInLinks :: ((Point2,Float) -> Bool) -> Room -> Room
restrictInLinks f = rmLinks %~ restrictLinkType InLink f
restrictInLinks = over rmLinks . restrictLinkType InLink
restrictOutLinks :: ((Point2,Float) -> Bool) -> Room -> Room
restrictOutLinks f = rmLinks %~ restrictLinkType OutLink f
+6 -1
View File
@@ -28,7 +28,8 @@ import qualified SDL
{- Update the screen camera rotation and position, including any in rold scope/remote camera modifiers;
update where your avatar's view is from. -}
updateCamera :: Configuration -> World -> World
updateCamera cfig = rotateCamera cfig . autoZoomCamera cfig . moveCamera . updateScopeZoom
updateCamera cfig = rotateCamera cfig . setViewDistance cfig
. autoZoomCamera cfig . 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
@@ -169,6 +170,10 @@ autoZoomCamera cfig w = w & cameraZoom %~ changeZoom
zoomOutSpeed = 15
theScopeZoom = fromMaybe 1 $ yourItem w ^? _Just . itScope . scopeZoom
setViewDistance :: Configuration -> World -> World
setViewDistance cfig w = w & viewDistance
.~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / _cameraZoom w
farWallDist :: Point2 -> Configuration -> World -> Float
farWallDist p cfig w = (winFac /) . min maxViewDistance $ ssfold (> maxViewDistance) findMax 1 vps
where