Hack wall depth, objects don't appear on top of walls (nor beneath windows)
This commit is contained in:
@@ -32,6 +32,7 @@ lev1 = do
|
||||
(
|
||||
[return $ return $ Right deadEndRoom
|
||||
]
|
||||
++[roomMiniIntro]
|
||||
++ [longRoom >>= randomiseLinks]
|
||||
++ [return $ connectRoom corridor
|
||||
,return $ connectRoom door]
|
||||
|
||||
@@ -28,13 +28,6 @@ mkAutoDoor pl pr xs = addSound $ zipWith3 (autoDoorPane [pl,pr])
|
||||
xs
|
||||
(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]
|
||||
@@ -45,7 +38,6 @@ mkAutoDoor pl pr xs = addSound $ zipWith3 (autoDoorPane [pl,pr])
|
||||
]
|
||||
norm = 10 *.* errorNormalizeV 49 ( vNormal (pr -.- pl))
|
||||
hw = 0.5 *.* (pl +.+ pr)
|
||||
--parallel = 15 *.* normalizeV (pl -.- pr)
|
||||
parallel = 0.5 *.* (pl -.- pr)
|
||||
plu = pl +.+ norm
|
||||
pld = pl -.- norm
|
||||
@@ -56,14 +48,10 @@ mkAutoDoor pl pr xs = addSound $ zipWith3 (autoDoorPane [pl,pr])
|
||||
shiftL = map $ (+.+ parallel) . (-.- normalizeV parallel)
|
||||
shiftR = map $ (-.- parallel) . (+.+ normalizeV parallel)
|
||||
|
||||
pllu = plu +.+ parallel
|
||||
plld = pld +.+ parallel
|
||||
prru = pru -.- parallel
|
||||
prrd = prd -.- parallel
|
||||
addSound (x:xs) = f x : xs
|
||||
f wl = over doorMech g wl
|
||||
g dm w | dist wp pld > 1 && dist wp hwd > 1 = soundFrom (WallSound (head xs)) (fromIntegral doorSound) 1 0
|
||||
$ dm w
|
||||
g dm w | dist wp pld > 1 && dist wp hwd > 1
|
||||
= soundFrom (WallSound (head xs)) (fromIntegral doorSound) 1 0 $ dm w
|
||||
| otherwise = dm w
|
||||
where wp = (_wlLine $ _walls w IM.! (head xs)) !! 1
|
||||
|
||||
|
||||
+9
-23
@@ -66,12 +66,12 @@ worldPictures w
|
||||
, ptPicts
|
||||
, ptPicts'
|
||||
, afterPtPicts'
|
||||
-- , wlPicts'
|
||||
, wlPicts
|
||||
, smokeShadows
|
||||
, ppLabels
|
||||
, btLabels
|
||||
, testPic w
|
||||
, wallsToSetDepth
|
||||
]
|
||||
where
|
||||
decPicts = IM.elems $ _decorations w
|
||||
@@ -84,7 +84,7 @@ worldPictures w
|
||||
clPicts = map clDraw $ IM.elems $ _clouds w
|
||||
smokeShadows = map (drawSmokeShadow w) $ _smoke w
|
||||
wlPicts = map drawWallFloor (wallFloorsToDraw w)
|
||||
wlPicts' = map (drawWallFace w) (wallShadowsToDraw w)
|
||||
wallsToSetDepth = map (drawWallFace w) (wallShadowsToDraw w)
|
||||
itFloorPicts = map drawItem (IM.elems (_floorItems w))
|
||||
yourPos = _crPos $ you w
|
||||
yourRot = _crDir $ you w
|
||||
@@ -271,9 +271,9 @@ outsideScreenPolygon w = [tr,tl,bl,br]
|
||||
x = halfWidth w + halfHeight w
|
||||
|
||||
wallShadowsToDraw :: World -> [Wall]
|
||||
wallShadowsToDraw w = --IM.elems $ _walls w
|
||||
filter isVisible $ IM.elems -- $ _walls w
|
||||
$ wallsNearZones (zoneOfSight w) w
|
||||
wallShadowsToDraw w = filter isVisible
|
||||
. IM.elems
|
||||
$ wallsNearZones (zoneOfSight w) w
|
||||
-- should really sort this out
|
||||
where onScreen wall = True -- lineOnScreenCone w (_wlLine wall)
|
||||
isVisible wl | wl ^? blVisible == Just False = False
|
||||
@@ -299,21 +299,12 @@ lineOnScreen w (p1:p2:_) = errorPointInPolygon 8 p1 sp || errorPointInPolygon 9
|
||||
|
||||
drawWallFace :: World -> Wall -> Picture
|
||||
drawWallFace w wall
|
||||
| isRHS sightFrom x y = blank
|
||||
| otherwise = colorAndLayer $ polygon $ points
|
||||
| isRHS sightFrom x y || _wlIsSeeThrough wall = blank
|
||||
| otherwise = setLayer 3 . setDepth 1 . polygon $ points
|
||||
where
|
||||
colorAndLayer | _wlIsSeeThrough wall = setLayer 2
|
||||
. onLayerL [levLayer ShadowLayer,3]
|
||||
. color (withAlpha 0.5 $ _wlColor wall)
|
||||
| otherwise = setLayer 0
|
||||
. onLayerL [levLayer ShadowLayer,l]
|
||||
. color (_wlColor wall)
|
||||
(x:y:_) = _wlLine wall
|
||||
points = extendConeToScreenEdge w sightFrom (x,y)
|
||||
sightFrom = _cameraCenter w
|
||||
l = case wall of
|
||||
Door {} -> 1
|
||||
_ -> 2
|
||||
|
||||
-- the following assumes that the point a is inside the screen
|
||||
-- it still works otherwise, but it might intersect two points:
|
||||
@@ -445,7 +436,8 @@ wallsPointsAndCols w = map f . filter (not . _wlIsSeeThrough) . IM.elems $ walls
|
||||
f wl = (linePairs $ _wlLine wl, _wlColor wl)
|
||||
|
||||
wallsWindows :: World -> [((Point2,Point2),Point4)]
|
||||
wallsWindows w = map f . filter _wlIsSeeThrough . IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
|
||||
wallsWindows w = map f . filter (fromMaybe True . (^? blVisible)) .
|
||||
filter _wlIsSeeThrough . IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
|
||||
where linePairs (x:y:_) = (x,y)
|
||||
f wl = (linePairs $ _wlLine wl, _wlColor wl)
|
||||
|
||||
@@ -455,12 +447,6 @@ wallsForShadows w = map (linePairs . _wlLine)
|
||||
. IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
|
||||
where linePairs (x:y:_) = (x,y)
|
||||
|
||||
wallsForGloom :: World -> [((Point2,Point2),Point4)]
|
||||
wallsForGloom w = map f $ filter (not . _wlIsSeeThrough)
|
||||
$ IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
|
||||
where linePairs (x:y:_) = (x,y)
|
||||
f wl = (linePairs $ _wlLine wl, _wlColor wl)
|
||||
|
||||
lightsForGloom' :: World -> [(Point4)]
|
||||
lightsForGloom' w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w)
|
||||
where getLS ls = ( fst $ _lsPos ls, snd $ _lsPos ls, _lsRad ls , _lsIntensity ls)
|
||||
|
||||
Reference in New Issue
Block a user