justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Make buttons without labels inactive

Browse Source
This commit is contained in:
justin
2021-03-08 17:03:58 +01:00
parent 70f8914767
commit 9f58066dba
4 changed files with 52 additions and 89 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Rendering.hs
+15 -12
View File
@@ -2,6 +2,8 @@ module Dodge.Rendering where
-- imports {{{
import Dodge.Data
import Dodge.Base
import Dodge.Inventory
import Geometry
import Picture
@@ -27,6 +29,7 @@ fixedCoordPictures w = pictures
-- [ scaler $ onLayer LabelLayer $ pictures [ppLabels, btLabels]
[ scaler $ hudDrawings w
, scaler $ onLayer MenuLayer menuScreen
, onLayer InvLayer $ activeObjectText w
]
where scaler = scale (2 / _windowX w) (2 / _windowY w)
menuScreen :: Picture
@@ -52,6 +55,18 @@ fixedCoordPictures w = pictures
]
where tst x y sc t = translate x y $ scale sc sc $ color white $ text t
activeObjectText :: World -> Picture
activeObjectText w = case closestActiveObject w of
Nothing -> Blank
Just (Right bt) -> pictures
[ scale (2/_windowX w) (2/_windowY w)
$ translate (0.25*_windowX w) (0.25*_windowY w)
$ scale 0.1 0.1 $ text $ _btText bt
, line [ (0,0),(0.5,0.5)]
]
where btp = _btPos bt
Just (Left flit) -> blank
worldPictures :: World -> Picture
worldPictures w
= pictures $ concat [ decPicts
@@ -86,9 +101,6 @@ worldPictures 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)))
--
scaler = onLayer LabelLayer . setLayer 1
itLabels = map (scaler . drawItemName w) (IM.elems (_floorItems w))
ppLabels = map (scaler . drawPPText w) (IM.elems (_pressPlates w))
@@ -378,21 +390,12 @@ drawButText w bt | magV (_crPos (you w) -.- _btPos bt) < 100
, tranItPos' $ line [(-8,10),(-15,10),(-15,-10),(-8,-10)]
, tranItPos' $ line [( 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 $ _btText bt
-- ]
| otherwise = blank
where tranItPos' = uncurry translate (_btPos bt) . rotate (_cameraRot w)
t = rotate (0 - (_cameraRot w))
. uncurry translate (zoom *.* (_btPos bt -.- _cameraPos w))
. rotate (_cameraRot w)
zoom = _cameraZoom w
-- where t = rotate (0 - (_cameraRot w)) . uncurry translate (zoom *.* (_btPos bt -.- _cameraPos w))
-- zoom = _cameraZoom w
-- scLine = dShadCol white . line . fmap (sqrt zoom *.*)
drawPPText :: World -> PressPlate -> Picture
drawPPText w pp | magV (_crPos (you w) -.- _ppPos pp) < 100