Work towards doing transformations using uniforms
This commit is contained in:
+129
-68
@@ -22,65 +22,42 @@ import qualified Data.Map as M
|
||||
import qualified Data.Set as S
|
||||
|
||||
-- }}}
|
||||
--
|
||||
drawTest :: World -> Picture
|
||||
drawTest w = screenT $ color red $ circle 200
|
||||
where (x,y) = (_windowX w,_windowY w)
|
||||
screenT = scale (1/x) (1/y)
|
||||
|
||||
|
||||
draw' :: Picture -> World -> ([((Float,Float),(Float,Float))]
|
||||
,[((Float,Float),Float,Float)]
|
||||
,Picture,Picture)
|
||||
draw' p w = (\(x,y) -> (wallsForGloom w,lightsForGloom w,x,y)) (draw'' p w)
|
||||
|
||||
draw :: Picture -> World -> Picture
|
||||
draw p w = (\(x,y) -> f $ pictures [x,y]) $ draw'' p w
|
||||
where f = scale (2/_windowX w) (2/_windowY w)
|
||||
|
||||
draw'' :: Picture -> World -> (Picture , Picture)
|
||||
draw'' b w-- | (Char 'm') `S.member` _keys w
|
||||
-- = let a = (-500,30)
|
||||
-- b = (200,0)
|
||||
-- in pictures [ color white $ polygon screenBox
|
||||
-- , color blue $ circleSolid 40
|
||||
-- , line [a,b]
|
||||
-- , uncurry translate (ssaTriPoint a (0,0) b 40)
|
||||
-- $ color red $ circleSolid 5
|
||||
-- ]
|
||||
= case _mapDisplay w of
|
||||
(True, z) -> (blank
|
||||
,pictures [color white $ circleSolid 3
|
||||
,scale z z $ rotate (0 - (_cameraRot w))
|
||||
$ uncurry translate ((0,0) -.- _cameraCenter w)
|
||||
$ pictures $ mapMaybe mapWall $ IM.elems $ _walls w]
|
||||
)
|
||||
_ -> ( blank
|
||||
--,pictures $ map fst pics
|
||||
,collectDrawings w
|
||||
)
|
||||
-- ++ map screenShift (pathsTest ++ map drawNode (labNodes $ _pathGraph w))
|
||||
where yourPos = _crPos $ you w
|
||||
backgroundTile = [screenShift $ translate (5*512*x) (5*512*y) $ scale 5 5 b | x <- [x1..x2] , y <- [y1..y2] ]
|
||||
where (x',y') = yourPos
|
||||
(x'',y'') = (fromIntegral $ round (x'/(512*5)), fromIntegral $ round (y'/(512*5)))
|
||||
x1 = (x''-1)
|
||||
x2 = (x''+1)
|
||||
y1 = (y''-1)
|
||||
y2 = (y''+1)
|
||||
screenShift = scale zoom zoom . rotate (0 - (_cameraRot w) )
|
||||
. uncurry translate ((0,0) -.- _cameraPos w)
|
||||
zoom = _cameraZoom w
|
||||
pathsTest = map drawPair $ _pathGraph' w
|
||||
drawPair (x,y) = color cyan $ pictures [line [x,y]
|
||||
-- , uncurry translate x $ scale 0.05 0.05 $ text $ show x
|
||||
fixedCoordPictures :: World -> Picture
|
||||
fixedCoordPictures w = pictures
|
||||
[ scaler $ onLayer LabelLayer $ pictures [itLabels, ppLabels, btLabels]
|
||||
, scaler $ hudDrawings w
|
||||
, scaler $ onLayer MenuLayer menuScreen
|
||||
]
|
||||
where scaler = scale (2 / _windowX w) (2 / _windowY w)
|
||||
itLabels = pictures $ map (drawItemName w) (IM.elems (_floorItems w))
|
||||
ppLabels = pictures $ map (drawPPText w) (IM.elems (_pressPlates w))
|
||||
btLabels = pictures $ map (drawButText w) (IM.elems (_buttons w))
|
||||
menuScreen :: Picture
|
||||
menuScreen = case _menuState w of
|
||||
InGame -> blank
|
||||
LevelMenu x ->
|
||||
pictures [--color (withAlpha 0.5 black) $ polygon $ screenBox w
|
||||
tst (-100) 100 0.4 ("LEVEL "++show x)
|
||||
,controlsList
|
||||
]
|
||||
PauseMenu -> pictures
|
||||
[--color (withAlpha 0.5 black) $ polygon $ screenBox w
|
||||
tst (-100) 100 0.4 "PAUSED"
|
||||
,tst (-100) 50 0.2 "n - new level"
|
||||
,tst (-100) 0 0.2 "r - restart"
|
||||
, controlsList
|
||||
]
|
||||
drawNode (i,x) = color yellow $ uncurry translate x $ scale 0.05 0.05 $ text $ show i
|
||||
GameOverMenu -> pictures [color (withAlpha 0.5 black) $ polygon $ screenBox w
|
||||
,tst (-100) 100 0.4 "GAME OVER"
|
||||
,tst (-100) 50 0.2 "n - new level"
|
||||
,tst (-100) 0 0.2 "r - restart"
|
||||
,controlsList
|
||||
]
|
||||
where tst x y sc t = translate x y $ scale sc sc $ color white $ text t
|
||||
|
||||
collectDrawings :: World -> Picture
|
||||
collectDrawings w = pictures
|
||||
[screenShift $
|
||||
pictures $ concat
|
||||
worldPictures :: World -> Picture
|
||||
worldPictures w
|
||||
= pictures $ map screenShift $ concat
|
||||
[ decPicts
|
||||
, ppPicts
|
||||
, itFloorPicts
|
||||
@@ -94,15 +71,99 @@ collectDrawings w = pictures
|
||||
, wallShadows
|
||||
, smokeShadows
|
||||
]
|
||||
, onLayer LabelLayer $ pictures [itLabels, ppLabels, btLabels]
|
||||
, hudDrawings w
|
||||
, onLayer MenuLayer menuScreen
|
||||
where
|
||||
screenShift = scale zoomx zoomy . rotate (0 - (_cameraRot w) )
|
||||
. uncurry translate ((0,0) -.- _cameraPos w)
|
||||
zoomx = 2 * _cameraZoom w / _windowX w
|
||||
zoomy = 2 * _cameraZoom w / _windowY w
|
||||
scaler = scale (2 / _windowX w) (2 / _windowY w)
|
||||
decPicts = IM.elems $ _decorations w
|
||||
ptPicts = map _ptPict (IM.elems (_particles w))
|
||||
ptPicts' = map _ptPict' $ _particles' w
|
||||
afterPtPicts' = map _ptPict' $ _afterParticles' w
|
||||
buttonPicts = map btDraw (IM.elems (_buttons w))
|
||||
ppPicts = map ppDraw (IM.elems (_pressPlates w))
|
||||
crPicts = map crDraw $ IM.elems $ _creatures w
|
||||
clPicts = map clDraw $ IM.elems $ _clouds w
|
||||
wallShadows = map (drawWallShadow w) $ wallShadowsToDraw w
|
||||
smokeShadows = map (drawSmokeShadow w) $ _smoke w
|
||||
wlPicts = map drawWall (wallsToDraw w)
|
||||
itFloorPicts = map (drawItem) (IM.elems (_floorItems w))
|
||||
yourPos = _crPos $ you w
|
||||
yourRot = _crDir $ you w
|
||||
yourRad = _crRad $ you w
|
||||
-- itFloorPicts = zipWith (uncurry translate) (map _flItPos (IM.elems (_floorItems w)))
|
||||
-- (map (_itFloorPict . _flIt) (IM.elems (_floorItems w)))
|
||||
itLabels = pictures $ map (drawItemName w) (IM.elems (_floorItems w))
|
||||
ppLabels = pictures $ map (drawPPText w) (IM.elems (_pressPlates w))
|
||||
btLabels = pictures $ map (drawButText w) (IM.elems (_buttons w))
|
||||
menuScreen :: Picture
|
||||
menuScreen = case _menuState w of
|
||||
InGame -> blank
|
||||
LevelMenu x ->
|
||||
pictures [--color (withAlpha 0.5 black) $ polygon $ screenBox w
|
||||
tst (-100) 100 0.4 ("LEVEL "++show x)
|
||||
,controlsList
|
||||
]
|
||||
PauseMenu -> pictures
|
||||
[--color (withAlpha 0.5 black) $ polygon $ screenBox w
|
||||
tst (-100) 100 0.4 "PAUSED"
|
||||
,tst (-100) 50 0.2 "n - new level"
|
||||
,tst (-100) 0 0.2 "r - restart"
|
||||
, controlsList
|
||||
]
|
||||
GameOverMenu -> pictures [color (withAlpha 0.5 black) $ polygon $ screenBox w
|
||||
,tst (-100) 100 0.4 "GAME OVER"
|
||||
,tst (-100) 50 0.2 "n - new level"
|
||||
,tst (-100) 0 0.2 "r - restart"
|
||||
,controlsList
|
||||
]
|
||||
where tst x y sc t = translate x y $ scale sc sc $ color white $ text t
|
||||
|
||||
draw :: World -> Picture
|
||||
draw w
|
||||
= case _mapDisplay w of
|
||||
(True, z) -> scaler $ pictures [color white $ circleSolid 3
|
||||
,scale z z $ rotate (0 - (_cameraRot w))
|
||||
$ uncurry translate ((0,0) -.- _cameraCenter w)
|
||||
$ pictures $ mapMaybe mapWall $ IM.elems $ _walls w]
|
||||
_ -> collectDrawings w
|
||||
where yourPos = _crPos $ you w
|
||||
f = scale (2/_windowX w) (2/_windowY w)
|
||||
pathsTest = map drawPair $ _pathGraph' w
|
||||
drawPair (x,y) = color cyan $ pictures [line [x,y]
|
||||
-- , uncurry translate x $ scale 0.05 0.05 $ text $ show x
|
||||
]
|
||||
drawNode (i,x) = color yellow $ uncurry translate x $ scale 0.05 0.05 $ text $ show i
|
||||
scaler = scale (2 / _windowX w) (2 / _windowY w)
|
||||
|
||||
collectDrawings :: World -> Picture
|
||||
collectDrawings w = pictures $ (map screenShift $
|
||||
concat
|
||||
[ decPicts
|
||||
, ppPicts
|
||||
, itFloorPicts
|
||||
, crPicts
|
||||
, clPicts
|
||||
, buttonPicts
|
||||
, ptPicts
|
||||
, ptPicts'
|
||||
, afterPtPicts'
|
||||
, wlPicts
|
||||
, wallShadows
|
||||
, smokeShadows
|
||||
]) ++
|
||||
[ scaler $ onLayer LabelLayer $ pictures [itLabels, ppLabels, btLabels]
|
||||
, scaler $ hudDrawings w
|
||||
, scaler $ onLayer MenuLayer menuScreen
|
||||
]
|
||||
-- <> [onLayer GloomLayer $ theLighting w]
|
||||
where
|
||||
screenShift = scale zoom zoom . rotate (0 - (_cameraRot w) )
|
||||
screenShift = scale zoomx zoomy . rotate (0 - (_cameraRot w) )
|
||||
. uncurry translate ((0,0) -.- _cameraPos w)
|
||||
zoom = _cameraZoom w
|
||||
zoomx = 2 * _cameraZoom w / _windowX w
|
||||
zoomy = 2 * _cameraZoom w / _windowY w
|
||||
scaler = scale (2 / _windowX w) (2 / _windowY w)
|
||||
decPicts = IM.elems $ _decorations w
|
||||
ptPicts = map _ptPict (IM.elems (_particles w))
|
||||
ptPicts' = map _ptPict' $ _particles' w
|
||||
@@ -444,12 +505,12 @@ ringPict = onLayer LabelLayer $ dShadCol white $ pictures [line [(-8,10),(-15,10
|
||||
|
||||
dShadCol :: Color -> Picture -> Picture
|
||||
dShadCol c p = pictures $
|
||||
map (flip (uncurry translate) p) [(0.2,-0.2)
|
||||
,(0.4,-0.4)
|
||||
,(0.6,-0.6)
|
||||
,(0.8,-0.8)
|
||||
,( 1,- 1)
|
||||
,(1.2,-1.2)
|
||||
map (flip (uncurry translate) p) [--(0.2,-0.2)
|
||||
--,(0.4,-0.4)
|
||||
--,(0.6,-0.6)
|
||||
--,(0.8,-0.8)
|
||||
--,( 1,- 1)
|
||||
(1.2,-1.2)
|
||||
] ++ [color c p]
|
||||
|
||||
dropShadow :: Picture -> Picture
|
||||
|
||||
Reference in New Issue
Block a user