This commit is contained in:
2022-12-27 10:53:31 +00:00
parent eecc38d68f
commit 2def9800fa
6 changed files with 28 additions and 40 deletions
+1 -2
View File
@@ -6,7 +6,6 @@ module Dodge.Data.SelectionList where
import Color
import Picture.Data
import Control.Lens
import Data.Set (Set)
import Dodge.Data.CardinalPoint
--import Data.Aeson
--import Data.Aeson.TH
@@ -33,7 +32,7 @@ data SelectionWidth = FixedSelectionWidth Int
| UseMaxSelectionItemWidth
data CursorType = NoCursor
| BorderCursor (Set CardinalPoint)
| BorderCursor [CardinalPoint]
data SelectionItem a = SelectionItem
{ _siPictures :: [Picture]
+1 -2
View File
@@ -4,7 +4,6 @@ module Dodge.Menu.Option where
import Data.Maybe
--import Dodge.WindowLayout
import qualified Data.Set as Set
import Dodge.Data.CardinalPoint
import Dodge.Data.SelectionList
import Dodge.Data.Universe
@@ -21,7 +20,7 @@ optionListDisplayParams =
, _ldpScale = 2
, _ldpVerticalGap = 30
, _ldpWidth = FixedSelectionWidth 50
, _ldpCursorType = BorderCursor (Set.fromList [North, South, West])
, _ldpCursorType = BorderCursor [North, South, West]
}
initializeOptionMenu :: String -> [MenuOption] -> PositionedMenuOption -> Universe -> ScreenLayer
+17 -22
View File
@@ -14,7 +14,8 @@ import qualified Data.Vector as V
import Dodge.Base
import Dodge.Clock
import Dodge.Combine
import Dodge.Data.Universe
import Dodge.Data.World
import Dodge.Data.Config
import Dodge.Inventory
import Dodge.Inventory.ItemSpace
import Dodge.Item.Display
@@ -28,28 +29,22 @@ import ListHelp
import Padding
import Picture
import SDL (MouseButton (..))
import qualified Data.Set as Set
drawHUD :: Universe -> Picture
drawHUD uv = case w ^. cWorld . lWorld . hud . hudElement of
drawHUD :: Configuration -> World -> Picture
drawHUD cfig w = case w ^. cWorld . lWorld . hud . hudElement of
DisplayCarte -> drawCarte cfig w
DisplayInventory subinv ->
drawInGameHUD sl uv
drawInGameHUD sl cfig w
<> drawSubInventory subinv cfig w
where
sl = makeInventorySelectionList w
w = _uvWorld uv
cfig = _uvConfig uv
drawInGameHUD :: SelectionList () -> Universe -> Picture
drawInGameHUD sl uv =
drawInGameHUD :: SelectionList () -> Configuration -> World -> Picture
drawInGameHUD sl cfig w =
pictures
[ winScale cfig . dShadCol white $ displayHP 0 cfig w
, inventoryDisplay sl cfig w
, inventoryDisplay w cfig sl
]
where
w = _uvWorld uv
cfig = _uvConfig uv
defaultListDisplayParams :: ListDisplayParams
defaultListDisplayParams = ListDisplayParams
@@ -71,8 +66,8 @@ subInvListDisplayParams = ListDisplayParams
, _ldpWidth = FixedSelectionWidth 15
}
subInvSelectionList :: SelectionList a
subInvSelectionList = SelectionList
defaultSubInvSelectionList :: SelectionList a
defaultSubInvSelectionList = SelectionList
{ _slItems = []
, _slSelPos = Nothing
, _slLength = 0
@@ -81,15 +76,15 @@ subInvSelectionList = SelectionList
invDisplayParams :: World -> ListDisplayParams
invDisplayParams w = defaultListDisplayParams
& ldpWidth .~ FixedSelectionWidth topInvW
& ldpCursorType .~ BorderCursor (Set.fromList selcursortype)
& ldpCursorType .~ BorderCursor selcursortype
& ldpWidth .~ FixedSelectionWidth (determineInvSelCursorWidth w)
where
selcursortype
| ButtonRight `M.member` _mouseButtons (_input w) = [North,South,East,West]
| otherwise = [North,South,West]
inventoryDisplay :: SelectionList () -> Configuration -> World -> Picture
inventoryDisplay sl cfig w = drawSelectionList (invDisplayParams w) cfig sl
inventoryDisplay :: World -> Configuration -> SelectionList () -> Picture
inventoryDisplay w = drawSelectionList (invDisplayParams w)
drawSubInventory :: SubInventory -> Configuration -> World -> Picture
drawSubInventory subinv cfig w = case subinv of
@@ -102,7 +97,7 @@ drawSubInventory subinv cfig w = case subinv of
, rboptions
]
TweakInventory mtweaki ->
titledSub "TWEAK" (subInvSelectionList & slItems .~ ammoTweakSelectionItems it)
titledSub "TWEAK" (defaultSubInvSelectionList & slItems .~ ammoTweakSelectionItems it)
[ selcursor' listCursorNESW
, fromMaybe mempty $ do
tweaki <- mtweaki
@@ -136,7 +131,7 @@ drawSubInventory subinv cfig w = case subinv of
]
]
InspectInventory ->
titledSub "INSPECT" (subInvSelectionList & slItems .~ textSelItems (itmInfo it))
titledSub "INSPECT" (defaultSubInvSelectionList & slItems .~ textSelItems (itmInfo it))
[ selcursor' listCursorNESW
]
where
@@ -145,7 +140,7 @@ drawSubInventory subinv cfig w = case subinv of
extrapics
closeobjectcursor = case selectedCloseObject w of
Nothing -> mempty
Just (i,_) -> drawCursorAt (invDisplayParams w & ldpCursorType .~ BorderCursor (Set.fromList [North,South])) cfig (Just i) (inventorySelectionList w)
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
@@ -289,7 +284,7 @@ determineInvSelCursorWidth w = case _rbOptions w of
else topInvW
combineListSelection :: World -> SelectionList ()
combineListSelection w = subInvSelectionList & slItems .~ combineListSelectionItems w
combineListSelection w = defaultSubInvSelectionList & slItems .~ combineListSelectionItems w
combineListSelectionItems :: World -> [SelectionItem ()]
combineListSelectionItems w = case combineListSelectionItems' w of
+8 -10
View File
@@ -2,8 +2,6 @@ module Dodge.Render.List where
import Data.Foldable
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import Dodge.Base.WinScale
import Dodge.Base.Window
import Dodge.Data.CardinalPoint
@@ -74,7 +72,7 @@ stackPicturesAtOff tx ty cfig i = mconcat . zipWith (listTextPictureAt tx ty cfi
listCursorChooseBorderScale ::
Float ->
Float ->
Set CardinalPoint ->
[CardinalPoint] ->
Float ->
Float ->
Configuration ->
@@ -99,12 +97,12 @@ listCursorChooseBorderScale ygap s borders xoff yoff cfig yint col cursxsize cur
-- the width of a character appears to be 9(?!)
-- this is probably because it is 8 pixels plus one for the border
listCursorChooseBorder ::
Set CardinalPoint -> Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
[CardinalPoint] -> Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
listCursorChooseBorder = listCursorChooseBorderScale 10 1
-- note we cannot simply scale lines because they are drawn as solid rectangles
chooseCursorBorders :: Float -> Float -> Set CardinalPoint -> Picture
chooseCursorBorders wth hgt = fold . Set.map (line . toLine)
chooseCursorBorders :: Float -> Float -> [CardinalPoint] -> Picture
chooseCursorBorders wth hgt = fold . map (line . toLine)
where
top = 0
bot = - hgt
@@ -115,16 +113,16 @@ chooseCursorBorders wth hgt = fold . Set.map (line . toLine)
toLine West = [V2 lef bot, V2 lef top]
listCursorNS :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
listCursorNS = listCursorChooseBorder (Set.fromList [North, South])
listCursorNS = listCursorChooseBorder [North, South]
listCursorNES :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
listCursorNES = listCursorChooseBorder (Set.fromList [North, South, East])
listCursorNES = listCursorChooseBorder [North, South, East]
listCursorNESW :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
listCursorNESW = listCursorChooseBorder (Set.fromList [North, South, East, West])
listCursorNESW = listCursorChooseBorder [North, South, East, West]
listCursorNSW :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
listCursorNSW = listCursorChooseBorder (Set.fromList [North, South, West])
listCursorNSW = listCursorChooseBorder [North, South, West]
fillScreenText :: Configuration -> String -> Picture
fillScreenText cfig str =
-3
View File
@@ -3,10 +3,8 @@ module Dodge.Render.MenuScreen (
drawMenuScreen,
) where
--import LensHelp
import Dodge.Base.WinScale
import Dodge.Data.SelectionList
--import Dodge.Menu.Option
import Dodge.Render.List
import qualified Data.Text as T
import Dodge.Base.Window
@@ -73,4 +71,3 @@ drawFooterText cfig col = color col . placeString (- hw + 30) (- hh + 10) 0.1
where
hh = halfHeight cfig
hw = halfWidth cfig
+1 -1
View File
@@ -22,7 +22,7 @@ fixedCoordPictures u = drawMenuOrHUD cfig u
drawMenuOrHUD :: Configuration -> Universe -> Picture
drawMenuOrHUD cfig u = case u ^. uvScreenLayers of
[] -> drawHUD u
[] -> drawHUD (u ^. uvConfig) (u ^. uvWorld)
(lay : _) -> drawMenuScreen cfig lay
drawConcurrentMessage :: Universe -> Picture