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

Implement textures on walls, windows don't look great yet

Browse Source
This commit is contained in:
justin
2021-03-21 22:21:29 +01:00
parent e6c76da6b3
commit abd7cd7ea9
5 changed files with 29 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Rendering.hs
+19 -3
View File
@@ -29,9 +29,9 @@ fixedCoordPictures :: World -> Picture
fixedCoordPictures w = pictures
[ scaler $ hudDrawings w
, scaler $ onLayer MenuLayer menuScreen
, onLayer InvLayer $ closeObjectTexts w
, setDepth 1 $ closeObjectTexts w
]
where scaler = scale (2 / _windowX w) (2 / _windowY w)
where scaler = setDepth 1 . scale (2 / _windowX w) (2 / _windowY w)
menuScreen :: Picture
menuScreen = case _menuState w of
InGame -> blank
@@ -241,7 +241,7 @@ drawSmokeShadow w sm@(Smoke {_smPos = p, _smRad = r', _smColor = c, _smPs = ps,
drawWallFloor :: Wall -> Picture
drawWallFloor wl = if _wlIsSeeThrough wl
then onLayerL [levLayer WlLayer] $ color c $ polygon [x,x +.+ n2,y+.+n2, y]
then onLayerL [0] $ color c $ polygon [x,x +.+ n2,y+.+n2, y]
else blank
where
(x:y:_) = _wlLine wl
@@ -439,6 +439,22 @@ displayHP n w = translate (halfWidth w-80) (halfHeight w-20) $
scale 0.2 0.2 $ text $ reverse $ take 5 $ (++ repeat ' ') $ reverse $ show
$ _crHP $ _creatures w IM.! n
wallsPointsAndCols :: World -> [((Point2,Point2),Point4)]
wallsPointsAndCols 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)
wallsWindows :: World -> [((Point2,Point2),Point4)]
wallsWindows w = map f . filter _wlIsSeeThrough . IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
where linePairs (x:y:_) = (x,y)
f wl = (linePairs $ _wlLine wl, _wlColor wl)
wallsForShadows :: World -> [(Point2,Point2)]
wallsForShadows w = map (linePairs . _wlLine)
. filter (not . _wlIsSeeThrough)
. 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