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

Improve control over floor items and buttons

Browse Source
This commit is contained in:
justin
2021-03-09 01:18:44 +01:00
parent 13cc9501a7
commit 2310bd1b09
7 changed files with 72 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Rendering.hs
+62 -7
View File
@@ -29,7 +29,8 @@ fixedCoordPictures w = pictures
-- [ scaler $ onLayer LabelLayer $ pictures [ppLabels, btLabels]
[ scaler $ hudDrawings w
, scaler $ onLayer MenuLayer menuScreen
, onLayer InvLayer $ activeObjectText w
--, onLayer InvLayer $ activeObjectText w
, onLayer InvLayer $ closeObjectTexts w
]
where scaler = scale (2 / _windowX w) (2 / _windowY w)
menuScreen :: Picture
@@ -55,18 +56,72 @@ fixedCoordPictures w = pictures
]
where tst x y sc t = translate x y $ scale sc sc $ color white $ text t
closeObjectTexts :: World -> Picture
closeObjectTexts w = pictures $ (zipWith ren [0..] $ map toTs $ _closeActiveObjects w)
++ maybeToList maybeLine
where toTs (Left x) = (_itInvColor $ _flIt x, _itName $ _flIt x)
toTs (Right x) = (white, _btText x)
ren i (c,t) = scale (2/_windowX w) (2/_windowY w)
. tran
. translate (xtran i) (0 - 20 * fromIntegral i)
. scale 0.1 0.1 $ color c $ text t
tran = case freeSlot of
Just i -> translate (pushout - halfWidth w) (halfHeight w - 20* (fromIntegral i +1))
Nothing -> translate (0.25*_windowX w) (0.25*_windowY w)
freeSlot = checkInvSlotsYou' (fmap _flIt mayIt) w
mayObj = listToMaybe $ _closeActiveObjects w
mayIt = mayObj >>= maybeLeft
maybeLeft (Left x) = Just x
maybeLeft _ = Nothing
pushout = 200
xtran 0 = case mayIt of Nothing -> 25
_ -> -25
xtran _ = 0
objPos obj = case obj of Left flit -> _flItPos flit
Right bt -> _btPos bt
objText obj = case obj of Left flit -> _itName $ _flIt flit
Right bt -> _btText bt
mayScreenPos = fmap objPos mayObj >>= (\thePos -> Just (sc $ rotateV (0 - _cameraRot w) $ _cameraZoom w *.* (thePos -.- _cameraPos w)))
sc (x, y) = (x*2/_windowX w, y*2/_windowY w)
maybeLine = do
itScreenPos <- mayScreenPos
theText <- fmap objText mayObj
let textWidth = 9 * fromIntegral (length theText)
let col = fromMaybe white $ fmap (_itInvColor . _flIt) mayIt
let p = case freeSlot of
Just i -> ( pushout - halfWidth w + textWidth
, halfHeight w - 20* (fromIntegral i +1) + 2.5
)
Nothing -> ( 0.25*_windowX w
, 0.25*_windowY w
)
let p' = case freeSlot of
Just i -> ( pushout - halfWidth w + 130
, halfHeight w - 20* (fromIntegral i +1) + 2.5
)
Nothing -> ( 0.25*_windowX w
, 0.25*_windowY w
)
return $ lineCol
[(itScreenPos, withAlpha 0 col)
,(sc p' , col)
,(sc p , col)
]
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)
$ translate (0.35*_windowX w) (0.25*_windowY w)
$ scale 0.1 0.1 $ text $ _btText bt
, line [sc $ rotateV (0 - _cameraRot w) $ _cameraZoom w *.* (_btPos bt -.- _cameraPos w)
,(0.5,0.5)
]
, lineCol [(p , withAlpha 0 white)
,((0.5,0.5) , white )
,((0.65,0.5), white )
]
]
where sc (x, y) = (x*2/_windowX w, y*2/_windowY w)
p = sc $ rotateV (0 - _cameraRot w) $ _cameraZoom w *.* (_btPos bt -.- _cameraPos w)
Just (Left flit)
-> pictures
[ color col $ scale (2/_windowX w) (2/_windowY w)
@@ -506,8 +561,8 @@ drawFFShadow w ff
, y]
displayHP :: Int -> World -> Picture
displayHP n w = translate (halfWidth w-70) (halfHeight w-40) $
scale 0.2 0.2 $ text $ show
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
testPic w = blank