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

Start to add mountable objects

Browse Source
This commit is contained in:
justin
2022-06-23 16:07:58 +01:00
parent 85406d06c1
commit e3d5c4eb4b
6 changed files with 31 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Placement/Instance/Door.hs
+2 -2
View File
@@ -45,13 +45,13 @@ doorBetween pathing col cond soff pa pb speed g = case divideLine 40 pa pb of
divideDoorPane :: Maybe Int -> Bool -> Color -> (World -> Bool) -> Float -> Float
-> [(Point2,Point2)] -> (Placement -> Maybe Placement) -> Placement
divideDoorPane mid pathing col cond soff speed ppairs g = case ppairs of
[p] -> ptCont (adoor p) $ g
[p] -> ptCont (adoor p) g
(p:ps) -> ptCont (adoor p) $ \pl -> Just $ divideDoorPane (_plMID pl) pathing col cond soff speed ps g
_ -> undefined
where
adoor (x,y) = PutSlideDr pathing col thedoor soff x y
thedoor = defaultDoor & drSpeed .~ speed & drTrigger .~ cond
& drSupport .~ maybe SupportsItself SupportedBy mid
& drPushedBy .~ maybe PushesItself PushedBy mid
putAutoDoor :: Point2 -> Point2 -> Placement
putAutoDoor a b = PlacementUsingPos (addZ 0 a)