60 lines
1.9 KiB
Haskell
60 lines
1.9 KiB
Haskell
module Dodge.Render.Walls (
|
|
wallsToDraw,
|
|
) where
|
|
|
|
import qualified Control.Foldl as L
|
|
import Control.Lens
|
|
import Dodge.Base.Wall
|
|
import Dodge.Data.World
|
|
import Dodge.Wall.Draw
|
|
--import Dodge.Zoning.Base
|
|
--import Dodge.Zoning.Wall
|
|
--import Dodge.Zoning.World
|
|
import Geometry
|
|
import ShapePicture
|
|
|
|
-- not necessary: should just poke all walls to their wanted places
|
|
wallsToDraw :: World -> ( [((Point2, Point2), Point4)], SPic, [Wall])
|
|
wallsToDraw w = L.fold
|
|
( (,,)
|
|
<$>L.prefilter wlSeeThroughDraw (L.premap f L.list)
|
|
<*> L.premap getWallSPic L.mconcat
|
|
<*> L.prefilter wlOpaqueDraw L.list
|
|
)
|
|
(w ^. cWorld . lWorld . walls)
|
|
-- (wlsFromIXs w $ zonesExtract (w ^. wlZoning) $ zoneOfSight wlZoneSize cam)
|
|
where
|
|
f wl = (_wlLine wl, _wlColor wl)
|
|
-- cam = w ^. cWorld . camPos
|
|
|
|
--wallsToDraw
|
|
-- :: World
|
|
-- -> ( [((Point2,Point2),Point4)] ,[((Point2,Point2),Point4)], SPic )
|
|
--wallsToDraw w
|
|
-- = ( wls, wins,spic)
|
|
-- where
|
|
-- f wl = (_wlLine wl, _wlColor wl)
|
|
-- (wls, wins, spic) = runIdentity $ L.purely S.fold_
|
|
-- ((,,)
|
|
-- <$> L.prefilter wlOpaqueDraw (L.premap f L.list)
|
|
-- <*> L.prefilter wlSeeThroughDraw (L.premap f L.list)
|
|
-- <*> L.premap getWallSPic L.mconcat
|
|
-- ) (S.concat $ S.mapMaybe g $ zoneOfSight wlZoneSize w)
|
|
-- g (V2 i j) = w ^? wlZoning . znObjects . ix i . ix j
|
|
|
|
wlOpaqueDraw :: Wall -> Bool
|
|
wlOpaqueDraw wl = wlIsOpaque wl && _wlHeight wl == 100
|
|
|
|
wlSeeThroughDraw :: Wall -> Bool
|
|
wlSeeThroughDraw wl = wlIsSeeThrough wl && _wlHeight wl == 100
|
|
|
|
getWallSPic :: Wall -> SPic
|
|
getWallSPic wl = case wl ^? wlOpacity . opDraw of
|
|
Nothing -> mempty
|
|
Just f -> drawWall f wl
|
|
|
|
-- (wins,wls) = partition theTest . IM.elems . IM.filter _wlUnshadowed $ wallsDoubleScreen cfig w
|
|
-- theTest wl = case _wlOpacity wl of
|
|
-- Opaque -> False
|
|
-- _ -> True
|