Refactor inventory management, add tweak, combine and inspect modes
This commit is contained in:
+111
-39
@@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
module Dodge.Render.HUD
|
||||
where
|
||||
import Dodge.Data
|
||||
@@ -8,12 +9,17 @@ import Geometry
|
||||
|
||||
import Data.Maybe
|
||||
import qualified Data.IntMap as IM
|
||||
import qualified Data.Set as S
|
||||
import Control.Lens
|
||||
import SDL (MouseButton (..))
|
||||
|
||||
winScale :: World -> Picture -> Picture
|
||||
winScale w = scale (2 / getWindowX w) (2 / getWindowY w)
|
||||
|
||||
hudDrawings :: World -> Picture
|
||||
hudDrawings w = setLayer 1 . setDepth (-0.5) . pictures $
|
||||
[ scaler . dShadCol white $ displayHP 0 w
|
||||
, scaler . translate (-390) 20 . scale 0.05 0.05 . dShadCol white $ text (_testString w)
|
||||
[ winScale w . dShadCol white $ displayHP 0 w
|
||||
, winScale w . translate (-390) 20 . scale 0.05 0.05 . dShadCol white $ text (_testString w)
|
||||
]
|
||||
++ selectionText
|
||||
where
|
||||
@@ -21,26 +27,65 @@ hudDrawings w = setLayer 1 . setDepth (-0.5) . pictures $
|
||||
if _carteDisplay w
|
||||
then drawLocations w
|
||||
else drawInventory w
|
||||
scaler = scale (2 / getWindowX w) (2 / getWindowY w)
|
||||
|
||||
drawInventory :: World -> [Picture]
|
||||
drawInventory w =
|
||||
[ closeObjectTexts w
|
||||
, drawListCursor (itCol (yourItem w)) iPos w
|
||||
]
|
||||
++ displayInv 0 w
|
||||
drawInventory w = case _inventoryMode w of
|
||||
TopInventory -> [ closeObjectTexts w]
|
||||
++ topInvCursor col iPos w
|
||||
++ displayInv 0 w
|
||||
TweakInventory ->
|
||||
mCurs it w
|
||||
++ [cursorAt 120 col 5 iPos w]
|
||||
++ displayInv 0 w
|
||||
++ displayMidList w (ammoTweakStrings it) "TWEAK"
|
||||
++ mCurs it w
|
||||
CombineInventory -> displayInv 0 w ++ invHead w "COMBINE"
|
||||
InspectInventory -> displayInv 0 w ++ invHead w "INSPECT"
|
||||
where
|
||||
itCol = fromMaybe (greyN 0.5) . (^? itInvColor)
|
||||
iPos = _crInvSel $ _creatures w IM.! _yourID w
|
||||
it = yourItem w
|
||||
col = itCol it
|
||||
|
||||
topInvCursor :: Color -> Int -> World -> [Picture]
|
||||
topInvCursor col iPos w
|
||||
| ButtonRight `S.member` _mouseButtons w =
|
||||
[cursorAt 100 col 5 iPos w
|
||||
,openCursorAt 20 col 105 iPos w]
|
||||
| otherwise = [ openCursorAt 120 col 5 iPos w ]
|
||||
|
||||
ammoTweakStrings :: Item -> [String]
|
||||
ammoTweakStrings it = case it ^? wpAmmo . amPjMove of
|
||||
Just l -> map pjTweakString l
|
||||
_ -> ["NOT TWEAKABLE"]
|
||||
|
||||
mCurs :: Item -> World -> [Picture]
|
||||
mCurs it w = case it ^? wpAmmo . amParamSel of
|
||||
Nothing -> []
|
||||
Just i -> [openCursorAt 120 white 200 i w]
|
||||
|
||||
pjTweakString :: PjParam -> String
|
||||
pjTweakString pj = _pjDisplayParam pj $ _pjIntParam pj
|
||||
|
||||
displayMidList :: World -> [String] -> String -> [Picture]
|
||||
displayMidList w strs s =
|
||||
invHead w s
|
||||
++ renderListAt (200,0) (map (,white) strs) w
|
||||
|
||||
invHead :: World -> String -> [Picture]
|
||||
invHead w s = [winScale w . translate (-150) (150-halfHeight w)
|
||||
. dShadCol white . scale 0.5 0.5 $ text s
|
||||
]
|
||||
|
||||
displayListTopLeft :: [(String,Color)] -> World -> [Picture]
|
||||
displayListTopLeft scols w =
|
||||
map scaler $ zipWith
|
||||
(translate (15-halfWidth w))
|
||||
( map (\x -> halfHeight w - (20 * (fromIntegral x+1))) ([0..]::[Int]) )
|
||||
displayListTopLeft = renderListAt (0,0)
|
||||
|
||||
renderListAt :: Point2 -> [(String,Color)] -> World -> [Picture]
|
||||
renderListAt (tx,ty) scols w =
|
||||
map (winScale w) $ zipWith
|
||||
(translate (tx + 15-halfWidth w))
|
||||
( map (\x -> ty + halfHeight w - (20 * (fromIntegral x+1))) ([0..]::[Int]) )
|
||||
( map (\(s,col) -> scale 0.1 0.1 . dShadCol col $ text s) scols )
|
||||
where
|
||||
scaler = scale (2 / getWindowX w) (2 / getWindowY w)
|
||||
|
||||
displayInv :: Int -> World -> [Picture]
|
||||
displayInv n w = displayListTopLeft scols w
|
||||
@@ -60,13 +105,15 @@ drawLocations wrld = displayListTopLeft locs wrld
|
||||
iPos = _selLocation wrld
|
||||
locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ wrld
|
||||
locPoss = map (cartePosToScreen wrld . ($ wrld) . fst) . IM.elems . _seenLocations $ wrld
|
||||
--cZoom = _carteZoom w
|
||||
locTexts = map fst locs
|
||||
bFunc (x,y) (z,w) = pictures
|
||||
[ bezierQuad (withAlpha 0.0 white) (withAlpha 0.2 white) 0.050 0.010 (x,y) (0,y) (z,w)
|
||||
, bezierQuad (withAlpha 0.0 white) (withAlpha 0.5 white) 0.045 0.005 (x,y) (0,y) (z,w)
|
||||
, bezierQuad (withAlpha 0.0 white) (withAlpha 0.5 white) 0.035 0.002 (x,y) (0,y) (z,w)
|
||||
[ bline 0.2 0.050 0.010
|
||||
, bline 0.5 0.045 0.005
|
||||
, bline 0.5 0.035 0.002
|
||||
] --cheapo antialiasing
|
||||
where
|
||||
bline alph lwidth rwidth
|
||||
= bezierQuad (withAlpha 0.0 white) (withAlpha alph white) lwidth rwidth (x,y) (0,y) (z,w)
|
||||
|
||||
displayListCoords :: World -> [Point2]
|
||||
displayListCoords w = map (g . f) [(1::Int)..]
|
||||
@@ -96,24 +143,22 @@ mapWall w wl =
|
||||
else Nothing
|
||||
where
|
||||
t = normalizeV (y -.- x)
|
||||
-- n2 = 2 *.* vNormal t
|
||||
n2 = 20 *.* vNormal t
|
||||
(x,y) = _wlLine wl
|
||||
c = _wlColor wl
|
||||
|
||||
{- | Pictures of popup text for items close to your position.-}
|
||||
closeObjectTexts :: World -> Picture
|
||||
closeObjectTexts w = pictures $ zipWith renderList [(0::Int)..] (map colAndText $ _closeActiveObjects w)
|
||||
++ maybeToList maybeLine
|
||||
++ maybeToList maybeLine
|
||||
where
|
||||
colAndText (Left x) = (_itInvColor $ _flIt x, _itName $ _flIt x)
|
||||
colAndText (Right x) = (white, _btText x)
|
||||
renderList i (c,t) = scale (2/getWindowX w) (2/getWindowY w)
|
||||
. tran
|
||||
. translate (xtran i) (negate (20 * fromIntegral i))
|
||||
. scale 0.1 0.1
|
||||
. color c
|
||||
$ text t
|
||||
renderList i (c,t) = winScale w
|
||||
. tran
|
||||
. translate (xtran i) (negate (20 * fromIntegral i))
|
||||
. scale 0.1 0.1
|
||||
. color c
|
||||
$ text t
|
||||
tran = translate (pushout - halfWidth w) (halfHeight w - 20* (fromIntegral invPos +1))
|
||||
youSel = _crInvSel $ you w
|
||||
freeSlot = mayIt >>= \it -> checkInvSlotsYou (_flIt it) w
|
||||
@@ -147,22 +192,49 @@ closeObjectTexts w = pictures $ zipWith renderList [(0::Int)..] (map colAndText
|
||||
,(sc p' , col)
|
||||
,(sc p , col)
|
||||
]
|
||||
|
||||
{- | Add coloured drop shadow. -}
|
||||
{- | Colour picture and add black drop shadow. -}
|
||||
dShadCol :: Color -> Picture -> Picture
|
||||
dShadCol c p = pictures
|
||||
[ color black $ uncurry translate (1.2,-1.2) p
|
||||
, color c p
|
||||
]
|
||||
[ color black $ uncurry translate (1.2,-1.2) p
|
||||
, color c p
|
||||
]
|
||||
|
||||
drawListCursor :: Color -> Int -> World -> Picture
|
||||
drawListCursor c iPos w = scale (2 / getWindowX w) (2 / getWindowY w)
|
||||
. translate (105-halfWidth w) (halfHeight w - (20* fromIntegral iPos) - 20)
|
||||
$ lineCol [(( 100,12.5) ,withAlpha 0 c)
|
||||
,((-100,12.5) ,c)
|
||||
,((-100,-7.5) ,c)
|
||||
,(( 100,-7.5) ,withAlpha 0 c)
|
||||
]
|
||||
drawListCursor c = openCursorAt 120 c 5
|
||||
|
||||
openCursorAt
|
||||
:: Float -- ^ Width
|
||||
-> Color
|
||||
-> Float -- ^ x offset
|
||||
-> Int -- ^ y offset (discrete)
|
||||
-> World
|
||||
-> Picture
|
||||
openCursorAt wth col xoff yint w = winScale w
|
||||
. translate (xoff-halfWidth w) (halfHeight w - (20* fromIntegral yint) - 20)
|
||||
$ lineCol
|
||||
[(( wth,12.5) ,withAlpha 0 col)
|
||||
,(( 0,12.5) ,col)
|
||||
,(( 0,-7.5) ,col)
|
||||
,(( wth,-7.5) ,withAlpha 0 col)
|
||||
]
|
||||
cursorAt
|
||||
:: Float -- ^ Width
|
||||
-> Color
|
||||
-> Float -- ^ x offset
|
||||
-> Int -- ^ y offset (discrete)
|
||||
-> World
|
||||
-> Picture
|
||||
cursorAt wth col xoff yint w = winScale w
|
||||
. translate (xoff-halfWidth w) (halfHeight w - (20* fromIntegral yint) - 20)
|
||||
. color col
|
||||
$ line
|
||||
[( wth,12.5)
|
||||
,( 0,12.5)
|
||||
,( 0,-7.5)
|
||||
,( wth,-7.5)
|
||||
,( wth,12.5)
|
||||
]
|
||||
|
||||
|
||||
displayHP :: Int -> World -> Picture
|
||||
displayHP n w = translate (halfWidth w-80) (halfHeight w-20) $
|
||||
|
||||
Reference in New Issue
Block a user