From 7ddbbdda144d4002a424376e711435c6e34e7e19 Mon Sep 17 00:00:00 2001 From: justin Date: Mon, 1 Nov 2021 15:21:21 +0000 Subject: [PATCH] Improve machines, tweak wall ids --- src/Dodge/Data.hs | 7 ++++--- src/Dodge/Default.hs | 14 ++++++++++++-- src/Dodge/Item/Weapon/BatteryGuns.hs | 15 ++++++++------- src/Dodge/LevelGen.hs | 3 ++- src/Dodge/LevelGen/Block.hs | 5 +++-- src/Dodge/LevelGen/TriggerDoor.hs | 5 +++-- src/Dodge/Machine/Sensor.hs | 3 ++- src/Dodge/Render/ShapePicture.hs | 2 +- src/Dodge/Update.hs | 20 +++++++++++--------- src/Dodge/Wall/Delete.hs | 19 +++++++++++++++++++ src/Dodge/WorldEvent/DamageBlock.hs | 11 +++++++++++ 11 files changed, 76 insertions(+), 28 deletions(-) create mode 100644 src/Dodge/Wall/Delete.hs diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index e93421827..21cc4ffb2 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -547,23 +547,24 @@ data Prop data Either3 a b c = E3x1 a | E3x2 b | E3x3 c data Block = Block { _blID :: Int - , _blWallIDs :: [Int] + , _blWallIDs :: IS.IntSet , _blHPs :: [Int] , _blShadows :: [Int] } data Machine = Machine { _mcID :: Int - , _mcWallIDs :: [Int] + , _mcWallIDs :: IS.IntSet , _mcUpdate :: Machine -> World -> World , _mcDraw :: Machine -> SPic , _mcPos :: Point2 , _mcDir :: Float , _mcHP :: Int , _mcSensor :: Int + , _mcDamage :: [DamageType] } data Door = Door { _drID :: Int - , _drWallIDs :: [Int] + , _drWallIDs :: IS.IntSet , _drStatus :: DoorStatus , _drTrigger :: World -> Bool , _drMech :: Door -> World -> World diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index fd927c0af..c91acf6bd 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -17,6 +17,7 @@ import Dodge.Creature.Memory.Data import Dodge.SoundLogic import Dodge.SoundLogic.LoadSound import Dodge.Picture.Layer +import Dodge.Wall.Delete import Geometry import Picture import ShapePicture @@ -212,14 +213,23 @@ defaultIt = Consumable defaultMachine :: Machine defaultMachine = Machine { _mcID = 0 - , _mcWallIDs = [] - , _mcUpdate = const id + , _mcWallIDs = mempty + , _mcUpdate = defaultMachineUpdate , _mcDraw = const mempty , _mcPos = V2 0 0 , _mcDir = 0 , _mcHP = 100 , _mcSensor = 0 + , _mcDamage = [] } +defaultMachineUpdate :: Machine -> World -> World +defaultMachineUpdate mc w + | _mcHP mc < 1 = w & machines %~ IM.delete mcid + & deleteWallIDs (_mcWallIDs mc) + | otherwise = w & machines . ix mcid %~ ( (mcDamage .~ []) . (mcHP -~ dams) ) + where + dams = sum $ map _dmAmount $ _mcDamage mc + mcid = _mcID mc defaultDrawButton :: Color -> Button -> SPic defaultDrawButton col bt = diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index eee3d90c4..142bbd901 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -9,6 +9,7 @@ import Dodge.SoundLogic.LoadSound import Dodge.Creature.State.Data import Dodge.Data.DamageType import Dodge.WorldEvent +import Dodge.WorldEvent.DamageBlock import Dodge.Default import Dodge.Item.Draw import Dodge.Item.Data @@ -221,13 +222,13 @@ moveLaser phaseV pos dir w pt h' ws (_,Right wl) = not $ any (\w' -> _wlID w' == _wlID wl) ws h' _ _ = True (thHit, ps) = f [] pos xp - hitEffect - = case thHit of - Just (p,Left cr) - -> over (creatures . ix (_crID cr) . crState . crDamage) ((:) $ Lasering 19 pos p xp) - Just (p,Right wl) -> colSpark 8 (V4 20 (-5) 0 1) (p +.+ safeNormalizeV (pos -.- p)) - (reflectDir wl) - _ -> id + hitEffect = case thHit of + Just (p,Left cr) + -> creatures . ix (_crID cr) . crState . crDamage %~ (Lasering 19 pos p xp :) + Just (p,Right wl) -> colSpark 8 (V4 20 (-5) 0 1) (p +.+ safeNormalizeV (pos -.- p)) + (reflectDir wl) + . damageWall (Lasering 19 pos p xp) wl + _ -> id pic = setLayer 1 $ pictures [ setDepth 19 . color (brightX 0 0.5 yellow) $ lineOfThickness 20 (pos:ps) , setDepth 19.5 . color (brightX 10 1 yellow) $ lineOfThickness 3 (pos:ps) diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index 0c7ebac89..95c39512c 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -25,6 +25,7 @@ import Color import Control.Monad.State import Control.Lens +import qualified Data.IntSet as IS placeSpot :: World -> ((Point2,Float) , Placement) -> World placeSpot w (shift, plmnt) = @@ -195,7 +196,7 @@ placeMachine color wallpoly mc p rot w = (mcid where mcid = IM.newKey $ _machines w wlid = IM.newKey $ _walls w - wlids = [wlid .. wlid + length wallpoly] + wlids = IS.fromList [wlid .. wlid + length wallpoly] addMc mcs = IM.insert mcid (mc {_mcPos = p,_mcDir = rot,_mcID = mcid, _mcWallIDs = wlids}) mcs -- TODO correctly remove/shift pathfinding lines (removePathsCrossing) placeMachineWalls :: Color -> [Point2] -> Int -> Int -> IM.IntMap Wall -> IM.IntMap Wall diff --git a/src/Dodge/LevelGen/Block.hs b/src/Dodge/LevelGen/Block.hs index 6d0062010..78df50df1 100644 --- a/src/Dodge/LevelGen/Block.hs +++ b/src/Dodge/LevelGen/Block.hs @@ -15,6 +15,7 @@ import Color import Control.Lens import Data.List +import qualified Data.IntSet as IS addBlock :: [Point2] -- ^ Block polygon @@ -30,7 +31,7 @@ addBlock (p:ps) hp col opacity hps w | otherwise = w & wallsZone . znObjects %~ flip (IM.foldl' $ flip wallInZone) panes & walls %~ IM.union panes - & blocks %~ IM.insert blid (Block {_blID = blid,_blWallIDs = is, _blHPs = hp:hps, _blShadows=[]}) + & blocks %~ IM.insert blid (Block {_blID = blid,_blWallIDs = IS.fromList is, _blHPs = hp:hps, _blShadows=[]}) where blid = IM.newKey $ _blocks w lns = zip (p:ps) (ps ++ [p]) @@ -87,7 +88,7 @@ placeLineBlock basePane blockWidth depth a b w = (,) 0 k = IM.newKey $ _walls w blid = IM.newKey $ _blocks w insertBlock i = over blocks $ IM.insert (i+blid) Block - {_blID = i + blid, _blWallIDs = ksAtI i, _blHPs = [5,5], _blShadows = shadowsAt i} + {_blID = i + blid, _blWallIDs = IS.fromList $ ksAtI i, _blHPs = [5,5], _blShadows = shadowsAt i} insertBlocks = flip (foldr insertBlock) is ksAtI i = map ( + (k + i*4) ) [0,1,2,3] visibilityAt i diff --git a/src/Dodge/LevelGen/TriggerDoor.hs b/src/Dodge/LevelGen/TriggerDoor.hs index 4d51b8ead..7004bcdb7 100644 --- a/src/Dodge/LevelGen/TriggerDoor.hs +++ b/src/Dodge/LevelGen/TriggerDoor.hs @@ -24,6 +24,7 @@ import Data.List import Data.Maybe import Control.Lens import Data.Graph.Inductive hiding ((&)) +import qualified Data.IntSet as IS -- probably don't have to rebuild the entire graph, oh well addButtonDoor :: Color -> Point2 -> Float -> Point2 -> Point2 -> Float -> World -> (Int, World) @@ -58,7 +59,7 @@ putDoor col cond pss w = (drid, addWalls w & doors %~ addDoor) drid = IM.newKey $ _doors w addDoor = IM.insert drid $ Door { _drID = drid - , _drWallIDs = wlids + , _drWallIDs = IS.fromList wlids , _drStatus = DoorInt 0 , _drTrigger = cond , _drMech = doorMechanismStepwise nsteps drid wlids pss @@ -136,7 +137,7 @@ putSingleDoor isPathable col cond a b speed w = (drid, addWalls w drid = IM.newKey $ _doors w addDoor = IM.insert drid $ Door { _drID = drid - , _drWallIDs = wlids + , _drWallIDs = IS.fromList wlids , _drStatus = DoorClosed , _drTrigger = cond , _drMech = doorMechanism drid speed (zip3 wlids shiftedPairs pairs) diff --git a/src/Dodge/Machine/Sensor.hs b/src/Dodge/Machine/Sensor.hs index cce70c208..fa019e694 100644 --- a/src/Dodge/Machine/Sensor.hs +++ b/src/Dodge/Machine/Sensor.hs @@ -11,7 +11,8 @@ import Shape lightSensor :: PSType lightSensor = PutMachine blue (reverse $ square wdth) defaultMachine - { _mcDraw = const lightSensorSPic } + { _mcDraw = const lightSensorSPic + } lightSensorSPic :: SPic lightSensorSPic = ( colorSH blue $ upperPrismPoly 25 (square wdth) diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index db7967420..042c1f4bb 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -39,7 +39,7 @@ worldSPic w = camCen = _cameraCenter w extraShapes :: World -> Shape -extraShapes w = _foregroundShape w +extraShapes = _foregroundShape extraPics :: World -> Picture extraPics w = pictures (_decorations w) diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 75360c223..bac6cb20f 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -15,6 +15,7 @@ import Dodge.Update.Camera import Dodge.SoundLogic import Dodge.Inventory import Dodge.WorldEvent.Sound +import Dodge.Wall.Delete import Geometry import Geometry.ConvexPoly import Geometry.Vector3D @@ -24,6 +25,7 @@ import Data.List import Data.Maybe import Data.Function import qualified Data.Set as S +import qualified Data.IntSet as IS import qualified Data.IntMap.Strict as IM import Control.Lens import Data.Monoid @@ -63,6 +65,7 @@ functionalUpdate w = case _menuLayers w of . updateLightSources . updateClouds . zoneClouds + . updateMachines . updateCreatures . updateCreatureGroups . updateBlocks @@ -86,7 +89,7 @@ splinterBlock bl w = foldr unshadowBlock w (_blShadows bl) -- foldr shiftTowardC & blocks . ix (_blID bl) . blHPs %~ tail & theSoundEffect cen where - wls = map (_walls w IM.!) (_blWallIDs bl) + wls = map (_walls w IM.!) (IS.toList $ _blWallIDs bl) ps = map (fst . _wlLine) wls cen = centroid ps theSoundEffect @@ -112,18 +115,12 @@ updateBlocks w = foldr f w $ _blocks w destroyBlock :: Block -> World -> World destroyBlock bl w = w - & walls %~ removeIDs wlids - & flip (foldr removeFromZone) wlids + & deleteWallIDs wlids & blocks %~ IM.delete (_blID bl) & mkSoundBreakGlass pos where wlids = _blWallIDs bl - pos = fst . _wlLine $ _walls w IM.! head wlids - removeIDs is wls = foldr IM.delete wls is - removeFromZone wlid w' = over (wallsZone . znObjects . ix x . ix y) (IM.delete (_wlID wl)) w' - where - (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine wl) - wl = _walls w IM.! wlid -- note the use of w not w' + pos = fst . _wlLine $ _walls w IM.! IS.findMin wlids -- | Note the explict use of record syntax. Using lens created a space leak. resetWorldEvents :: World -> World @@ -158,6 +155,11 @@ updateParticles w = set particles (catMaybes ps) w' where (w',ps) = mapAccumR (\a b -> _ptUpdate b a b) w $ _particles w +updateMachines :: World -> World +updateMachines w = foldr f w (_machines w) + where + f mc = _mcUpdate mc mc + -- Note that this updates the randgen updateCreatures :: World -> World updateCreatures w = appEndo f $ w diff --git a/src/Dodge/Wall/Delete.hs b/src/Dodge/Wall/Delete.hs new file mode 100644 index 000000000..4c1980a29 --- /dev/null +++ b/src/Dodge/Wall/Delete.hs @@ -0,0 +1,19 @@ +module Dodge.Wall.Delete + ( deleteWallIDs + ) where +import Dodge.Data +import Dodge.Zone +import Geometry + +import Control.Lens +import qualified Data.IntMap.Strict as IM +import qualified Data.IntSet as IS +deleteWall :: Wall -> World -> World +deleteWall wl = (walls %~ IM.delete i) + . (wallsZone . znObjects . ix x . ix y %~ IM.delete i) + where + (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine wl) + i = _wlID wl + +deleteWallIDs :: IS.IntSet -> World -> World +deleteWallIDs is w = foldr deleteWall w $ IM.restrictKeys (_walls w) is diff --git a/src/Dodge/WorldEvent/DamageBlock.hs b/src/Dodge/WorldEvent/DamageBlock.hs index 599b0490f..9e6771928 100644 --- a/src/Dodge/WorldEvent/DamageBlock.hs +++ b/src/Dodge/WorldEvent/DamageBlock.hs @@ -1,10 +1,21 @@ module Dodge.WorldEvent.DamageBlock ( damageBlocksBy + , damageWall ) where import Dodge.Data +import Dodge.Data.DamageType import Control.Lens +damageWall :: DamageType -> Wall -> World -> World +damageWall dt wl = case _wlStructure wl of + MachinePart mcid -> machines . ix mcid . mcDamage %~ (dt :) + BlockPart blid -> blocks . ix blid %~ damageBlockWith dt + _ -> id + +damageBlockWith :: DamageType -> Block -> Block +damageBlockWith _ = id + damageBlocksBy :: Int -> Wall -> World -> World damageBlocksBy x wl = case wl ^? wlStructure . wlStBlock of Just blid -> blocks . ix blid . blHPs %~ reduceHeadBy x