diff --git a/src/Dodge/Combine.hs b/src/Dodge/Combine.hs index 78c34d24a..5d5f6cb96 100644 --- a/src/Dodge/Combine.hs +++ b/src/Dodge/Combine.hs @@ -87,11 +87,11 @@ fullModuleName = fromMaybe "EMPTYMODULE" . moduleName toggleCombineInv :: World -> World toggleCombineInv w = case w ^. cWorld . lWorld . hud . hudElement of - DisplayInventory CombineInventory{} -> w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory + DisplayInventory CombineInventory{} -> w & cWorld . lWorld . hud . hudElement . subInventory .~ NoSubInventory _ -> w & enterCombineInv enterCombineInv :: World -> World -enterCombineInv w = w & cWorld . lWorld . hud . hudElement .~ DisplayInventory (CombineInventory mi) +enterCombineInv w = w & cWorld . lWorld . hud . hudElement . subInventory .~ CombineInventory mi where mi = 0 <$ listToMaybe (combineItemListYou w) diff --git a/src/Dodge/Data/HUD.hs b/src/Dodge/Data/HUD.hs index 853973e3b..c2af2bec2 100644 --- a/src/Dodge/Data/HUD.hs +++ b/src/Dodge/Data/HUD.hs @@ -13,7 +13,8 @@ import Geometry.Data data HUDElement = DisplayInventory - { _subInventory :: SubInventory} + { _subInventory :: SubInventory + } | DisplayCarte deriving (Eq, Ord, Show, Read) --Generic, Flat) diff --git a/src/Dodge/Data/SelectionList.hs b/src/Dodge/Data/SelectionList.hs index bf05771ea..919493261 100644 --- a/src/Dodge/Data/SelectionList.hs +++ b/src/Dodge/Data/SelectionList.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveAnyClass #-} +--{-# LANGUAGE DeriveGeneric #-} +--{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Data.SelectionList where @@ -8,8 +8,8 @@ import Picture.Data import Control.Lens import Data.Set (Set) import Dodge.Data.CardinalPoint -import Data.Aeson -import Data.Aeson.TH +--import Data.Aeson +--import Data.Aeson.TH data ListDisplayParams = ListDisplayParams { _ldpPosX :: Float @@ -26,6 +26,7 @@ data SelectionList a = SelectionList , _slSelPos :: Maybe Int , _slLength :: Int } + --deriving (Eq, Ord, Show, Read) --Generic, Flat) data SelectionWidth = FixedSelectionWidth Int | VariableSelectionWidth (Int -> Int) @@ -43,8 +44,10 @@ data SelectionItem a = SelectionItem , _siOffX :: Int , _siPayload :: a } + --deriving (Eq, Ord, Show, Read) --Generic, Flat) makeLenses ''ListDisplayParams makeLenses ''SelectionList makeLenses ''SelectionItem -deriveJSON defaultOptions ''SelectionItem +--deriveJSON defaultOptions ''SelectionItem +--deriveJSON defaultOptions ''SelectionList diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index eba526083..9be2bd28b 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -1,5 +1,6 @@ module Dodge.Default.World where +--import Dodge.Data.SelectionList import Data.Graph.Inductive.Graph hiding ((&)) import qualified Data.Map as M import qualified Data.Set as S diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 64604ff98..516317fdc 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -121,11 +121,7 @@ closeObjectCol e = case e of Right _ -> yellow selNumPos :: Int -> World -> Int -selNumPos i w = splitgap + (foldl' (+) 0 . fst $ IM.split i (augmentedInvSizes w)) - where - splitgap = 0 --- | i < length (yourInv w) = 0 --- | otherwise = 1 +selNumPos i w = sum . fst $ IM.split i (augmentedInvSizes w) selNumTextPos :: Configuration -> World -> Int -> Point2 selNumTextPos cfig w i = V2 (150 - hw) (hh - (20 * fromIntegral ipos + 20)) @@ -162,7 +158,7 @@ updateTerminal = checkTermDist checkTermDist :: World -> World checkTermDist w = case w ^? cWorld . lWorld . hud . hudElement . subInventory . termID of - Just tmid -> fromMaybe (w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory) $ do + Just tmid -> fromMaybe (w & cWorld . lWorld . hud . hudElement . subInventory .~ NoSubInventory) $ do btid <- w ^? cWorld . lWorld . terminals . ix tmid . tmButtonID btpos <- w ^? cWorld . lWorld . buttons . ix btid . btPos if dist btpos (_crPos $ you w) < 40 then Just w else Nothing @@ -395,4 +391,4 @@ selectedCloseObject w inv = _crInv cr selectNthCloseObject :: World -> Int -> Maybe (Int, Either FloorItem Button) -selectNthCloseObject w n = (length (yourInv w) + n,) <$> (_closeObjects (_lWorld (_cWorld w)) !? n) +selectNthCloseObject w n = (length (yourInv w) + n + 1,) <$> (_closeObjects (_lWorld (_cWorld w)) !? n) diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 1706ca2f7..a4d9f1e1b 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -3,6 +3,7 @@ module Dodge.Render.HUD ( drawHUD, ) where +import Dodge.Inventory.SelectionList import Dodge.Data.CardinalPoint import Dodge.Data.SelectionList import Control.Lens @@ -33,17 +34,18 @@ drawHUD :: Universe -> Picture drawHUD uv = case w ^. cWorld . lWorld . hud . hudElement of DisplayCarte -> drawCarte cfig w DisplayInventory subinv -> - drawInGameHUD subinv uv + drawInGameHUD sl uv <> drawSubInventory subinv cfig w where + sl = makeInventorySelectionList w w = _uvWorld uv cfig = _uvConfig uv -drawInGameHUD :: SubInventory -> Universe -> Picture -drawInGameHUD subinv uv = +drawInGameHUD :: SelectionList () -> Universe -> Picture +drawInGameHUD sl uv = pictures [ winScale cfig . dShadCol white $ displayHP 0 cfig w - , inventoryDisplay subinv cfig w + , inventoryDisplay sl cfig w ] where w = _uvWorld uv @@ -59,13 +61,6 @@ defaultListDisplayParams = ListDisplayParams , _ldpWidth = FixedSelectionWidth 15 } -defaultSelectionList :: SelectionList a -defaultSelectionList = SelectionList - {_slItems = [] - , _slSelPos = Nothing - , _slLength = 0 - } - subInvListDisplayParams :: ListDisplayParams subInvListDisplayParams = ListDisplayParams { _ldpVerticalGap = 10 @@ -83,25 +78,6 @@ subInvSelectionList = SelectionList , _slLength = 0 } -inventorySelectionList :: World -> [SelectionItem ()] -inventorySelectionList w = map (invSelectionItem cr) (IM.toList inv) - ++ [SelectionItem displayFreeSlots 1 True (length thetext) invDimColor 2 ()] - ++ map (closeObjectToSelectionItem nfreeslots) (w ^. cWorld . lWorld . closeObjects) - where - cr = you w - inv = _crInv cr - nfreeslots = crNumFreeSlots cr - thetext = case nfreeslots of - 0 -> " INVENTORY FULL" - 1 -> " +1 FREE SLOT" - x -> " +" ++ show x ++ " FREE SLOTS" - displayFreeSlots = [color invDimColor $ text thetext] - -inventoryCursorPos :: SubInventory -> World -> Maybe Int -inventoryCursorPos subinv w = case subinv of - CombineInventory {} -> Nothing - _ -> Just $ yourInvSel w - invDisplayParams :: World -> ListDisplayParams invDisplayParams w = defaultListDisplayParams & ldpWidth .~ FixedSelectionWidth topInvW @@ -112,10 +88,8 @@ invDisplayParams w = defaultListDisplayParams | ButtonRight `M.member` _mouseButtons (_input w) = [North,South,East,West] | otherwise = [North,South,West] -inventoryDisplay :: SubInventory -> Configuration -> World -> Picture -inventoryDisplay subinv cfig w = drawSelectionList (invDisplayParams w) cfig $ - defaultSelectionList & slItems .~ inventorySelectionList w - & slSelPos .~ inventoryCursorPos subinv w +inventoryDisplay :: SelectionList () -> Configuration -> World -> Picture +inventoryDisplay sl cfig w = drawSelectionList (invDisplayParams w) cfig sl drawSubInventory :: SubInventory -> Configuration -> World -> Picture drawSubInventory subinv cfig w = case subinv of @@ -171,15 +145,16 @@ drawSubInventory subinv cfig w = case subinv of extrapics closeobjectcursor = case selectedCloseObject w of Nothing -> mempty - Just (i, co) -> - listCursorNS - clObjFloatIn - 0 - cfig - (selNumPos i w) - (closeObjectCol co) - topInvW - (invSelSize i w) + Just (i,co) -> drawCursorAt (invDisplayParams w & ldpCursorType .~ BorderCursor (Set.fromList [North,South])) cfig (Just i) (inventorySelectionList w) +-- Just (i, co) -> +-- listCursorNS +-- clObjFloatIn +-- 0 +-- cfig +-- (selNumPos i w) +-- (closeObjectCol co) +-- topInvW +-- (invSelSize i w) itcol = fromMaybe (greyN 0.5) (it ^? _Just . itInvColor) cr = you w it = yourItem w @@ -356,38 +331,8 @@ invHead cfig s = $ text s -closeObjectToSelectionItem :: Int -> Either FloorItem Button -> SelectionItem () -closeObjectToSelectionItem n e = SelectionItem - { _siPictures = pics - , _siHeight = length pics - , _siIsSelectable = True - , _siWidth = 15 - , _siColor = col - , _siOffX = 2 - , _siPayload = () - } - where - (pics,col) = closeObjectToTextPictures' n e - -closeObjectToTextPictures' :: Int -> Either FloorItem Button -> ([Picture],Color) -closeObjectToTextPictures' nfreeslots e = case e of - Left flit -> let it = _flIt flit - in (map (applycolor it . textindent) $ itemDisplay it, thecol it) - Right bt -> ([color yellow $ textindent $ _btText bt], yellow) - where - textindent = text . (replicate clObjIntIn ' ' ++) - applycolor it - | nfreeslots >= itSlotsTaken it = color $ _itInvColor it - | otherwise = color invDimColor - thecol it - | nfreeslots >= itSlotsTaken it = _itInvColor it - | otherwise = invDimColor - -clObjIntIn :: Int -clObjIntIn = 2 - -clObjFloatIn :: Float -clObjFloatIn = fromIntegral clObjIntIn * 9 +--clObjFloatIn :: Float +--clObjFloatIn = fromIntegral clObjIntIn * 9 drawCarte :: Configuration -> World -> Picture drawCarte cfig w = @@ -475,23 +420,6 @@ picsToSelectable wdth pics = SelectionItem textSelItems :: [String] -> [SelectionItem ()] textSelItems = map (picsToSelectable 15 . (:[]) . text) -invSelectionItem :: Creature -> (Int,Item) -> SelectionItem () -invSelectionItem cr (i,it) = SelectionItem - { _siPictures = pics - , _siHeight = length pics - , _siIsSelectable = True - , _siWidth = 15 - , _siColor = col - , _siOffX = 0 - , _siPayload = () - } - where - col = _itInvColor it - pics = take (itSlotsTaken it) . (++ replicate 10 (color col $ text "*")) $ case _itCurseStatus it of - UndroppableIdentified -> map (color yellow . text) (itemDisplay it) - _ | crSel cr == i -> map (color col . text) (selectedItemDisplay cr it) - _ -> map (color col . text) (itemDisplay it) - itemText :: Item -> [Picture] {-# INLINE itemText #-} itemText it = f $ case _itCurseStatus it of diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index 758a610e6..b706c2f7b 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -12,7 +12,7 @@ import Dodge.Data.SelectionList import Geometry import ListHelp import Picture ---import LensHelp +import LensHelp drawSelectionList :: ListDisplayParams -> Configuration -> SelectionList a -> Picture drawSelectionList ldps cfig sl = @@ -32,9 +32,10 @@ makeSelectionListPictures sl = concatMap _siPictures $ _slItems sl -- SelectionSizeRestriction {} -> concatMap (_siPictures . fst) $ _slShownItems sl -- _ -> concatMap _siPictures $ _slItems sl -drawSelectionCursor :: ListDisplayParams -> Configuration -> SelectionList a -> Picture -drawSelectionCursor ldps cfig sl = fromMaybe mempty $ do - i <- _slSelPos sl + +drawCursorAt :: ListDisplayParams -> Configuration -> Maybe Int -> [SelectionItem a] -> Picture +drawCursorAt ldps cfig mi lis = fromMaybe mempty $ do + i <- mi selit <- lis !? i f <- case _ldpCursorType ldps of BorderCursor cps -> Just $ listCursorChooseBorderScale (_ldpVerticalGap ldps) (_ldpScale ldps) cps @@ -43,11 +44,13 @@ drawSelectionCursor ldps cfig sl = fromMaybe mempty $ do col = _siColor selit return $ f (_ldpPosX ldps + (9 * fromIntegral (_siOffX selit))) (_ldpPosY ldps) cfig j col wdth (_siHeight selit) where - lis = _slItems sl wdth = case _ldpWidth ldps of FixedSelectionWidth x -> x _ -> 1 +drawSelectionCursor :: ListDisplayParams -> Configuration -> SelectionList a -> Picture +drawSelectionCursor ldps cfig sl = drawCursorAt ldps cfig (sl ^. slSelPos) (sl ^. slItems) + -- given a list of pictures that are each the size of a "text" call, displays them as -- a list on the screen listPicturesAt :: Float -> Float -> Configuration -> [Picture] -> Picture diff --git a/src/Dodge/SelectionList.hs b/src/Dodge/SelectionList.hs index 9a4f6b1ae..c2b489b5f 100644 --- a/src/Dodge/SelectionList.hs +++ b/src/Dodge/SelectionList.hs @@ -15,3 +15,10 @@ getAvailableListLines ldps cfig = nlines dToBot = cfig ^. windowY - (ldps ^. ldpPosY + dFromScreenBot) dFromScreenBot = 5 -- fromMaybe 0 $ sl ^? slSizeRestriction . ssrType . ssrFromScreenBottom +defaultSelectionList :: SelectionList a +defaultSelectionList = SelectionList + {_slItems = [] + , _slSelPos = Nothing + , _slLength = 0 + } + diff --git a/src/Dodge/TestString.hs b/src/Dodge/TestString.hs index 9a25457a1..76c038443 100644 --- a/src/Dodge/TestString.hs +++ b/src/Dodge/TestString.hs @@ -3,13 +3,15 @@ module Dodge.TestString where import Control.Lens import Dodge.Data.Universe --import Data.Maybe -import ShortShow -import qualified Data.Map.Strict as M +--import ShortShow +--import qualified Data.Map.Strict as M +import qualified IntMapHelp as IM testStringInit :: Universe -> [String] testStringInit u = - [ show $ u ^? uvScreenLayers . _head . scOffset - ] - ++ [ shortShow $ u ^?! uvWorld . cWorld . lWorld . creatures . ix 0 . crPos - ] - ++ map show (M.toList (u ^. uvWorld . input . pressedKeys)) + [ show $ IM.keys $ u ^?! uvWorld . cWorld . lWorld . creatures . ix 0 . crInv ] +-- [ show $ u ^? uvScreenLayers . _head . scOffset +-- ] +-- ++ [ shortShow $ u ^?! uvWorld . cWorld . lWorld . creatures . ix 0 . crPos +-- ] +-- ++ map show (M.toList (u ^. uvWorld . input . pressedKeys)) diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index e3162f501..1f34fbba2 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.Inventory.SelectionList import Color import Control.Applicative import Data.List @@ -293,8 +294,13 @@ functionalUpdate w = . over uvWorld updateRBList . over uvWorld updateCloseObjects . over uvWorld updateWheelEvents + -- . over uvWorld updateInventorySelectionList $ over uvWorld updatePastWorlds w +--updateInventorySelectionList :: World -> World +--updateInventorySelectionList w = w +-- & cWorld . lWorld . hud . hudElement . augmentedInventory .~ makeInventorySelectionList w + -- this can probably be unified with updateWheelEvents menuWheelEvents :: Universe -> Universe menuWheelEvents u = foldr ($) u (replicate (abs y) (menuWheelStep (signum y))) diff --git a/src/Dodge/Update/Input.hs b/src/Dodge/Update/Input.hs index 1591150e0..963a340e7 100644 --- a/src/Dodge/Update/Input.hs +++ b/src/Dodge/Update/Input.hs @@ -4,6 +4,8 @@ module Dodge.Update.Input , doInputScreenInput ) where +--import Dodge.Inventory.SelectionList +--import Dodge.Render.HUD import Dodge.Terminal.LeftButton import Dodge.Save import Dodge.Debug.Terminal @@ -93,8 +95,8 @@ spaceAction w = case w ^?! cWorld . lWorld . hud . hudElement of Just (_, Left flit) -> pickUpItem 0 flit w Just (_, Right but) -> doButtonEvent (_btEvent but) but w _ -> w - DisplayInventory DisplayTerminal{} -> w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory - _ -> w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory + DisplayInventory DisplayTerminal{} -> w & cWorld . lWorld . hud . hudElement . subInventory .~ NoSubInventory + _ -> w & cWorld . lWorld . hud . hudElement . subInventory .~ NoSubInventory where --theLoc = doWorldPos (fst (_seenLocations (_cWorld w) IM.! _selLocation (_cWorld w))) w theLoc = doWorldPos (w ^?! cWorld . lWorld . seenLocations . ix (w ^. cWorld . lWorld . selLocation) . _1) w @@ -106,10 +108,10 @@ 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 .~ DisplayInventory NoSubInventory - _ -> w & thepointer .~ DisplayInventory (TweakInventory mi) + DisplayInventory TweakInventory{} -> w & thepointer .~ NoSubInventory + _ -> w & thepointer .~ TweakInventory mi where - thepointer = cWorld . lWorld . hud . hudElement + thepointer = cWorld . lWorld . hud . hudElement . subInventory mi = 0 <$ (yourItem w >>= (^? itTweaks . tweakParams . ix 0)) toggleInspectInv :: HUDElement -> HUDElement diff --git a/src/Dodge/Update/UsingInput.hs b/src/Dodge/Update/UsingInput.hs index 26b72a397..2ee7824f9 100644 --- a/src/Dodge/Update/UsingInput.hs +++ b/src/Dodge/Update/UsingInput.hs @@ -47,7 +47,7 @@ pressedMBEffects subinv pkeys w = case subinv of where maybeexitcombine | ButtonRight `M.member` _mouseButtons (_input w) = id - | otherwise = cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory + | otherwise = cWorld . lWorld . hud . hudElement . subInventory .~ NoSubInventory pressedMBEffectsNoInventory :: M.Map MouseButton Bool -> World -> World pressedMBEffectsNoInventory pkeys w diff --git a/src/Dodge/WorldEffect.hs b/src/Dodge/WorldEffect.hs index faba10f7d..7c92878b1 100644 --- a/src/Dodge/WorldEffect.hs +++ b/src/Dodge/WorldEffect.hs @@ -44,7 +44,7 @@ accessTerminal :: Maybe Int -> World -> World accessTerminal mtmid w = case mtmid of Nothing -> w Just tmid -> - w & cWorld . lWorld . hud . hudElement .~ DisplayInventory (DisplayTerminal tmid) + w & cWorld . lWorld . hud . hudElement . subInventory .~ DisplayTerminal tmid & cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus .~ True & cWorld . lWorld . terminals . ix tmid %~ tryToBoot where