This commit is contained in:
2022-12-27 14:14:03 +00:00
parent 2def9800fa
commit 85738adff1
6 changed files with 169 additions and 160 deletions
+1 -2
View File
@@ -20,9 +20,8 @@ data HUDElement
data SubInventory
= NoSubInventory
| TweakInventory {_tweakInvSel :: Maybe Int}
| ExamineInventory {_examineInvSel :: Maybe Int}
| CombineInventory {_combineInvSel :: Maybe Int}
| InspectInventory
| LockedInventory
| DisplayTerminal {_termID :: Int}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
+1 -1
View File
@@ -32,7 +32,7 @@ applyTerminalCommand s = case s of
(uvWorld . cWorld . lWorld %~ initSpecificCrItemLocations 0)
. (uvWorld . cWorld . lWorld . creatures . ix 0 . crInv .~ IM.fromList (zip [0 ..] $ inventoryX x))
. (uvWorld . cWorld . lWorld . creatures . ix 0 . crInvCapacity .~ 50)
['I','S',x,y] -> (uvWorld . cWorld . lWorld . creatures . ix 0 . crInvCapacity .~ read [x,y])
['I','S',x,y] -> uvWorld . cWorld . lWorld . creatures . ix 0 . crInvCapacity .~ read [x,y]
"GODON" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crMaterial .~ Crystal
"GODOFF" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crMaterial .~ Flesh
_ -> id
+161 -145
View File
@@ -3,9 +3,6 @@ module Dodge.Render.HUD (
drawHUD,
) where
import Dodge.Inventory.SelectionList
import Dodge.Data.CardinalPoint
import Dodge.Data.SelectionList
import Control.Lens
import qualified Data.Map.Strict as M
import Data.Maybe
@@ -14,11 +11,15 @@ import qualified Data.Vector as V
import Dodge.Base
import Dodge.Clock
import Dodge.Combine
import Dodge.Data.World
import Dodge.Data.CardinalPoint
import Dodge.Data.Config
import Dodge.Data.SelectionList
import Dodge.Data.World
import Dodge.Inventory
import Dodge.Inventory.ItemSpace
import Dodge.Inventory.SelectionList
import Dodge.Item.Display
import Dodge.Item.Info
import Dodge.Render.Connectors
import Dodge.Render.List
import Dodge.Tweak.Show
@@ -47,41 +48,37 @@ drawInGameHUD sl cfig w =
]
defaultListDisplayParams :: ListDisplayParams
defaultListDisplayParams = ListDisplayParams
{ _ldpVerticalGap = 10
, _ldpScale = 1
, _ldpPosX = 0
, _ldpPosY = 0
, _ldpCursorType = NoCursor
, _ldpWidth = FixedSelectionWidth 15
}
subInvListDisplayParams :: ListDisplayParams
subInvListDisplayParams = ListDisplayParams
{ _ldpVerticalGap = 10
, _ldpScale = 1
, _ldpPosX = subInvX
, _ldpPosY = 60
, _ldpCursorType = NoCursor
, _ldpWidth = FixedSelectionWidth 15
}
defaultListDisplayParams =
ListDisplayParams
{ _ldpVerticalGap = 10
, _ldpScale = 1
, _ldpPosX = 0
, _ldpPosY = 0
, _ldpCursorType = NoCursor
, _ldpWidth = FixedSelectionWidth 15
}
defaultSubInvSelectionList :: SelectionList a
defaultSubInvSelectionList = SelectionList
{ _slItems = []
, _slSelPos = Nothing
, _slLength = 0
}
defaultSubInvSelectionList =
SelectionList
{ _slItems = []
, _slSelPos = Nothing
, _slLength = 15
}
invDisplayParams :: World -> ListDisplayParams
invDisplayParams w = defaultListDisplayParams
& ldpWidth .~ FixedSelectionWidth topInvW
& ldpCursorType .~ BorderCursor selcursortype
& ldpWidth .~ FixedSelectionWidth (determineInvSelCursorWidth w)
invDisplayParams w =
defaultListDisplayParams
& ldpWidth .~ FixedSelectionWidth topInvW
& ldpCursorType .~ BorderCursor selcursortype
& ldpWidth .~ FixedSelectionWidth (determineInvSelCursorWidth w)
where
selcursortype
| ButtonRight `M.member` _mouseButtons (_input w) = [North,South,East,West]
| otherwise = [North,South,West]
| isexaminesub || ButtonRight `M.member` _mouseButtons (_input w) = [North, South, East, West]
| otherwise = [North, South, West]
isexaminesub = case w ^? cWorld . lWorld . hud . hudElement . subInventory of
Just ExamineInventory{} -> True
_ -> False
inventoryDisplay :: World -> Configuration -> SelectionList () -> Picture
inventoryDisplay w = drawSelectionList (invDisplayParams w)
@@ -89,78 +86,116 @@ inventoryDisplay w = drawSelectionList (invDisplayParams w)
drawSubInventory :: SubInventory -> Configuration -> World -> Picture
drawSubInventory subinv cfig w = case subinv of
LockedInventory -> mempty -- topInvCursor col cursPos cfig w
NoSubInventory ->
pictures
[ closeobjectcursor
, equipcursors
, equipcursor -- the order is important, this should go on top of the other equipcursors
, rboptions
]
TweakInventory mtweaki ->
titledSub "TWEAK" (defaultSubInvSelectionList & slItems .~ ammoTweakSelectionItems it)
[ selcursor' listCursorNESW
, fromMaybe mempty $ do
tweaki <- mtweaki
-- consider moving this functionality out into a tweaks module
tparam <- it ^? _Just . itTweaks . tweakParams . ix tweaki
return $
lnkMidInvSel cfig w curpos tweaki
<> listCursorNSW subInvX 60 cfig tweaki white (length $ showTweak tparam) 1
]
NoSubInventory -> drawNoSubInventory cfig w
ExamineInventory mtweaki ->
titledSub
"TWEAK"
(defaultSubInvSelectionList & slItems .~ ammoTweakSelectionItems itm)
<> examineInventoryExtra mtweaki itm cfig
DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld)
CombineInventory mi ->
titledSub "COMBINE" (combineListSelection w)
[ fromMaybe mempty $ do
i <- mi
cpos <- combinePoss w !? i
col <- (combineItemListYou w !? i) <&> _itInvColor . snd
return $
pictures
[ fromMaybe mempty $ do
strs <- fmap (fst . snd) (combineListInfo w !? i)
return $ listPicturesAtOff (subInvX + 150) 60 cfig cpos $ map (color red . text) strs
, fromMaybe mempty $ do
csize <- combineSizes w !? i
return $ listCursorNSW subInvX 60 cfig cpos col 15 csize
, fromMaybe mempty $ do
lnks <- map fst (combineItemListYou w) !? i
return $
lnkMidPosInvSelsCol cfig w cpos col lnks
<> foldMap (topCursorTypeWidth listCursorNESW (topInvW + 2) cfig w) lnks
<> combineCounts cfig w lnks
]
]
InspectInventory ->
titledSub "INSPECT" (defaultSubInvSelectionList & slItems .~ textSelItems (itmInfo it))
[ selcursor' listCursorNESW
]
titledSub
"COMBINE"
(combineListSelection w mi)
<> combineInventoryExtra mi cfig w
where
titledSub subtitle subitems =
invHead cfig subtitle
<> drawSelectionList secondColumnParams cfig subitems
itm = yourItem w
drawNoSubInventory :: Configuration -> World -> Picture
drawNoSubInventory cfig w =
pictures
[ closeobjectcursor
, equipcursors
, equipcursor -- the order is important, this should go on top of the other equipcursors
, rboptions
]
where
titledSub subtitle subitems extrapics = pictures $ [invHead cfig subtitle
,drawSelectionList subInvListDisplayParams cfig subitems] <>
extrapics
closeobjectcursor = case selectedCloseObject w of
Nothing -> mempty
Just (i,_) -> drawCursorAt (invDisplayParams w & ldpCursorType .~ BorderCursor [North,South]) cfig (Just i) (inventorySelectionList w)
itcol = fromMaybe (greyN 0.5) (it ^? _Just . itInvColor)
cr = you w
it = yourItem w
selcursor' ct = fromMaybe mempty $ ct 0 0 cfig curpos itcol (determineInvSelCursorWidth w) cury <$ it
curpos = invSelPos w
cury = fromMaybe 1 $ augmentedInvSizes w IM.!? crSel (you w)
Just (i, _) ->
drawCursorAt
(invDisplayParams w & ldpCursorType .~ BorderCursor [North, South])
cfig
(Just i)
(inventorySelectionList w)
equipcursor = case _crLeftInvSel cr of
Just invid -> f cyan invid (_crInvEquipped cr IM.! invid)
_ -> mempty
equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr)
cr = you w
rboptions
| ButtonRight `M.member` _mouseButtons (_input w) = drawRBOptions cfig w (_rbOptions w)
| otherwise = mempty
f col invid epos = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos
rboptions =
if ButtonRight `M.member` _mouseButtons (_input w)
then drawRBOptions cfig w (_rbOptions w)
else mempty
examineInventoryExtra :: Maybe Int -> Maybe Item -> Configuration -> Picture
examineInventoryExtra mtweaki mitm cfig =
pictures
[ fromMaybe mempty $ do
tweaki <- mtweaki
-- consider moving this functionality out into a tweaks module
tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki
return $ listCursorNSW subInvX 60 cfig tweaki white (length $ showTweak tparam) 15
, drawSelectionList thirdColumnParams cfig (thirdColumnPara (itmInfo mitm))
]
combineInventoryExtra :: Maybe Int -> Configuration -> World -> Picture
combineInventoryExtra mi cfig w =
pictures
[ fromMaybe mempty $ do
i <- mi
cpos <- combinePoss w !? i
col <- (combineItemListYou w !? i) <&> _itInvColor . snd
return $
pictures
[ fromMaybe mempty $ do
strs <- fmap (fst . snd) (combineListInfo w !? i)
return $ listPicturesAtOff (subInvX + 150) 60 cfig cpos $ map (color red . text) strs
, fromMaybe mempty $ do
lnks <- map fst (combineItemListYou w) !? i
return $
lnkMidPosInvSelsCol cfig w cpos col lnks
<> foldMap (topCursorTypeWidth listCursorNESW (topInvW + 2) cfig w) lnks
<> combineCounts cfig w lnks
]
]
secondColumnParams :: ListDisplayParams
secondColumnParams =
defaultListDisplayParams
& ldpPosX .~ subInvX
& ldpPosY .~ 60
& ldpCursorType .~ BorderCursor [North, South, West]
thirdColumnParams :: ListDisplayParams
thirdColumnParams =
defaultListDisplayParams
& ldpPosX .~ 9 * fromIntegral topInvW + 275
& ldpPosY .~ 60
thirdColumnPara :: [String] -> SelectionList ()
thirdColumnPara strs = SelectionList (map f strs) Nothing (length strs)
where
f str =
SelectionItem
{ _siPictures = [text str]
, _siHeight = 1
, _siIsSelectable = True
, _siWidth = length str
, _siColor = white
, _siOffX = 0
, _siPayload = ()
}
itmInfo :: Maybe Item -> [String]
itmInfo mit = fromMaybe [] $ do
itm <- mit
return (map show . M.assocs . _iyModules $ _itType itm)
return $
itmBaseInfo (itm ^. itType . iyBase) :
(map show . M.assocs . _iyModules $ _itType itm)
displayTerminal :: Int -> Configuration -> LWorld -> Picture
displayTerminal tid cfig w = fromMaybe mempty $ do
@@ -168,13 +203,16 @@ displayTerminal tid cfig w = fromMaybe mempty $ do
return $
pictures
[ invHead cfig (_tmTitle tm ++ ":T" ++ show tid)
, renderListAt subInvX 60 cfig
. displayTermInput tm
. reverse
. take (_tmMaxLines tm)
$ _tmDisplayedLines tm
, drawSelectionList secondColumnParams cfig (thesellist tm)
]
where
toselitm (str, col) = SelectionItem [color col $ text str] 1 True (length str) col 0 ()
thesellist tm = SelectionList (thelist tm) Nothing (length (thelist tm))
thelist tm =
map toselitm . displayTermInput tm
. reverse
. take (_tmMaxLines tm)
$ _tmDisplayedLines tm
displayTermInput tm = case _tmInput tm of
TerminalInput s hasfoc _ -> (++ [(displayInputText tm s ++ displayBlinkCursor hasfoc, white)])
displayInputText tm s
@@ -225,28 +263,6 @@ topInvW = 15
subInvX :: Float
subInvX = 9 * fromIntegral topInvW + 50
lnkMidInvSel :: Configuration -> World -> Int -> Int -> Picture
lnkMidInvSel cfig w lefti midi =
winScale cfig
. color white
. zConnect rp
$ selNumMidHeight cfig w lefti
where
-- lp ipos = V2 (150 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
rp = V2 (190 - hw) (hh - (20 * fromIntegral midi + 77.5))
hh = halfHeight cfig
hw = halfWidth cfig
--lnkMidPosInvSels :: Configuration -> World -> Int -> [Int] -> Picture
--lnkMidPosInvSels cfig w i = winScale cfig
-- . color white
-- . concatMap (zConnect rp . selNumMidHeight cfig w)
-- where
---- lp ipos = V2 (150 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
-- rp = V2 (190 - hw) ( hh - (20 * fromIntegral i + 77.5))
-- hh = halfHeight cfig
-- hw = halfWidth cfig
combineCounts :: Configuration -> World -> [Int] -> Picture
combineCounts cfig w = winScale cfig . foldMap f . group
where
@@ -260,7 +276,6 @@ lnkMidPosInvSelsCol cfig w i col =
winScale cfig
. foldMap (\j -> zConnectCol rp (V2 18 0 + selNumMidHeight cfig w j) col white white (selNumCol j w))
where
-- lp ipos = V2 (150 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
rp = V2 (190 - hw) (hh - (20 * fromIntegral i + 77.5))
hh = halfHeight cfig
hw = halfWidth cfig
@@ -278,13 +293,15 @@ topCursorTypeWidth ctype width cfig w i =
determineInvSelCursorWidth :: World -> Int
determineInvSelCursorWidth w = case _rbOptions w of
NoRightButtonOptions -> topInvW
EquipOptions{} ->
if ButtonRight `M.member` _mouseButtons (_input w)
then 47
else topInvW
EquipOptions{}
| ButtonRight `M.member` _mouseButtons (_input w) -> 47
| otherwise -> topInvW
combineListSelection :: World -> SelectionList ()
combineListSelection w = defaultSubInvSelectionList & slItems .~ combineListSelectionItems w
combineListSelection :: World -> Maybe Int -> SelectionList ()
combineListSelection w mi =
defaultSubInvSelectionList
& slItems .~ combineListSelectionItems w
& slSelPos .~ mi
combineListSelectionItems :: World -> [SelectionItem ()]
combineListSelectionItems w = case combineListSelectionItems' w of
@@ -292,10 +309,9 @@ combineListSelectionItems w = case combineListSelectionItems' w of
xs -> xs
where
thetext = "NO POSSIBLE COMBINATIONS"
combineListSelectionItems' :: World -> [SelectionItem ()]
combineListSelectionItems' w = map (picsToSelectable 15 . itemText . snd) $ combineItemListYou w
combineListSelectionItems' = map (picsToSelectable 15 . itemText . snd) . combineItemListYou
ammoTweakSelectionItems :: Maybe Item -> [SelectionItem ()]
ammoTweakSelectionItems = textSelItems . ammoTweakStrings
@@ -309,12 +325,12 @@ tweakString :: TweakParam -> String
tweakString tp = rightPad 12 ' ' (show $ _tweakType tp) ++ " " ++ showTweak tp
invHead :: Configuration -> String -> Picture
invHead cfig s =
invHead cfig =
winScale cfig
. translate (- halfWidth cfig + subInvX + 20) (halfHeight cfig - 40)
. dShadCol white
. scale 0.4 0.4
$ text s
. text
drawCarte :: Configuration -> World -> Picture
drawCarte cfig w =
@@ -343,10 +359,9 @@ mapOverlay cfig w =
(mapMaybe (mapWall cfig (w ^. cWorld . lWorld . hud)) . IM.elems $ w ^. cWorld . lWorld . walls)
mapWall :: Configuration -> HUD -> Wall -> Maybe Picture
mapWall cfig thehud wl =
if _wlSeen wl
then Just . color c . polygon $ map (cartePosToScreen cfig thehud) [x, x +.+ n2, y +.+ n2, y]
else Nothing
mapWall cfig thehud wl
| _wlSeen wl = Just . color c . polygon $ map (cartePosToScreen cfig thehud) [x, x +.+ n2, y +.+ n2, y]
| otherwise = Nothing
where
t = normalizeV (y -.- x)
n2 = 20 *.* vNormal t
@@ -389,18 +404,19 @@ mainListCursor :: Color -> Int -> Configuration -> Picture
mainListCursor c = openCursorAt 120 c 5 0
picsToSelectable :: Int -> [Picture] -> SelectionItem ()
picsToSelectable wdth pics = SelectionItem
{ _siPictures = pics
, _siHeight = length pics
, _siIsSelectable = True
, _siWidth = wdth
, _siColor = white
, _siOffX = 0
, _siPayload = ()
}
picsToSelectable wdth pics =
SelectionItem
{ _siPictures = pics
, _siHeight = length pics
, _siIsSelectable = True
, _siWidth = wdth
, _siColor = white
, _siOffX = 0
, _siPayload = ()
}
textSelItems :: [String] -> [SelectionItem ()]
textSelItems = map (picsToSelectable 15 . (:[]) . text)
textSelItems = map (picsToSelectable 15 . (: []) . text)
itemText :: Item -> [Picture]
{-# INLINE itemText #-}
@@ -435,10 +451,10 @@ openCursorAt wth col xoff yoff yint w =
]
displayHP :: Int -> Configuration -> World -> Picture
displayHP cid cfig w =
displayHP cid cfig =
translate (halfWidth cfig -80) (halfHeight cfig -20)
. scale 0.2 0.2
. text
. leftPad 5 ' '
. show
$ w ^?! cWorld . lWorld . creatures . ix cid . crHP
. (^?! cWorld . lWorld . creatures . ix cid . crHP)
+2 -2
View File
@@ -1,6 +1,6 @@
module Dodge.Render.List where
import Data.Foldable
--import Data.Foldable
import Data.Maybe
import Dodge.Base.WinScale
import Dodge.Base.Window
@@ -102,7 +102,7 @@ listCursorChooseBorder = listCursorChooseBorderScale 10 1
-- note we cannot simply scale lines because they are drawn as solid rectangles
chooseCursorBorders :: Float -> Float -> [CardinalPoint] -> Picture
chooseCursorBorders wth hgt = fold . map (line . toLine)
chooseCursorBorders wth hgt = foldMap (line . toLine)
where
top = 0
bot = - hgt
+2 -8
View File
@@ -79,7 +79,6 @@ updateKeyInGame uv sc InitialPress = case sc of
ScancodeT -> over uvWorld testEvent uv
ScancodeX -> uv & uvWorld %~ toggleTweakInv
ScancodeC -> over uvWorld toggleCombineInv uv
ScancodeI -> uv & uvWorld . cWorld . lWorld . hud . hudElement %~ toggleInspectInv
_ -> uv
where
w = _uvWorld uv
@@ -108,13 +107,8 @@ toggleMap w = case w ^?! cWorld . lWorld . hud . hudElement of
toggleTweakInv :: World -> World
toggleTweakInv w = case w ^. cWorld . lWorld . hud . hudElement of
DisplayInventory TweakInventory{} -> w & thepointer .~ NoSubInventory
_ -> w & thepointer .~ TweakInventory mi
DisplayInventory ExamineInventory{} -> w & thepointer .~ NoSubInventory
_ -> w & thepointer .~ ExamineInventory mi
where
thepointer = cWorld . lWorld . hud . hudElement . subInventory
mi = 0 <$ (yourItem w >>= (^? itTweaks . tweakParams . ix 0))
toggleInspectInv :: HUDElement -> HUDElement
toggleInspectInv he = case he of
DisplayInventory InspectInventory -> DisplayInventory NoSubInventory
_ -> DisplayInventory InspectInventory
+2 -2
View File
@@ -32,7 +32,7 @@ updateWheelEvent yi w = case w ^. cWorld . lWorld . hud . hudElement of
| lbDown -> w & cWorld . camPos . camZoom +~ y
| invKeyDown -> changeSwapInvSel yi w
| otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w
DisplayInventory (TweakInventory mi)
DisplayInventory (ExamineInventory mi)
| invKeyDown && rbDown -> w & moveTweakSel yi
| invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvSel yi w
| rbDown -> w & changeTweakParam mi yi
@@ -87,7 +87,7 @@ scrollRBOption y w
moveTweakSel :: Int -> World -> World
moveTweakSel i w = case yourItem w ^? _Just . itTweaks . tweakParams of
Just l -> w & cWorld . lWorld . hud . hudElement . subInventory . tweakInvSel . _Just %~ (`mod` length l) . subtract i
Just l -> w & cWorld . lWorld . hud . hudElement . subInventory . examineInvSel . _Just %~ (`mod` length l) . subtract i
_ -> w
changeTweakParam :: Maybe Int -> Int -> World -> World