From ff512348e031b3c0f526f6b685fc4517718b292f Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 3 May 2023 20:02:56 +0100 Subject: [PATCH] Cleanup --- src/Dodge/DisplayInventory.hs | 5 ++- src/Dodge/Inventory.hs | 57 -------------------------- src/Dodge/Inventory/CheckSlots.hs | 2 +- src/Dodge/Inventory/Color.hs | 6 --- src/Dodge/Inventory/ItemSpace.hs | 12 ------ src/Dodge/Inventory/SelectionList.hs | 61 ++++++++++++++-------------- src/Dodge/Item/Display.hs | 2 +- src/Dodge/Render/HUD.hs | 33 +++++++++++++++ src/Dodge/Render/List.hs | 2 +- src/Dodge/Update.hs | 12 +++++- 10 files changed, 81 insertions(+), 111 deletions(-) delete mode 100644 src/Dodge/Inventory/Color.hs delete mode 100644 src/Dodge/Inventory/ItemSpace.hs diff --git a/src/Dodge/DisplayInventory.hs b/src/Dodge/DisplayInventory.hs index da8eaf408..ad6cb99f7 100644 --- a/src/Dodge/DisplayInventory.hs +++ b/src/Dodge/DisplayInventory.hs @@ -20,7 +20,6 @@ import Dodge.Data.Config import Dodge.Data.SelectionList import Dodge.Data.Universe import Dodge.Inventory.CheckSlots -import Dodge.Inventory.Color import Dodge.Inventory.SelectionList import Dodge.SelectionList import LensHelp @@ -130,6 +129,10 @@ updateDisplaySections w cfig sss = return $ IM.filter (plainRegex str) itms numfiltitems = " " ++ show (length itms - length itms') ++ " FILTERED" + +invDimColor :: Color +invDimColor = greyN 0.7 + -- it is annoying that this is necessary updateInventorySectionItems :: World -> World updateInventorySectionItems w = w diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 93bc500fa..54fe72140 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -1,39 +1,29 @@ --{-# LANGUAGE TupleSections #-} module Dodge.Inventory ( - selSecSelPos, checkInvSlotsYou, rmSelectedInvItem, - selNumTextEndPos, - selSecSelCol, - selNumEndMidHeight, rmInvItem, updateCloseObjects, updateRBList, - checkTermDist, closeObjScrollDir, changeSwapSel, scrollAugInvSel, crNumFreeSlots, crInvSize, selectedCloseObject, - invDimColor, setInvPosFromSS, ) where -import Control.Monad -import Color import Control.Applicative import qualified Data.Map.Strict as M import Data.Maybe import Dodge.Base -import Dodge.Data.Config import Dodge.Data.SelectionList import Dodge.Data.World import Dodge.DisplayInventory import Dodge.Euse import Dodge.Inventory.CheckSlots import Dodge.Inventory.CloseObject -import Dodge.Inventory.Color import Dodge.ItEffect import Dodge.Reloading import Dodge.SelectionSections @@ -110,52 +100,6 @@ rmSelectedInvItem cid w = case w ^? cWorld . lWorld . creatures . ix cid . crMan Just i -> rmInvItem cid i w Nothing -> w --- there are still more ListDisplayParams to integrate here -selNumTextEndPos :: Configuration -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Maybe Point2 -selNumTextEndPos cfig ldp sss i j = do - ipos <- selSecSelPos i j sss - return $ V2 (150 - hw) (hh - ((s * 10 + ygap) * (fromIntegral ipos + 1))) - where - s = _ldpScale ldp - ygap = _ldpVerticalGap ldp - hh = halfHeight cfig - hw = halfWidth cfig - -selNumEndMidHeight :: - Configuration -> - ListDisplayParams -> - SelectionSections a -> - Int -> - Int -> - Maybe Point2 -selNumEndMidHeight cfig ldp sss i j = do - ipos <- selSecSelPos i j sss - size <- selSecSelSize i j sss - --let bump = negate $ (10 * s + ygap) * fromIntegral size - return $ V2 (150 - hw) (hh - ((10 * s + ygap) * (fromIntegral ipos + fromIntegral size * 0.5))) - where - s = _ldpScale ldp - ygap = _ldpVerticalGap ldp - hh = halfHeight cfig - hw = halfWidth cfig - -selSecSelCol :: Int -> Int -> SelectionSections a -> Maybe Color -selSecSelCol i j sss = sss ^? sssSections . ix i . ssItems . ix j . siColor - -checkTermDist :: World -> World ---checkTermDist w = case w ^? hud . hudElement . subInventory . termID of --- Just tmid -> fromMaybe (w & hud . hudElement . subInventory .~ NoSubInventory) $ do --- btid <- w ^? cWorld . lWorld . terminals . ix tmid . tmButtonID --- btpos <- w ^? cWorld . lWorld . buttons . ix btid . btPos --- guard $ dist btpos (_crPos $ you w) < 40 --- return w --- Nothing -> w -checkTermDist w = fromMaybe w $ do - tmid <- w ^? hud . hudElement . subInventory . termID - btid <- w ^? cWorld . lWorld . terminals . ix tmid . tmButtonID - btpos <- w ^? cWorld . lWorld . buttons . ix btid . btPos - guard $ dist btpos (_crPos $ you w) > 40 - return (w & hud . hudElement . subInventory .~ NoSubInventory) -- this looks ugly... updateCloseObjects :: World -> World @@ -209,7 +153,6 @@ updateRBList w mcurrentitemid = do i <- cr ^? crManipulation . manObject . inInventory . ispItem cr ^? crInv . ix i . itID - --curinvid = crSel cr cr = you w chooseEquipmentPosition :: Creature -> [EquipPosition] -> Int diff --git a/src/Dodge/Inventory/CheckSlots.hs b/src/Dodge/Inventory/CheckSlots.hs index 914d15049..cc4461696 100644 --- a/src/Dodge/Inventory/CheckSlots.hs +++ b/src/Dodge/Inventory/CheckSlots.hs @@ -8,7 +8,7 @@ import Control.Lens import Data.Maybe import Dodge.Base.You import Dodge.Data.World -import Dodge.Inventory.ItemSpace +import Dodge.Item.SlotsTaken import qualified IntMapHelp as IM {- | checks whether or not an item will fit in your inventory diff --git a/src/Dodge/Inventory/Color.hs b/src/Dodge/Inventory/Color.hs deleted file mode 100644 index f3700f7eb..000000000 --- a/src/Dodge/Inventory/Color.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Dodge.Inventory.Color where -import Color - -invDimColor :: Color -invDimColor = greyN 0.7 - diff --git a/src/Dodge/Inventory/ItemSpace.hs b/src/Dodge/Inventory/ItemSpace.hs deleted file mode 100644 index e491f18d3..000000000 --- a/src/Dodge/Inventory/ItemSpace.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Dodge.Inventory.ItemSpace ( - itSlotsTaken, -) where - -import Control.Lens -import Dodge.Data.Item -import Dodge.Module - -itSlotsTaken :: Item -> Int -itSlotsTaken it = case it ^? itUse . useAmount of - Nothing -> moduleSizes it + ceiling (_itInvSize it) - Just i -> moduleSizes it + ceiling (_itInvSize it * fromIntegral i) diff --git a/src/Dodge/Inventory/SelectionList.hs b/src/Dodge/Inventory/SelectionList.hs index 08ad57554..c77e49456 100644 --- a/src/Dodge/Inventory/SelectionList.hs +++ b/src/Dodge/Inventory/SelectionList.hs @@ -1,26 +1,25 @@ -module Dodge.Inventory.SelectionList - ( invSelectionItem - , closeObjectToSelectionItem - ) - where +module Dodge.Inventory.SelectionList ( + invSelectionItem, + closeObjectToSelectionItem, +) where -import Dodge.Item.Display -import Dodge.Inventory.ItemSpace -import Picture.Base import Dodge.Data.SelectionList import Dodge.Data.World +import Dodge.Item.SlotsTaken +import Dodge.Item.Display import LensHelp +import Picture.Base -invSelectionItem :: Creature -> Int -> Item -> SelectionItem () -invSelectionItem cr i it = SelectionItem - { _siPictures = pics - , _siHeight = length pics - , _siIsSelectable = True - --, _siWidth = 15 - , _siColor = col - , _siOffX = 0 - , _siPayload = () - } +invSelectionItem :: Creature -> Int -> Item -> SelectionItem () +invSelectionItem cr i it = + SelectionItem + { _siPictures = pics + , _siHeight = length pics + , _siIsSelectable = True + , _siColor = col + , _siOffX = 0 + , _siPayload = () + } where col = _itInvColor it pics = take (itSlotsTaken it) . (++ replicate 10 "*") $ case _itCurseStatus it of @@ -29,19 +28,21 @@ invSelectionItem cr i it = SelectionItem _ -> itemDisplay it closeObjectToSelectionItem :: Either FloorItem Button -> SelectionItem () -closeObjectToSelectionItem e = SelectionItem - { _siPictures = pics - , _siHeight = length pics - , _siIsSelectable = True - --, _siWidth = 15 - , _siColor = col - , _siOffX = 2 - , _siPayload = () - } +closeObjectToSelectionItem e = + SelectionItem + { _siPictures = pics + , _siHeight = length pics + , _siIsSelectable = True + , --, _siWidth = 15 + _siColor = col + , _siOffX = 2 + , _siPayload = () + } where - (pics,col) = closeObjectToTextPictures e + (pics, col) = closeObjectToTextPictures e + -- -closeObjectToTextPictures :: Either FloorItem Button -> ([String],Color) +closeObjectToTextPictures :: Either FloorItem Button -> ([String], Color) closeObjectToTextPictures e = case e of - Left flit -> let it = _flIt flit in ( itemDisplay it, _itInvColor it) + Left flit -> let it = _flIt flit in (itemDisplay it, _itInvColor it) Right bt -> ([_btText bt], yellow) diff --git a/src/Dodge/Item/Display.hs b/src/Dodge/Item/Display.hs index b36ee48ac..dba2a80f8 100644 --- a/src/Dodge/Item/Display.hs +++ b/src/Dodge/Item/Display.hs @@ -7,7 +7,7 @@ module Dodge.Item.Display ( import Data.Maybe import Data.Sequence import Dodge.Data.Creature -import Dodge.Inventory.ItemSpace +import Dodge.Item.SlotsTaken import Dodge.Module import LensHelp import Padding diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 271eed677..23f5aa698 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.SelectionSections import Control.Lens import Data.Foldable import qualified Data.Map.Strict as M @@ -432,3 +433,35 @@ displayHP cid cfig = . leftPad 5 ' ' . show . (^?! cWorld . lWorld . creatures . ix cid . crHP) + +-- there are still more ListDisplayParams to integrate here +selNumTextEndPos :: Configuration -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Maybe Point2 +selNumTextEndPos cfig ldp sss i j = do + ipos <- selSecSelPos i j sss + return $ V2 (150 - hw) (hh - ((s * 10 + ygap) * (fromIntegral ipos + 1))) + where + s = _ldpScale ldp + ygap = _ldpVerticalGap ldp + hh = halfHeight cfig + hw = halfWidth cfig + +selNumEndMidHeight :: + Configuration -> + ListDisplayParams -> + SelectionSections a -> + Int -> + Int -> + Maybe Point2 +selNumEndMidHeight cfig ldp sss i j = do + ipos <- selSecSelPos i j sss + size <- selSecSelSize i j sss + --let bump = negate $ (10 * s + ygap) * fromIntegral size + return $ V2 (150 - hw) (hh - ((10 * s + ygap) * (fromIntegral ipos + fromIntegral size * 0.5))) + where + s = _ldpScale ldp + ygap = _ldpVerticalGap ldp + hh = halfHeight cfig + hw = halfWidth cfig + +selSecSelCol :: Int -> Int -> SelectionSections a -> Maybe Color +selSecSelCol i j sss = sss ^? sssSections . ix i . ssItems . ix j . siColor diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index bd8a2b6d8..293696045 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -4,12 +4,12 @@ module Dodge.Render.List where --import Data.Foldable +import Dodge.SelectionSections import Data.Maybe import Dodge.Base.Window import Dodge.Data.CardinalPoint import Dodge.Data.Config import Dodge.Data.SelectionList -import Dodge.Inventory import Dodge.SelectionList import Geometry import LensHelp diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index dd00dcd1c..22b1b366d 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -6,8 +6,7 @@ Description : Simulation update -} module Dodge.Update (updateUniverse) where ---import Dodge.InputFocus - +import Control.Monad import Dodge.Update.Input.InGame import Dodge.Update.Input.ScreenLayer import Dodge.Debug @@ -279,6 +278,15 @@ functionalUpdate w = -- . over uvWorld updateInventorySelectionList $ over uvWorld updatePastWorlds w +checkTermDist :: World -> World +checkTermDist w = fromMaybe w $ do + tmid <- w ^? hud . hudElement . subInventory . termID + btid <- w ^? cWorld . lWorld . terminals . ix tmid . tmButtonID + btpos <- w ^? cWorld . lWorld . buttons . ix btid . btPos + guard $ dist btpos (_crPos $ you w) > 40 + return (w & hud . hudElement . subInventory .~ NoSubInventory) + + updateWheelEvents :: World -> World updateWheelEvents w | yi == 0 = w