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

Add in "linear" lWorld to separate time reversable worlds

Browse Source
This commit is contained in:
justin
2022-10-28 12:24:51 +01:00
parent 5f6bd43599
commit 7e790b7153
130 changed files with 827 additions and 980 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Placement/Instance/LightSource/Flicker.hs
+4 -4
View File
@@ -23,14 +23,14 @@ flickerMod pl =
flickerUpdate :: Modification -> World -> World
flickerUpdate md w
| _mdTimer md > 0 = w & cWorld . modifications . ix mdid . mdTimer -~ 1
| _mdTimer md > 0 = w & cWorld . lWorld . modifications . ix mdid . mdTimer -~ 1
| otherwise =
w & cWorld . lightSources . ix lsid . lsParam . lsCol .~ mdcol
& cWorld . modifications . ix mdid
w & cWorld . lWorld . lightSources . ix lsid . lsParam . lsCol .~ mdcol
& cWorld . lWorld . modifications . ix mdid
%~ ((mdTimer .~ newtime) . (mdPoint3 .~ lscol) . (mdBool %~ not))
where
mdcol = _mdPoint3 md
lscol = w ^?! cWorld . lightSources . ix lsid . lsParam . lsCol -- _lsCol $ _lsParam $ _lightSources w IM.! lsid
lscol = w ^?! cWorld . lWorld . lightSources . ix lsid . lsParam . lsCol -- _lsCol $ _lsParam $ _lightSources w IM.! lsid
lsid = _mdExternalID md
mdid = _mdID md
timerange
src/Dodge/Placement/Instance/Terminal.hs
+4 -4
View File
@@ -31,10 +31,10 @@ putTerminal mc tm =
where
setids tmpl btpl mcpl w =
w
& 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
& cWorld . lWorld . terminals . ix tmid . tmButtonID .~ btid
& cWorld . lWorld . terminals . ix tmid . tmMachineID .~ mcid
& cWorld . lWorld . machines . ix mcid . mcMounts . at ObTerminal ?~ tmid
& cWorld . lWorld . buttons . ix btid . btTermMID ?~ tmid
where
tmid = fromJust (_plMID tmpl)
btid = fromJust (_plMID btpl)
src/Dodge/Placement/PlaceSpot.hs
+17 -18
View File
@@ -94,21 +94,21 @@ placeSpotID ps pt 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 (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
PutTrigger cnd -> plNewID (cWorld . lWorld . triggers) cnd w
PutMod mdi -> plNewUpID (cWorld . lWorld . modifications) mdID mdi w
PutProp prp -> plNewUpID (cWorld . lWorld . props) prID (mvProp p rot prp) w
PutButton bt -> plNewUpID (cWorld . lWorld . buttons) btID (mvButton p rot bt) w
PutTerminal tm -> plNewUpID (cWorld . lWorld . terminals) tmID tm w
PutFlIt itm -> plNewUpID (cWorld . lWorld . floorItems) flItID (createFlIt p rot itm) w
PutCrit cr -> plNewUpID (cWorld . lWorld . creatures) crID (mvCr p rot cr) w
PutForeground fs -> plNewUpID (cWorld . lWorld . foregroundShapes) fsID (mvFS p rot fs) w
PutDecoration pic -> plNewID (cWorld . lWorld . decorations) (shiftDec p rot pic) w
PutMachine pps mc wl -> plMachine (map doShift pps) mc wl p rot w
PutLS ls -> plNewUpID (cWorld . lightSources) lsID (mvLS p' rot ls) w
PutPPlate pp -> plNewUpID (cWorld . pressPlates) ppID (mvPP p rot pp) w
PutLS ls -> plNewUpID (cWorld . lWorld . lightSources) lsID (mvLS p' rot ls) w
PutPPlate pp -> plNewUpID (cWorld . lWorld . 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 (cWorld . coordinates) (doShift cp) w
PutCoord cp -> plNewID (cWorld . lWorld . 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' ->
@@ -160,7 +160,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 (cWorld . walls) wlID (wl & wlLine .~ l)
w & plNew (cWorld . lWorld . walls) wlID (wl & wlLine .~ l)
& fst . uncurry (obstructPathsCrossing WallObstacle) l
-- where
@@ -188,14 +188,13 @@ 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 & cWorld . machines %~ addMc
& cWorld . walls %~ placeMachineWalls wl col wallpoly mcid wlid
, gw & cWorld . lWorld . machines %~ addMc
& cWorld . lWorld . walls %~ placeMachineWalls wl col wallpoly mcid wlid
)
where
col = _mcColor mc
w' = gw
mcid = IM.newKey $ _machines (_cWorld w')
wlid = IM.newKey $ _walls (_cWorld w')
mcid = IM.newKey $ gw ^. cWorld . lWorld . machines
wlid = IM.newKey $ gw ^. cWorld . lWorld . walls
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
@@ -27,7 +27,7 @@ plBlock [] _ _ _ = error "Trying to add a block with incomplete polygon"
plBlock (p : ps) bl wl w =
(,) blid $
w
& cWorld . blocks . at blid
& cWorld . lWorld . blocks . at blid
?~ bl
{ _blID = blid
, _blWallIDs = IS.fromList is
@@ -36,9 +36,9 @@ plBlock (p : ps) bl wl w =
}
& insertWalls blid wls
where
blid = IM.newKey $ _blocks (_cWorld w)
blid = IM.newKey $ w ^. cWorld . lWorld . blocks
lns = zip (p : ps) (ps ++ [p])
i = IM.newKey $ _walls (_cWorld w)
i = IM.newKey $ w ^. cWorld . lWorld . walls
is = [i .. i + length lns -1]
wls =
zipWith
@@ -72,12 +72,12 @@ plLineBlock basePane blwidth a b gw =
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 (_cWorld gw)
blid = IM.newKey $ _blocks (_cWorld gw)
wlid = IM.newKey $ gw ^. cWorld . lWorld . walls
blid = IM.newKey $ gw ^. cWorld . lWorld . blocks
insertBlock (i, p) =
insertWalls (i + blid) (makeWallAt p i)
. over
(cWorld . blocks)
(cWorld . lWorld . blocks)
( IM.insert
(i + blid)
Block
@@ -115,11 +115,11 @@ plLineBlock basePane blwidth a b gw =
-- | Must be done after inserting the block
insertWalls :: Int -> [Wall] -> World -> World
insertWalls blid wls w = w' & cWorld . blocks . ix blid . blObstructs .~ Set.unions paths
insertWalls blid wls w = w' & cWorld . lWorld . blocks . ix blid . blObstructs .~ Set.unions paths
where
(w', paths) = mapAccumR (flip insertWall) w wls
insertWall :: Wall -> World -> (World, Set PathEdgeNodes)
insertWall wl =
uncurry (obstructPathsCrossing BlockObstacle) (_wlLine wl)
. (cWorld . walls . at (_wlID wl) ?~ wl)
. (cWorld . lWorld . walls . at (_wlID wl) ?~ wl)
src/Dodge/Placement/PlaceSpot/TriggerDoor.hs
+10 -10
View File
@@ -29,9 +29,9 @@ plDoor ::
[(Point2, Point2)] ->
World ->
(Int, World)
plDoor col eo cond pss gw = (drid, addWalls $ gw & cWorld . doors %~ addDoor) -- carefull with the ordering of addWalls
plDoor col eo cond pss gw = (drid, addWalls $ gw & cWorld . lWorld . doors %~ addDoor) -- carefull with the ordering of addWalls
where
drid = IM.newKey $ _doors (_cWorld gw)
drid = IM.newKey $ _doors (_lWorld (_cWorld gw))
addDoor =
IM.insert drid $
defaultDoor
@@ -46,14 +46,14 @@ plDoor col eo cond pss gw = (drid, addWalls $ gw & cWorld . doors %~ addDoor) --
, _drObstacleType = eo
}
nsteps = length pss - 1
wlids = take 4 [IM.newKey $ _walls (_cWorld gw) ..]
wlids = take 4 [IM.newKey $ _walls (_lWorld (_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'
& cWorld . walls
& cWorld . lWorld . walls
%~ IM.insert
wlid
wl
@@ -61,7 +61,7 @@ addDoorWall eo drid wl w (wlid, wlps) =
, _wlID = wlid
, _wlStructure = DoorPart drid
}
& cWorld . doors . ix drid . drObstructs <>~ es
& cWorld . lWorld . doors . ix drid . drObstructs <>~ es
where
(w', es) = uncurry (obstructPathsCrossing eo) wlps w
@@ -71,9 +71,9 @@ maybeClearDoorPaths eo es w = foldl' (maybeClearDoorPath eo) w es
maybeClearDoorPath :: EdgeObstacle -> World -> PathEdgeNodes -> World
maybeClearDoorPath eo w (PathEdgeNodes x y pe)
| not . null $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w =
w & cWorld . pathGraph %~ FGL.insEdge (x, y, pe & peObstacles . at eo ?~ ()) . FGL.delEdge (x, y)
w & cWorld . lWorld . pathGraph %~ FGL.insEdge (x, y, pe & peObstacles . at eo ?~ ()) . FGL.delEdge (x, y)
| otherwise =
w & cWorld . pathGraph %~ FGL.insEdge (x, y, pe & peObstacles . at eo .~ Nothing) . FGL.delEdge (x, y)
w & cWorld . lWorld . pathGraph %~ FGL.insEdge (x, y, pe & peObstacles . at eo .~ Nothing) . FGL.delEdge (x, y)
plSlideDoor ::
Door ->
@@ -85,9 +85,9 @@ plSlideDoor ::
World ->
(Int, World)
plSlideDoor dr wl eo shiftOffset a b gw =
(drid, addDoorWalls $ gw & cWorld . doors %~ addDoor)
(drid, addDoorWalls $ gw & cWorld . lWorld . doors %~ addDoor)
where
drid = IM.newKey $ _doors (_cWorld gw)
drid = IM.newKey $ _doors (_lWorld (_cWorld gw))
addDoor =
IM.insert drid $
dr
@@ -103,7 +103,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 (_cWorld gw) ..]
wlids = take 4 [IM.newKey $ _walls (_lWorld (_cWorld gw)) ..]
-- old code that may help with pathing
--import Dodge.LevelGen.Pathing