diff --git a/src/Dodge/Data/Item/Use/Consumption/LoadAction.hs b/src/Dodge/Data/Item/Use/Consumption/LoadAction.hs index b90a6b838..3f4304c74 100644 --- a/src/Dodge/Data/Item/Use/Consumption/LoadAction.hs +++ b/src/Dodge/Data/Item/Use/Consumption/LoadAction.hs @@ -17,11 +17,17 @@ data LoadAction | LoadPrime {_actionTime :: Int, _actionSound :: SoundID} deriving (Eq, Ord, Show, Read) --Generic, Flat) -data InvSel +data InvSel -- should be ManipulatedObject? = InvSel {_iselPos :: Int, _iselAction :: InvSelAction} | Brute deriving (Eq, Ord, Show, Read) --Generic, Flat) +data SelPos + = SelItem Int + | SelNothing + | SelCloseObject Int + deriving (Eq, Ord, Show, Read) --Generic, Flat) + data InvSelAction = NoInvSelAction | ReloadAction {_actionProgress :: Int, _reloadAction :: LoadAction} diff --git a/src/Dodge/Data/SelectionList.hs b/src/Dodge/Data/SelectionList.hs index 21b45db76..ccee798d7 100644 --- a/src/Dodge/Data/SelectionList.hs +++ b/src/Dodge/Data/SelectionList.hs @@ -3,6 +3,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.SelectionList where +import Picture.Data import Color import Control.Lens import Dodge.Data.CardinalPoint @@ -35,14 +36,20 @@ data SelectionSections a = SelectionSections , _sssMaxSize :: Int } +data SSRestriction = NoSSRestriction + | SSRestriction + { _ssrSize :: Int + , _ssrOffset :: Int + } + data SelectionSection a = SelectionSection { _ssItems :: [SelectionItem a] , _ssSelPos :: Maybe Int - , _ssRegex :: String - , _ssRegexInput :: Bool , _ssMinSize :: Int + , _ssPriority :: Int , _ssOffset :: Int - , _ssShownItems :: IntMap (SelectionItem a) + , _ssRestriction :: SSRestriction + , _ssShownItems :: [Picture] } @@ -85,5 +92,8 @@ makeLenses ''ListDisplayParams makeLenses ''SelectionList makeLenses ''SelectionItem makeLenses ''SelectionIntMap +makeLenses ''SelectionSection +makeLenses ''SelectionSections +makeLenses ''SSRestriction --deriveJSON defaultOptions ''SelectionItem --deriveJSON defaultOptions ''SelectionList diff --git a/src/Dodge/DisplayInventory.hs b/src/Dodge/DisplayInventory.hs new file mode 100644 index 000000000..2d9f5e562 --- /dev/null +++ b/src/Dodge/DisplayInventory.hs @@ -0,0 +1,102 @@ +module Dodge.DisplayInventory where + +import Picture.Base +import Dodge.Render.HUD +import Dodge.SelectionList +import LensHelp +import Dodge.Inventory.CheckSlots +import Dodge.Inventory.Color +import Dodge.Base.You +import Dodge.Inventory.SelectionList +import qualified Data.IntMap.Strict as IM +import Dodge.Data.Config +import Dodge.Default.World +import Dodge.Data.SelectionList +import Dodge.Data.World + +makeDisplayInventory :: World -> Configuration -> SelectionSections () +makeDisplayInventory w cfig = defaultDisplaySections + { _sssSections = restrictsections + , _sssSelPos = Just 0 + , _sssMaxSize = availablelines + } + where + initialsections = IM.fromList + [ (0, inventorysection) + , (1, makeYouSection w) + , (2, closesection) + ] + inventorysection = makeInventorySection w + closesection = makeCloseObjectsSection w + itotallength = length . foldMap _siPictures $ _ssItems inventorysection + ctotallength = length . foldMap _siPictures $ _ssItems closesection + availablelines = getAvailableListLines (invDisplayParams w) cfig + iavailablelines = availablelines - 6 + minlengths = sum $ fmap _ssMinSize initialsections + sections | itotallength + 1 + ctotallength > availablelines = restrictsections + | otherwise = initialsections + ioffset = 1 + restrictsections = IM.fromList + [ (0, makeInventorySection w & ssShownItems %~ (take iavailablelines . drop ioffset)) + , (1, makeYouSection w) + , (2, makeCloseObjectsSection w) + ] + + +makeInventorySection :: World -> SelectionSection () +makeInventorySection w = SelectionSection + { _ssItems = map (invSelectionItem cr ) (IM.toList inv) + , _ssSelPos = Just 0 + , _ssRestriction = NoSSRestriction + , _ssPriority = 0 + , _ssOffset = 0 +-- , _ssRegex = "" +-- , _ssRegexInput = False + , _ssMinSize = 5 +-- , _ssOffset = 0 + , _ssShownItems = foldMap (f . invSelectionItem cr ) (IM.toList inv) + } + where + cr = you w + inv = _crInv cr + f si = map (color (_siColor si) . text) $ _siPictures si + +makeYouSection :: World -> SelectionSection () +makeYouSection w = SelectionSection + { _ssItems = [SelectionItem [thetext] 1 True (length thetext) invDimColor 2 ()] + , _ssSelPos = Nothing + , _ssOffset = 0 + , _ssPriority = 1 + , _ssRestriction = NoSSRestriction +-- , _ssRegex = "" +-- , _ssRegexInput = False + , _ssMinSize = 1 +-- , _ssOffset = 0 + , _ssShownItems = [color invDimColor $ text thetext] + } + where + cr = you w + nfreeslots = crNumFreeSlots cr + thetext = case nfreeslots of + 0 -> " INVENTORY FULL" + 1 -> " +1 FREE SLOT" + x -> " +" ++ show x ++ " FREE SLOTS" + +makeCloseObjectsSection :: World -> SelectionSection () +makeCloseObjectsSection w = SelectionSection + { _ssItems = map (closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects) + , _ssSelPos = Just 0 + , _ssPriority = 1 + , _ssOffset = 0 + , _ssRestriction = NoSSRestriction +-- , _ssRegex = "" +-- , _ssRegexInput = False + , _ssMinSize = 5 +-- , _ssOffset = 0 + , _ssShownItems = foldMap (f . closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects) + } + where + f si = map (color (_siColor si) . text) $ _siPictures si + cr = you w + nfreeslots = crNumFreeSlots cr + diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index b406f85ca..b04187499 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -1,6 +1,7 @@ --{-# LANGUAGE TupleSections #-} module Dodge.Render.HUD ( drawHUD, + invDisplayParams, ) where import SelectionIntMap @@ -39,17 +40,12 @@ drawHUD :: Configuration -> World -> Picture drawHUD cfig w = case w ^. hud . hudElement of DisplayCarte -> drawCarte cfig w DisplayInventory {_diSections = sections, _subInventory = subinv} -> - drawInGameHUD sl cfig w + drawHP cfig w + <> inventoryDisplay sections w cfig <> drawSubInventory subinv cfig w - where - sl = makeInventorySelectionList w -drawInGameHUD :: SelectionList () -> Configuration -> World -> Picture -drawInGameHUD sl cfig w = - pictures - [ winScale cfig . dShadCol white $ displayHP 0 cfig w - , inventoryDisplay w cfig sl - ] +drawHP :: Configuration -> World -> Picture +drawHP cfig w = winScale cfig . dShadCol white $ displayHP 0 cfig w defaultListDisplayParams :: ListDisplayParams defaultListDisplayParams = @@ -76,9 +72,22 @@ invDisplayParams w = Just ExamineInventory{} -> True _ -> False -inventoryDisplay :: World -> Configuration -> SelectionList () -> Picture -inventoryDisplay = drawSelectionList . invDisplayParams - +inventoryDisplay :: SelectionSections () -> World -> Configuration -> Picture +inventoryDisplay sss w cfig = listPicturesAtScaleOff + (_ldpVerticalGap ldps) + (_ldpScale ldps) + (_ldpPosX ldps) + (_ldpPosY ldps) + cfig + 0 -- offset + --undefined + pics + where + ldps = invDisplayParams w +-- pics' = take (_sssMaxSize sss) pics +-- totallength = length pics' + pics = foldMap (_ssShownItems) (_sssSections sss) + drawSubInventory :: SubInventory -> Configuration -> World -> Picture drawSubInventory subinv cfig w = case subinv of LockedInventory -> mempty -- topInvCursor col cursPos cfig w diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index d051ad59a..55f4413d5 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -6,6 +6,7 @@ Description : Simulation update -} module Dodge.Update (updateUniverse) where +import Dodge.DisplayInventory import Dodge.ScrollValue import Color import Control.Applicative @@ -72,6 +73,7 @@ updateUniverse u = . over (uvWorld . input . textInput) (const mempty) . updateUniverseMid . updateUseInput + . updateInventoryDisplay . over uvWorld (updateCamera cfig) . over (uvWorld . input) updateScrollTestValue . over (uvWorld . cWorld . cClock) (+ 1) @@ -79,6 +81,11 @@ updateUniverse u = where cfig = u ^. uvConfig +updateInventoryDisplay :: Universe -> Universe +updateInventoryDisplay u = u & uvWorld . hud . hudElement . diSections %~ const di + where + di = makeDisplayInventory (_uvWorld u) (_uvConfig u) + maybeOpenTerminal :: Universe -> Universe maybeOpenTerminal u = case u ^. uvWorld . input . pressedKeys . at ScancodeSemicolon of Just InitialPress -> gotoTerminal u diff --git a/src/Picture/Text.hs b/src/Picture/Text.hs new file mode 100644 index 000000000..266de3868 --- /dev/null +++ b/src/Picture/Text.hs @@ -0,0 +1,29 @@ +module Picture.Text where +import Geometry.Data +import Picture.Data +import Color +textGrad :: Color -> Color -> String -> Picture +{-# INLINE textGrad #-} +textGrad topc botc = map f . stringToListGrad topc botc + where + f (pos, col, V2 a b) = Verx pos col [a, b] BottomLayer textNum + +-- no premature optimisation, consider changing to use texture arrays +stringToListGrad :: Color -> Color -> String -> [(Point3, Point4, Point2)] +{-# INLINE stringToListGrad #-} +stringToListGrad topc botc = concatMap (uncurry (charToTupleGrad topc botc)) . zip [0, 0.9 * dimText ..] + where + dimText = 100 + +charToTupleGrad :: Color -> Color -> Float -> Char -> [(Point3, Point4, Point2)] +{-# INLINE charToTupleGrad #-} +charToTupleGrad topc botc x c = + [ (V3 (x -50) (-100) 0, botc, V2 offset 1) + , (V3 (x -50) 100 0, topc, V2 offset 0) + , (V3 (x + 50) 100 0, topc, V2 (offset + 1) 0) + , (V3 (x -50) (-100) 0, botc, V2 offset 1) + , (V3 (x + 50) (-100) 0, botc, V2 (offset + 1) 1) + , (V3 (x + 50) 100 0, topc, V2 (offset + 1) 0) + ] + where + offset = fromIntegral (fromEnum c) - 32