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

Refactor wall face drawing

Browse Source
This commit is contained in:
jgk
2021-03-21 13:51:58 +01:00
parent 779c858a2c
commit ca14e3675b
1 changed files with 5 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Rendering.hs
+5 -15
View File
@@ -310,15 +310,14 @@ drawWallFace w wall
| otherwise = colorAndLayer $ polygon $ points
where
colorAndLayer | _wlIsSeeThrough wall = setLayer 2
. onLayerL [levLayer ShadowLayer,2]
. onLayerL [levLayer ShadowLayer,3]
. color (withAlpha 0.2 $ _wlColor wall)
| otherwise = setLayer 2
. onLayerL [levLayer ShadowLayer]
. onLayerL [levLayer ShadowLayer,2]
. color (_wlColor wall)
(x:y:_) = _wlLine wall
ps = linePointsBetween x y
ds = map (\p -> safeNormalizeV (p -.- sightFrom)) ps
p's = zipWith (\d x -> (15 *.* d) +.+ x) ds ps
ds = map (\p -> safeNormalizeV (p -.- sightFrom)) [x,y]
p's = zipWith (\d x -> (15 *.* d) +.+ x) ds [x,y]
sightFrom = _cameraCenter w
corns = screenPolygon w
borders = filter g $ zip corns (tail corns ++ [head corns])
@@ -329,16 +328,7 @@ drawWallFace w wall
isShadowed p = isLHS sightFrom x p && isRHS sightFrom y p
f (bpa,bpb) = intersectSegLineFrom' bpa bpb x (head p's)
f' (bpa,bpb) = intersectSegLineFrom' bpa bpb y (last p's)
points = orderPolygon (borderps ++ ps)
wallBase | _wlIsSeeThrough wall = polygon $ _wlLine wall
| otherwise = blank
linePointsBetween :: Point2 -> Point2 -> [Point2]
linePointsBetween p p' | d > 99 = map (\m -> p +.+ fromIntegral m *.* p'') [0..n-1] ++ [p']
| otherwise = [p,p']
where d = dist p p'
n = ceiling $ d / 50
p'' = (1/fromIntegral n) *.* (p' -.- p)
points = orderPolygon (borderps ++ [x,y])
displayInv :: Int -> World -> Picture
displayInv n w = pictures $ zipWith (translate (15-halfWidth w))