justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Improve machines, tweak wall ids

Browse Source
This commit is contained in:
justin
2021-11-01 15:21:21 +00:00
parent 7692421112
commit 7ddbbdda14
11 changed files with 76 additions and 28 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
+4 -3
View File
@@ -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
src/Dodge/Default.hs
+12 -2
View File
@@ -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 =
src/Dodge/Item/Weapon/BatteryGuns.hs
+8 -7
View File
@@ -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)
src/Dodge/LevelGen.hs
+2 -1
View File
@@ -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
src/Dodge/LevelGen/Block.hs
+3 -2
View File
@@ -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
src/Dodge/LevelGen/TriggerDoor.hs
+3 -2
View File
@@ -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)
src/Dodge/Machine/Sensor.hs
+2 -1
View File
@@ -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)
src/Dodge/Render/ShapePicture.hs
+1 -1
View File
@@ -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)
src/Dodge/Update.hs
+11 -9
View File
@@ -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
src/Dodge/Wall/Delete.hs
+19
View File
@@ -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
src/Dodge/WorldEvent/DamageBlock.hs
+11
View File
@@ -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