Reimplement floor item label cursors
This commit is contained in:
+1
-3
@@ -51,9 +51,7 @@ main = do
|
||||
doPreload
|
||||
cleanUpPreload
|
||||
(initializeWorld $ generateFromTree lev1 $ initWorld)
|
||||
(-- \((bs:fs:ts:_),tes) w -> --do render setparams w egFade
|
||||
\preData w -> --do render setparams w egFade
|
||||
do
|
||||
( \preData w -> do
|
||||
startTicks <- SDL.ticks
|
||||
(lightTicks,timeSpentPoking) <- renderPicture' (_renderData preData)
|
||||
(_cameraRot w) (_cameraZoom w)
|
||||
|
||||
+29
-102
@@ -24,12 +24,13 @@ import qualified Data.Set as S
|
||||
-- }}}
|
||||
fixedCoordPictures :: World -> Picture
|
||||
fixedCoordPictures w = pictures
|
||||
[ scaler $ onLayer LabelLayer $ pictures [itLabels, ppLabels, btLabels]
|
||||
-- [ scaler $ onLayer LabelLayer $ pictures [itLabels, ppLabels, btLabels]
|
||||
[ scaler $ onLayer LabelLayer $ pictures [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))
|
||||
-- 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
|
||||
@@ -69,6 +70,7 @@ worldPictures w
|
||||
, wlPicts
|
||||
, wallShadows
|
||||
, smokeShadows
|
||||
, itLabels
|
||||
]
|
||||
where
|
||||
decPicts = IM.elems $ _decorations w
|
||||
@@ -88,94 +90,9 @@ worldPictures 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 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 (setLayer 0 . drawWallShadow w) $ wallShadowsToDraw w
|
||||
smokeShadows = map (drawSmokeShadow w) $ _smoke w
|
||||
wlPicts = map (setLayer 0 . 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))
|
||||
--
|
||||
scaler = onLayer LabelLayer . setLayer 1
|
||||
itLabels = map (scaler . 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
|
||||
@@ -206,8 +123,7 @@ hudDrawings w = setLayer 1 $ (onLayer InvLayer)
|
||||
$ pictures
|
||||
[ displayInv 0 w
|
||||
, dShadCol white $ displayHP 0 w
|
||||
, --color (itCol (yourItem w))
|
||||
drawCursor (itCol (yourItem w)) w
|
||||
, drawCursor (itCol (yourItem w)) w
|
||||
, translate (-390) 20
|
||||
$ scale 0.05 0.05 $ dShadCol white $ text (_testString w)
|
||||
]
|
||||
@@ -450,8 +366,8 @@ displayAmount n | n > 1 = "-x" ++show n
|
||||
rectangleSolid x y = polygon [(x,y),(x,-y),(-x,-y),(-x,y)]
|
||||
|
||||
drawItem :: FloorItem -> Drawing
|
||||
drawItem (FlAm {_flItPos = p}) = uncurry translateDrawing p $ onLayer FlItLayer $ rectangleSolid 5 5
|
||||
drawItem flIt = uncurry translateDrawing (_flItPos flIt)
|
||||
drawItem (FlAm {_flItPos = p}) = uncurry translate p $ onLayer FlItLayer $ rectangleSolid 5 5
|
||||
drawItem flIt = uncurry translate (_flItPos flIt)
|
||||
$ rotateDrawing (radToDeg $ _flItRot flIt) (_itFloorPict (_flIt flIt))
|
||||
|
||||
drawButText :: World -> Button -> Picture
|
||||
@@ -486,19 +402,30 @@ drawPPText w pp | magV (_crPos (you w) -.- _ppPos pp) < 100
|
||||
drawItemName :: World -> FloorItem -> Picture
|
||||
drawItemName w flIt | magV (_crPos (you w) -.- _flItPos flIt) < 100
|
||||
&& hasLOS (_flItPos flIt) (_crPos (you w)) w
|
||||
= t $ rotate (_cameraRot w)
|
||||
$ pictures $ [ scLine [(-8,10),(-15,10),(-15,-10),(-8,-10)]
|
||||
, scLine [( 8,10),( 15,10),( 15,-10),( 8,-10)]
|
||||
,translate (-15) (-10*sqrt zoom - 5) $ dShadCol white
|
||||
$ scale 0.1 0.1 $ text $ nameOfItem
|
||||
]
|
||||
= pictures
|
||||
[ scale (2/_windowX w) (2/_windowY w)
|
||||
. tranItPos
|
||||
. translate (-15) (-10*sqrt zoom - 5) $ dShadCol white
|
||||
$ scale 0.1 0.1 $ text $ nameOfItem
|
||||
, tranItPos' $ scLine [(-8,10),(-15,10),(-15,-10),(-8,-10)]
|
||||
, tranItPos' $ scLine [( 8,10),( 15,10),( 15,-10),( 8,-10)]
|
||||
]
|
||||
-- ,
|
||||
-- t $ rotate (_cameraRot w)
|
||||
-- $ pictures $ [ scLine [(-8,10),(-15,10),(-15,-10),(-8,-10)]
|
||||
-- , scLine [( 8,10),( 15,10),( 15,-10),( 8,-10)]
|
||||
-- ,translate (-15) (-10*sqrt zoom - 5) $ dShadCol white
|
||||
-- $ scale 0.1 0.1 $ text $ nameOfItem
|
||||
-- ]
|
||||
| otherwise = blank
|
||||
where t = rotate (0 - (_cameraRot w)) . uncurry translate (zoom *.* (_flItPos flIt -.- _cameraPos w))
|
||||
where tranItPos = uncurry translate $ zoom *.* (_flItPos flIt -.- _cameraPos w)
|
||||
tranItPos' = uncurry translate $ (_flItPos flIt)
|
||||
t = rotate (0 - (_cameraRot w)) . uncurry translate (zoom *.* (_flItPos flIt -.- _cameraPos w))
|
||||
nameOfItem = case flIt of FlIt {} -> _itName $ _flIt flIt
|
||||
FlAm {_flAm = PistolBullet} -> "Bullets"
|
||||
FlAm {_flAm = LiquidFuel} -> "Liquid Fuel"
|
||||
zoom = _cameraZoom w
|
||||
scLine = dShadCol white . line . fmap (sqrt zoom *.*)
|
||||
scLine = line -- . fmap ( zoom *.*)
|
||||
|
||||
ringPict :: Drawing
|
||||
ringPict = onLayer LabelLayer $ dShadCol white $ pictures [line [(-8,10),(-15,10),(-15,-10),(-8,-10)]
|
||||
|
||||
Reference in New Issue
Block a user