Fix auto door opening

This commit is contained in:
jgk
2021-03-21 23:04:29 +01:00
parent abd7cd7ea9
commit c8a89163c1
3 changed files with 26 additions and 27 deletions
+1 -1
View File
@@ -32,7 +32,7 @@ lev1 = do
(
[return $ return $ Right deadEndRoom
]
++ [roomMiniIntro]
++ [longRoom >>= randomiseLinks]
++ [return $ connectRoom corridor
,return $ connectRoom door]
++ firstWeapon
+22 -16
View File
@@ -26,30 +26,36 @@ autoDoorAt a b wls = IM.union wls $ IM.fromList $ zip is $ mkAutoDoor a b is
mkAutoDoor :: Point2 -> Point2 -> [Int] -> [Wall]
mkAutoDoor pl pr xs = addSound $ zipWith3 (autoDoorPane [pl,pr])
xs
[ [pld,hwd,hw,pl]
, [hwd,hwu]
, [hwu,plu,pl,hw]
, [pru,hwu,hw,pr]
, [hwu,hwd]
, [hwd,prd,pr,hw]
]
[ [plld,pld,pl,pl]
, [pld,plu]
, [plu,pllu,pl,pl]
, [prru,pru,pr,pr]
, [pru,prd]
, [prd,prrd,pr,pr]
]
where norm = 10 *.* errorNormalizeV 49 ( vNormal (pr -.- pl))
(lDoorClosed ++ rDoorClosed)
(map shiftL lDoorClosed ++ map shiftR rDoorClosed)
-- [ [plld,pld]
-- , [pld,plu]
-- , [plu,pllu]
-- , [prru,pru]
-- , [pru,prd]
-- , [prd,prrd]
-- ]
where lDoorClosed = [ [pld,hwd]
, [hwd,hwu]
, [hwu,plu]
]
rDoorClosed = [ [pru,hwu]
, [hwu,hwd]
, [hwd,prd]
]
norm = 10 *.* errorNormalizeV 49 ( vNormal (pr -.- pl))
hw = 0.5 *.* (pl +.+ pr)
--parallel = 15 *.* normalizeV (pl -.- pr)
parallel = 0.51 *.* (pl -.- pr)
parallel = 0.5 *.* (pl -.- pr)
plu = pl +.+ norm
pld = pl -.- norm
pru = pr +.+ norm
prd = pr -.- norm
hwu = hw +.+ norm
hwd = hw -.- norm
shiftL = map $ (+.+ parallel) . (-.- normalizeV parallel)
shiftR = map $ (-.- parallel) . (+.+ normalizeV parallel)
pllu = plu +.+ parallel
plld = pld +.+ parallel
prru = pru -.- parallel
+3 -10
View File
@@ -206,7 +206,7 @@ door = Room
, _rmLinks = lnks
, _rmPath = [((20,35),(20,5))]
-- door extends into side walls (for shadows as rendered 12/03)
, _rmPS = [PS (0,20) 0 $ PutAutoDoor (-20,0) (60,0)]
, _rmPS = [PS (0,20) 0 $ PutAutoDoor (0,0) (40,0)]
, _rmBound = []
}
where lnks = [((20,35),0)
@@ -623,15 +623,6 @@ longRoom = do
h <- state $ randomR (1500,1500)
let w = 75
let cond x = (snd . fst) x < h - 40
-- let solidBlocks = putWallBlocks (12.5,h-25) (12.5,h-265)
-- ++putWallBlocks (37.5,h-25) (37.5,h-265)
-- ++putWallBlocks (62.5,h-25) (62.5,h-265)
-- ++putWallBlocks (87.5,h-25) (87.5,h-265)
-- let wBlocks = [PS (0,0) 0 $ PutWindowBlock (12.5,h-50) (12.5,h-265)
-- ,PS (0,0) 0 $ PutWindowBlock (37.5,h-50) (37.5,h-265)
-- ,PS (0,0) 0 $ PutWindowBlock (62.5,h-50) (62.5,h-265)
-- ,PS (0,0) 0 $ PutWindowBlock (87.5,h-50) (87.5,h-265)
-- ]
let ws = map (\ps -> PS (0,0) 0 $ PutWindow ps $ withAlpha 0.5 aquamarine)
[rectNSWE (h-35) (h-135) (-10) 10
,rectNSWE (h-35) (h-135) 15 35
@@ -652,6 +643,8 @@ longRoom = do
[PS ( 12.5,h-25) 0 $ PutCrit longCrit
,PS ( 37.5,h-25) 0 $ PutCrit longCrit
,PS ( 62.5,h-25) 0 $ PutCrit longCrit
,PS ( 25, 20) 0 $ basicLS
,PS ( 25, h-10) 0 $ basicLS
]
)
$ rm