Implement textures on walls, windows don't look great yet
This commit is contained in:
@@ -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
|
||||
|
||||
+19
-3
@@ -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
|
||||
|
||||
@@ -41,10 +41,10 @@ setCommonUniforms pdata rot zoom (tranx,trany) (winx,winy) = do
|
||||
: (map extractProgAndUnis $ _listShaders pdata)
|
||||
)
|
||||
|
||||
renderPicture' :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) ->
|
||||
[((Point2,Point2),Point4)] -> [Point4] ->
|
||||
renderPicture' :: RenderData -> Float -> Float -> Point2 -> Point2 ->
|
||||
[((Point2,Point2),Point4)] -> [((Point2,Point2),Point4)] -> [Point4] ->
|
||||
(Float,Float) -> Picture -> IO (Word32,Word32)
|
||||
renderPicture' pdata rot zoom trans@(tranx,trany) wins@(winx,winy) wallPointsCol lightPoints
|
||||
renderPicture' pdata rot zoom trans@(tranx,trany) wins@(winx,winy) wallPointsCol windowPoints lightPoints
|
||||
viewFroms@(viewFromx,viewFromy) pic = do
|
||||
let wallPoints = map fst wallPointsCol
|
||||
startTicks <- SDL.ticks
|
||||
@@ -67,6 +67,8 @@ renderPicture' pdata rot zoom trans@(tranx,trany) wins@(winx,winy) wallPointsCol
|
||||
|
||||
renderWalls pdata wallPointsCol pmat
|
||||
|
||||
renderWalls pdata windowPoints pmat
|
||||
|
||||
-- reset blend so that light map doesn't apply
|
||||
blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
|
||||
renderFoldable pdata $ picToLTree (Just 1) pic
|
||||
@@ -120,7 +122,6 @@ createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
|
||||
uniform ( (fromJust $ _shaderCustomUnis $ _wallShadowShader pdata) !! 2)
|
||||
$= (0 :: Float)
|
||||
cullFace $= Just Back
|
||||
cullFace $= Nothing
|
||||
drawShader (_wallShadowShader pdata) nWalls
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user