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

Separate out concrete part of world

Browse Source
This commit is contained in:
justin
2022-07-25 12:10:50 +01:00
parent 3354d108be
commit b2efbd2b3e
134 changed files with 933 additions and 930 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Placement/Instance/LightSource/Flicker.hs
+4 -4
View File
@@ -18,13 +18,13 @@ flickerMod pl = Just $ sps0 $ PutMod $ ModIDTimerPoint3Bool
flickerUpdate :: Modification -> World -> World
flickerUpdate md w
| _mdTimer md > 0 = w & modifications . ix mdid . mdTimer -~ 1
| otherwise = w & lightSources . ix lsid . lsParam . lsCol .~ mdcol
& modifications . ix mdid
| _mdTimer md > 0 = w & cWorld . modifications . ix mdid . mdTimer -~ 1
| otherwise = w & cWorld . lightSources . ix lsid . lsParam . lsCol .~ mdcol
& cWorld . modifications . ix mdid
%~ ( (mdTimer .~ newtime) . (mdPoint3 .~ lscol) . (mdBool %~ not) )
where
mdcol = _mdPoint3 md
lscol = _lsCol $ _lsParam $ _lightSources w IM.! lsid
lscol = w ^?! cWorld . lightSources . ix lsid . lsParam . lsCol -- _lsCol $ _lsParam $ _lightSources w IM.! lsid
lsid = _mdExternalID md
mdid = _mdID md
timerange
src/Dodge/Placement/Instance/Sensor.hs
+1 -1
View File
@@ -29,7 +29,7 @@ damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1)
& mcColor .~ yellow
& mcMounts . at ObTrigger .~ mtrid
& mcMounts . at ObLightSource ?~ lsid
& mcDraw .~ MachineDrawDamageSensor wdth (_sensorCoding (_genParams gw) M.! dt)
& mcDraw .~ MachineDrawDamageSensor wdth (_sensorCoding (_genParams (_cWorld gw)) M.! dt)
& mcSensor .~ DamageSensor False 0 dt
)
defaultSensorWall
src/Dodge/Placement/Instance/Terminal.hs
+4 -4
View File
@@ -29,10 +29,10 @@ putTerminal mc tm
$ \mcpl -> Just $ sps0 $ PutWorldUpdate $ const (setids tmpl btpl mcpl)
where
setids tmpl btpl mcpl w = w
& terminals . ix tmid . tmButtonID .~ btid
& terminals . ix tmid . tmMachineID .~ mcid
& machines . ix mcid . mcMounts . at ObTerminal ?~ tmid
& buttons . ix btid . btTermMID ?~ tmid
& cWorld . terminals . ix tmid . tmButtonID .~ btid
& cWorld . terminals . ix tmid . tmMachineID .~ mcid
& cWorld . machines . ix mcid . mcMounts . at ObTerminal ?~ tmid
& cWorld . buttons . ix btid . btTermMID ?~ tmid
where
tmid = fromJust (_plMID tmpl)
btid = fromJust (_plMID btpl)
src/Dodge/Placement/Instance/Turret.hs
+13 -13
View File
@@ -39,7 +39,7 @@ lasTurret = Turret
-- this needs a major cleanup
updateTurret :: Float -> Machine -> World -> World
updateTurret rotSpeed mc w
| _mcHP mc < 1 = w & machines %~ IM.delete mcid
| _mcHP mc < 1 = w & cWorld . machines %~ IM.delete mcid
& deleteWallIDs (_mcWallIDs mc)
& makeExplosionAt mcpos
& copyItemToFloor mcpos lasGun
@@ -52,12 +52,12 @@ updateTurret rotSpeed mc w
where
deleteHomonculus = case _tuMCrID (_mcType mc) of
Nothing -> id
Just cid -> creatures . at cid .~ Nothing
initHomonculus w' = case w' ^? machines . ix mcid . mcType . tuMCrID . _Just of
Nothing -> w' & machines . ix mcid . mcType . tuMCrID ?~ cid
& creatures . at cid ?~ thecreature
Just cid -> cWorld . creatures . at cid .~ Nothing
initHomonculus w' = case w' ^? cWorld . machines . ix mcid . mcType . tuMCrID . _Just of
Nothing -> w' & cWorld . machines . ix mcid . mcType . tuMCrID ?~ cid
& cWorld . creatures . at cid ?~ thecreature
where
cid = IM.newKey (_creatures w')
cid = IM.newKey (_creatures (_cWorld w'))
thecreature = defaultCreature
& crID .~ cid
& crInv . at 0 ?~ (_tuWeapon (_mcType mc) & itUse . useAim . aimHandlePos -~ 10
@@ -70,9 +70,9 @@ updateTurret rotSpeed mc w
& crStance . posture .~ Aiming
& crMaterial .~ Crystal
Just cid -> w'
& creatures . ix cid . crPos .~ mcpos
& creatures . ix cid . crDir .~ mcdir
dodamage = machines . ix mcid %~
& cWorld . creatures . ix cid . crPos .~ mcpos
& cWorld . creatures . ix cid . crDir .~ mcdir
dodamage = cWorld . machines . ix mcid %~
( (mcDamage .~ [Damage ELECTRICAL (min 2500 $ max 0 (elecDam - 10)) 0 0 0 NoDamageEffect])
. (mcHP -~ dam)
)
@@ -83,7 +83,7 @@ updateTurret rotSpeed mc w
| _tuFireTime (_mcType mc) > 0
= fromMaybe id $ do
cid <- _tuMCrID (_mcType mc)
return $ creatures . ix cid . crActionPlan . apImpulse .~ [UseItem]
return $ cWorld . creatures . ix cid . crActionPlan . apImpulse .~ [UseItem]
| otherwise = id
mcid = _mcID mc
ypos = _crPos $ you w
@@ -94,12 +94,12 @@ updateTurret rotSpeed mc w
dam = sum $ map _dmAmount dams
elecDam = sum $ map _dmAmount elecDams
doTurn
| seesYou = machines . ix mcid . mcDir %~ turnTo rotSpeed mcpos ypos
| seesYou = cWorld . machines . ix mcid . mcDir %~ turnTo rotSpeed mcpos ypos
| otherwise = id
closeFireAngle = seesYou -- && angleVV (ypos -.- mcpos) (unitVectorAtAngle mcdir) < 1
updateFiringStatus
| closeFireAngle = machines . ix mcid . mcType . tuFireTime .~ 20
| otherwise = machines . ix mcid . mcType . tuFireTime %~ (max 0 . subtract 1)
| closeFireAngle = cWorld . machines . ix mcid . mcType . tuFireTime .~ 20
| otherwise = cWorld . machines . ix mcid . mcType . tuFireTime %~ (max 0 . subtract 1)
drawTurret :: Machine -> SPic
src/Dodge/Placement/PlaceSpot.hs
+17 -17
View File
@@ -88,21 +88,21 @@ placeSpotID ps pt gw = let (i,w) = placeSpotID' ps pt (_gwWorld gw)
-- the Int here is some id that is assigned when the placement is placed
placeSpotID' :: PlacementSpot -> PSType -> World -> (Int, World)
placeSpotID' ps pt w = case pt of
PutTrigger cnd -> plNewID triggers cnd w
PutMod mdi -> plNewUpID modifications mdID mdi w
PutProp prp -> plNewUpID props prID (mvProp p rot prp) w
PutButton bt -> plNewUpID buttons btID (mvButton p rot bt) w
PutTerminal tm -> plNewUpID terminals tmID tm w
PutFlIt itm -> plNewUpID floorItems flItID (createFlIt p rot itm) w
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
PutTrigger cnd -> plNewID (cWorld . triggers) cnd w
PutMod mdi -> plNewUpID (cWorld . modifications) mdID mdi w
PutProp prp -> plNewUpID (cWorld . props) prID (mvProp p rot prp) w
PutButton bt -> plNewUpID (cWorld . buttons) btID (mvButton p rot bt) w
PutTerminal tm -> plNewUpID (cWorld . terminals) tmID tm w
PutFlIt itm -> plNewUpID (cWorld . floorItems) flItID (createFlIt p rot itm) w
PutCrit cr -> plNewUpID (cWorld . creatures) crID (mvCr p rot cr) w
PutForeground fs -> plNewUpID (cWorld . foregroundShapes) fsID (mvFS p rot fs) w
PutDecoration pic -> plNewID (cWorld . decorations) (shiftDec p rot pic) 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
PutLS ls -> plNewUpID (cWorld . lightSources) lsID (mvLS p' rot ls) w
PutPPlate pp -> plNewUpID (cWorld . pressPlates) ppID (mvPP p rot pp) w
RandPS rgn -> evaluateRandPS rgn ps w
PutDoor col eo f pss -> plDoor col eo f (map (bimap doShift doShift) pss) w
PutCoord cp -> plNewID coordinates (doShift cp) w
PutCoord cp -> plNewID (cWorld . coordinates) (doShift cp) w
PutSlideDr wl dr eo off a b
-> plSlideDoor wl dr eo off (doShift a) (doShift b) w
PutBlock bl wl ps' -> plBlock (map doShift ps') (bl & blPos %~ doShift & blDir .~ rot)
@@ -148,7 +148,7 @@ placeWallPoly qs wl w = foldl' (addPane wl) w pairs
addPane :: Wall -> World -> (Point2,Point2) -> World
--addPane wl w l = w & walls %~ IM.insert wlid (wl { _wlLine = l, _wlID = wlid })
addPane wl w l = w & plNew walls wlID (wl & wlLine .~ l)
addPane wl w l = w & plNew (cWorld . walls) wlID (wl & wlLine .~ l)
& fst . uncurry (obstructPathsCrossing WallObstacle) l
-- where
-- wlid = IM.newKey (_walls w)
@@ -174,14 +174,14 @@ mvFS p a = (fsDir +~ a) . (fsPos %~ ( (p +.+) . rotateV a ))
plMachine :: [Point2] -> Machine -> Wall -> Point2 -> Float -> World -> (Int,World)
plMachine wallpoly mc wl p rot gw = (mcid
, gw & machines %~ addMc
& walls %~ placeMachineWalls wl col wallpoly mcid wlid
, gw & cWorld . machines %~ addMc
& cWorld . walls %~ placeMachineWalls wl col wallpoly mcid wlid
)
where
col = _mcColor mc
w' = gw
mcid = IM.newKey $ _machines w'
wlid = IM.newKey $ _walls w'
mcid = IM.newKey $ _machines (_cWorld w')
wlid = IM.newKey $ _walls (_cWorld w')
wlids = IS.fromList [wlid .. wlid + length wallpoly - 1]
--addMc = IM.insert mcid (mc {_mcPos = centroid wallpoly,_mcDir = rot,_mcID = mcid, _mcWallIDs = wlids})
addMc = IM.insert mcid (mc {_mcPos = p,_mcDir = rot,_mcID = mcid, _mcWallIDs = wlids})
src/Dodge/Placement/PlaceSpot/Block.hs
+8 -8
View File
@@ -23,7 +23,7 @@ plBlock
-> (Int,World)
plBlock [] _ _ _ = error "Trying to add a block with incomplete polygon"
plBlock (p:ps) bl wl w = (,) blid $ w
& blocks . at blid ?~ bl
& cWorld . blocks . at blid ?~ bl
{ _blID = blid
, _blWallIDs = IS.fromList is
, _blShadows = []
@@ -31,9 +31,9 @@ plBlock (p:ps) bl wl w = (,) blid $ w
}
& insertWalls blid wls
where
blid = IM.newKey $ _blocks w
blid = IM.newKey $ _blocks (_cWorld w)
lns = zip (p:ps) (ps ++ [p])
i = IM.newKey $ _walls w
i = IM.newKey $ _walls (_cWorld w)
is = [i.. i + length lns-1]
wls = zipWith
(\j ln -> wl & wlLine .~ ln & wlID .~ j & wlStructure .~ BlockPart blid)
@@ -62,11 +62,11 @@ plLineBlock basePane blwidth a b gw = ( 0
cornerPoints = reverse $ rectWH halfBlockWidth depth -- goes clockwise around the block
cornersAt p = fmap ( (p +.+) . rotateV (argV (b -.- a)) ) cornerPoints
linesAt p = loopPairs $ cornersAt p
wlid = IM.newKey $ _walls gw
blid = IM.newKey $ _blocks gw
wlid = IM.newKey $ _walls (_cWorld gw)
blid = IM.newKey $ _blocks (_cWorld gw)
insertBlock (i,p) =
insertWalls (i + blid) (makeWallAt p i)
. over blocks (IM.insert (i+blid) Block
. over (cWorld . blocks) (IM.insert (i+blid) Block
{ _blID = i + blid, _blWallIDs = IS.fromList $ ksAtI i
, _blHP = 1000, _blShadows = shadowsAt i
, _blDir = 0 -- THIS IS NOT SENSIBLE. TODO rethink block positioning
@@ -96,10 +96,10 @@ plLineBlock basePane blwidth a b gw = ( 0
-- | Must be done after inserting the block
insertWalls :: Int -> [Wall] -> World -> World
insertWalls blid wls w = w' & blocks . ix blid . blObstructs .~ concat paths
insertWalls blid wls w = w' & cWorld . blocks . ix blid . blObstructs .~ concat paths
where
(w',paths) = mapAccumR (flip insertWall) w wls
insertWall :: Wall -> World -> (World,[(Int,Int,PathEdge)])
insertWall wl = uncurry (obstructPathsCrossing BlockObstacle) (_wlLine wl)
. (walls . at (_wlID wl) ?~ wl)
. (cWorld . walls . at (_wlID wl) ?~ wl)
src/Dodge/Placement/PlaceSpot/TriggerDoor.hs
+10 -10
View File
@@ -27,9 +27,9 @@ plDoor :: Color
-- Bumped out up and down by 9, not widened
-> World
-> (Int,World)
plDoor col eo cond pss gw = (drid, addWalls $ gw & doors %~ addDoor) -- carefull with the ordering of addWalls
plDoor col eo cond pss gw = (drid, addWalls $ gw & cWorld . doors %~ addDoor) -- carefull with the ordering of addWalls
where
drid = IM.newKey $ _doors gw
drid = IM.newKey $ _doors (_cWorld gw)
addDoor = IM.insert drid $ defaultDoor
{ _drID = drid
, _drWallIDs = IS.fromList wlids
@@ -42,18 +42,18 @@ plDoor col eo cond pss gw = (drid, addWalls $ gw & doors %~ addDoor) -- carefull
, _drObstacleType = eo
}
nsteps = length pss - 1
wlids = take 4 [IM.newKey $ _walls gw ..]
wlids = take 4 [IM.newKey $ _walls (_cWorld gw) ..]
wlps' = uncurry (rectanglePairs 9) $ head pss
addWalls w' = foldl' (addDoorWall eo drid $ switchWallCol col) w' $ zip wlids wlps'
addDoorWall :: EdgeObstacle -> Int -> Wall -> World -> (Int,(Point2,Point2)) -> World
addDoorWall eo drid wl w (wlid,wlps) = w'
& walls %~ IM.insert wlid wl
& cWorld . walls %~ IM.insert wlid wl
{ _wlLine = wlps
, _wlID = wlid
, _wlStructure = DoorPart drid
}
& doors . ix drid . drObstructs .++~ es
& cWorld . doors . ix drid . drObstructs .++~ es
where
(w',es) = uncurry (obstructPathsCrossing eo) wlps w
@@ -63,9 +63,9 @@ maybeClearDoorPaths eo es w = foldl' (maybeClearDoorPath eo) w es
maybeClearDoorPath :: EdgeObstacle -> World -> (Int,Int,PathEdge) -> World
maybeClearDoorPath eo w (x,y,pe)
| not . null $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w
= w & pathGraph %~ FGL.insEdge (x,y,pe & peObstacles . at eo ?~ ()) . FGL.delEdge (x,y)
= w & cWorld . pathGraph %~ FGL.insEdge (x,y,pe & peObstacles . at eo ?~ ()) . FGL.delEdge (x,y)
| otherwise
= w & pathGraph %~ FGL.insEdge (x,y,pe & peObstacles . at eo .~ Nothing) . FGL.delEdge (x,y)
= w & cWorld . pathGraph %~ FGL.insEdge (x,y,pe & peObstacles . at eo .~ Nothing) . FGL.delEdge (x,y)
plSlideDoor
:: Door
@@ -77,9 +77,9 @@ plSlideDoor
-> World
-> (Int, World)
plSlideDoor dr wl eo shiftOffset a b gw
= (drid, addDoorWalls $ gw & doors %~ addDoor)
= (drid, addDoorWalls $ gw & cWorld . doors %~ addDoor)
where
drid = IM.newKey $ _doors gw
drid = IM.newKey $ _doors (_cWorld gw)
addDoor = IM.insert drid $ dr
{ _drID = drid
, _drWallIDs = IS.fromList wlids
@@ -93,7 +93,7 @@ plSlideDoor dr wl eo shiftOffset a b gw
addDoorWalls w' = foldl' (addDoorWall eo drid wl) w' $ zip wlids pairs
pairs = rectanglePairs 9 a b
shiftLeft = (+.+ (a -.- b +.+ shiftOffset *.* normalizeV (b -.- a)))
wlids = take 4 [IM.newKey $ _walls gw ..]
wlids = take 4 [IM.newKey $ _walls (_cWorld gw) ..]
-- old code that may help with pathing
--import Dodge.LevelGen.Pathing
--import Data.Graph.Inductive hiding ((&))