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:
jgk
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/LevelGen/AutoDoor.hs
+3 -3
View File
@@ -40,10 +40,10 @@ mkAutoDoor pl pr xs = addSound $ zipWith3 (autoDoorPane [pl,pr])
, [pru,prd]
, [prd,prrd,pr,pr]
]
where norm = 15.1 *.* errorNormalizeV 49 ( vNormal (pr -.- pl))
-- .1 hack, there was flickering
where norm = 10 *.* errorNormalizeV 49 ( vNormal (pr -.- pl))
hw = 0.5 *.* (pl +.+ pr)
parallel = 20 *.* normalizeV (pl -.- pr)
--parallel = 15 *.* normalizeV (pl -.- pr)
parallel = 0.51 *.* (pl -.- pr)
plu = pl +.+ norm
pld = pl -.- norm
pru = pr +.+ norm
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