Tweak bullet bouncing and spawning

This commit is contained in:
2022-07-19 18:21:51 +01:00
parent 3031f2478c
commit 89d397a928
8 changed files with 49 additions and 37 deletions
+9 -6
View File
@@ -23,12 +23,15 @@ damageSensor
-> Placement
damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1)
$ \lsid -> Just $ spNoID ps $ PutUsingGenParams
$ \gw -> (,) gw $ PutMachine (reverse $ square wdth) $ defaultMachine
& mcColor .~ yellow
& mcMounts . at ObTrigger .~ mtrid
& mcMounts . at ObLightSource ?~ lsid
& mcDraw .~ sensorSPic wdth (_sensorCoding (_genParams gw) M.! dt)
& mcSensor .~ DamageSensor False 0 dt
$ \gw -> (,) gw $ PutMachine (reverse $ square wdth)
(defaultMachine
& mcColor .~ yellow
& mcMounts . at ObTrigger .~ mtrid
& mcMounts . at ObLightSource ?~ lsid
& mcDraw .~ sensorSPic wdth (_sensorCoding (_genParams gw) M.! dt)
& mcSensor .~ DamageSensor False 0 dt
)
defaultSensorWall
lightSensor :: Float
-> Maybe Int
+1
View File
@@ -30,6 +30,7 @@ putTerminal mc tm
(PutMachine (reverse $ square 10)
(mc & mcMounts . at ObButton ?~ fromJust (_plMID btpl)
& mcCloseSound ?~ fridgeHumS)
defaultSensorWall
)
$ \mcpl -> Just $ sps0 $ PutWorldUpdate $ const (setids tmpl btpl mcpl)
where
+8 -6
View File
@@ -26,12 +26,14 @@ import Data.List
import Data.Maybe
putLasTurret :: Float -> Placement
putLasTurret rotSpeed = sps0 $ PutMachine (reverse $ square wdth) (defaultMachine & mcColor .~ blue)
{ _mcDraw = drawTurret
-- , _mcUpdate = updateTurret rotSpeed
, _mcType = lasTurret & tuTurnSpeed .~ rotSpeed
, _mcHP = 50000
}
putLasTurret rotSpeed = sps0 $ PutMachine (reverse $ square wdth)
(defaultMachine
& mcColor .~ blue
& mcDraw .~ drawTurret
& mcType .~ (lasTurret & tuTurnSpeed .~ rotSpeed)
& mcHP .~ 50000
)
defaultMachineWall
lasTurret :: MachineType
lasTurret = Turret
{ _tuWeapon = lasGun
+7 -8
View File
@@ -11,7 +11,6 @@ import Dodge.Data
import Dodge.Placement.PlaceSpot.Block
import Dodge.Placement.PlaceSpot.TriggerDoor
import Dodge.Path
import Dodge.Default.Wall
import Dodge.ShiftPoint
import Dodge.Base.NewID
import Geometry
@@ -94,7 +93,7 @@ placeSpotID ps pt w = case pt of
PutCrit cr -> plNewUpID creatures crID (mvCr p rot cr) w
PutForeground fs -> plNewUpID foregroundShapes fsID (mvFS p rot fs) w
PutDecoration pic -> plNewID decorations (shiftDec p rot pic) w
PutMachine pps mc -> plMachine (map doShift pps) mc p rot w
PutMachine pps mc wl -> plMachine (map doShift pps) mc wl p rot w
PutLS ls -> plNewUpID lightSources lsID (mvLS p' rot ls) w
PutPPlate pp -> plNewUpID pressPlates ppID (mvPP p rot pp) w
RandPS rgn -> evaluateRandPS rgn ps w
@@ -169,10 +168,10 @@ mvCr p rot cr = cr {_crPos = p,_crOldPos = p,_crDir = rot}
mvFS :: Point2 -> Float -> ForegroundShape -> ForegroundShape
mvFS p a = (fsDir +~ a) . (fsPos %~ ( (p +.+) . rotateV a ))
plMachine :: [Point2] -> Machine -> Point2 -> Float -> World -> (Int,World)
plMachine wallpoly mc p rot gw = (mcid
plMachine :: [Point2] -> Machine -> Wall -> Point2 -> Float -> World -> (Int,World)
plMachine wallpoly mc wl p rot gw = (mcid
, gw & machines %~ addMc
& walls %~ placeMachineWalls col wallpoly mcid wlid
& walls %~ placeMachineWalls wl col wallpoly mcid wlid
)
where
col = _mcColor mc
@@ -184,11 +183,11 @@ plMachine wallpoly mc p rot gw = (mcid
addMc = IM.insert mcid (mc {_mcPos = p,_mcDir = rot,_mcID = mcid, _mcWallIDs = wlids})
-- TODO correctly remove/shift pathfinding lines (removePathsCrossing)
placeMachineWalls :: Color -> [Point2] -> Int -> Int -> IM.IntMap Wall -> IM.IntMap Wall
placeMachineWalls col poly mcid wlid = flip (foldr f) $ zip [wlid..] $ loopPairs poly
placeMachineWalls :: Wall -> Color -> [Point2] -> Int -> Int -> IM.IntMap Wall -> IM.IntMap Wall
placeMachineWalls wl col poly mcid wlid = flip (foldr f) $ zip [wlid..] $ loopPairs poly
where
f (wid,l) = IM.insert wid baseWall{_wlID = wid, _wlLine = l}
baseWall = defaultMachineWall
baseWall = wl
& wlColor .~ col
& wlStructure . wsMachine .~ mcid
& wlTouchThrough .~ True