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/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})