From 17c79e7cee8082366fcf141994c556138c7ca13f Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 19 May 2023 19:29:37 +0100 Subject: [PATCH] Cleanup and fix selection section cursor position bug --- src/Dodge/Creature/Impulse/UseItem.hs | 14 ++++------- src/Dodge/Item/Display.hs | 15 +++++------ src/Dodge/Item/Draw/SPic.hs | 1 + src/Dodge/Reloading.hs | 36 ++++++++++++++------------- src/Dodge/Render/List.hs | 4 ++- src/Dodge/SelectionSections.hs | 2 +- 6 files changed, 35 insertions(+), 37 deletions(-) diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index 6b3f0fdf4..189aaa8f8 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -34,23 +34,19 @@ useItemRightClick cr' w = fromMaybe (f w) $ do itemEffect :: Creature -> Item -> World -> World itemEffect cr it w = case it ^. itUse of HeldUse{_heldUse = eff, _heldMods = usemods} -> - hammerTest $ foldl' (&) (useHeld eff) (useMod usemods) it cr + foldl' (&) (useHeld eff) (useMod usemods) it cr w LeftUse{} -> doequipmentchange EquipUse{} -> doequipmentchange -- ConsumeUse will cause problems if the item is not selected - (ConsumeUse eff _) -> setuhamdown $ hammerTest $ useC eff it cr . rmInvItem (_crID cr) itRef - CraftUse{} -> setuhamdown w + (ConsumeUse eff _) -> useC eff it cr $ rmInvItem (_crID cr) itRef w + CraftUse{} -> w where itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change hammerTest f = case _crHammerPosition cr of - HammerUp -> f w + HammerUp -> f w & setuhamdown _ -> w & setuhamdown setuhamdown = cWorld . lWorld . creatures . ix (_crID cr) . crHammerPosition .~ HammerDown - doequipmentchange = - setuhamdown $ - hammerTest - ( toggleEquipmentAt itRef cr - ) + doequipmentchange = hammerTest $ toggleEquipmentAt itRef cr toggleEquipmentAt :: Int -> Creature -> World -> World toggleEquipmentAt invid cr w = case getEquipmentAllocation w of diff --git a/src/Dodge/Item/Display.hs b/src/Dodge/Item/Display.hs index 1267caa55..2ab529e1a 100644 --- a/src/Dodge/Item/Display.hs +++ b/src/Dodge/Item/Display.hs @@ -39,7 +39,7 @@ basicItemDisplay itm = itemBaseName itm : catMaybes [maybeWarmupStatus itm, maybeRateStatus itm] ++ moduleStrings itm - ++ repeat "\\" + ++ repeat "*" itemString :: Item -> String itemString = head . basicItemDisplay @@ -78,7 +78,7 @@ showAutoRechargeProgress lc = case lc of itemNumberDisplay :: Creature -> Item -> [String] itemNumberDisplay cr itm = case iu of - HeldUse{} -> [showReloadProgress' cr itm] + HeldUse{} -> [showReloadProgress cr itm] LeftUse{} -> [showAutoRechargeProgress (_leftConsumption iu)] EquipUse{} -> showEquipmentNumber cr itm _ -> [show $ iu ^?! useAmount . getItAmount] @@ -106,17 +106,14 @@ showAmmoSource cr itm = fromMaybe ["FAIL"] $ do guard (at' == atype && as == AboveSource) return ["vvvv",x] ) <|> Just [x] -showReloadProgress' :: Creature -> Item -> String -showReloadProgress' cr itm = case ic ^? laSource of +showReloadProgress :: Creature -> Item -> String +showReloadProgress cr itm = case ic ^? laSource of Just (InternalSource ia) -> case ia ^? iaProgress . _Just . ix 0 of - Nothing -> fromMaybe "" $ do - x <- ic ^? laSource . _InternalSource . iaLoaded - return $ show x - Just la -> show (_actionTime la) ++ showLoadActionType la (_laSource ic) + Nothing -> maybe "" show $ ic ^? laSource . _InternalSource . iaLoaded + Just la -> showLoadActionType la (_laSource ic) Just AboveSource -> fromMaybe "||||" $ do i <- fmap (subtract 1) $ itm ^? itLocation . ipInvID _ <- cr ^? crInv . ix i . itUse . equipEffect . eeUse . euseAmmoAmount - --return $ showIntKMG' x return "" _ -> "" where diff --git a/src/Dodge/Item/Draw/SPic.hs b/src/Dodge/Item/Draw/SPic.hs index 26e9d5763..d3bf21323 100644 --- a/src/Dodge/Item/Draw/SPic.hs +++ b/src/Dodge/Item/Draw/SPic.hs @@ -374,6 +374,7 @@ volleyGunShape i = [0 .. i -1] ) +-- to get this rotating should probably add extra state to the minigun miniGunXPictItem :: Int -> Item -> SPic miniGunXPictItem i it = miniGunXPict i spin where diff --git a/src/Dodge/Reloading.hs b/src/Dodge/Reloading.hs index f6e3096d1..7eaa4aff7 100644 --- a/src/Dodge/Reloading.hs +++ b/src/Dodge/Reloading.hs @@ -5,11 +5,9 @@ module Dodge.Reloading ( tryStartLoading, ) where -import Dodge.Data.Item.Use.Consumption.LoadAction import Control.Lens -import Dodge.Data.Creature import Data.Maybe ---import qualified IntMapHelp as IM +import Dodge.Data.Creature crCancelReloading :: Creature -> Creature crCancelReloading cr = @@ -19,7 +17,9 @@ crCancelReloading cr = where updateProgress = fromMaybe id $ do InInventory (SelItem i _) <- cr ^? crManipulation . manObject - return $ crInv . ix i . itUse . heldConsumption . laSource . _InternalSource . iaProgress %~ const Nothing + return $ + crInv . ix i . itUse . heldConsumption . laSource . _InternalSource . iaProgress + %~ const Nothing stepReloading :: Creature -> Creature stepReloading cr = case cr ^? crManipulation . manObject . inInventory of @@ -35,7 +35,7 @@ stepReloading cr = case cr ^? crManipulation . manObject . inInventory of tryNextLoadAction :: Creature -> Creature tryNextLoadAction cr = case cr ^? crManipulation . manObject . inInventory of - Just (SelItem i _) -> case cr ^? crInv . ix i . itUse . heldConsumption . laSource . _InternalSource . iaProgress . _Just . ix 0 of + Just (SelItem i _) -> case cr ^? crInv . ix i . itUse . heldConsumption . laSource . _InternalSource . iaProgress . _Just . ix 0 of Nothing -> cr & crManipulation . manObject . inInventory . iselAction .~ NoInvSelAction Just la -> cr & crManipulation . manObject . inInventory . iselAction . actionProgress .~ _actionTime la @@ -50,28 +50,30 @@ crUpdateLoadSource cr = case cr ^? crManipulation . manObject . inInventory . is tryStartLoading :: Creature -> Creature tryStartLoading cr = fromMaybe cr $ do i <- cr ^? crManipulation . manObject . inInventory . ispItem - as <- cr ^? crInv . ix i . itUse . heldConsumption . laSource - case as of - InternalSource ia -> return $ startLoading ia cr - AboveSource -> return cr + ia <- cr ^? crInv . ix i . itUse . heldConsumption . laSource . _InternalSource + return $ startLoading ia cr + +-- case as of +-- InternalSource ia -> return $ startLoading ia cr +-- AboveSource -> return cr startLoading :: InternalAmmo -> Creature -> Creature startLoading ic cr = case ic ^? iaProgress . _Just . ix 0 of Just la -> cr & startLoadingStep la - Nothing -> case ic ^? iaCycle of - Nothing -> cr - Just [] -> error "item has empty load cycle" - Just _ | _iaLoaded ic >= _iaMax ic -> cr - Just (la : las) -> fromMaybe (error "item loading error") $ do + Nothing -> case ic ^. iaCycle of + [] -> error "item has empty load cycle" + _ | _iaLoaded ic >= _iaMax ic -> cr + (la : las) -> fromMaybe (error "item loading error") $ do i <- cr ^? crManipulation . manObject . inInventory . ispItem - return $ cr & startLoadingStep la - & crInv . ix i . itUse . heldConsumption . laSource . _InternalSource . iaProgress ?~ (la : las) + return $ + cr & startLoadingStep la + & crInv . ix i . itUse . heldConsumption . laSource . _InternalSource . iaProgress ?~ (la : las) startLoadingStep :: LoadAction -> Creature -> Creature startLoadingStep la cr = cr & crManipulation . manObject . inInventory . iselAction .~ ReloadAction (_actionTime la) la rotateActionProgress :: InternalAmmo -> InternalAmmo -rotateActionProgress ic = case ic ^? iaProgress . _Just of +rotateActionProgress ic = case ic ^. iaProgress of Just (_ : la : las) -> ic & iaProgress . _Just .~ (la : las) _ | _iaLoaded ic < _iaMax ic -> ic & iaProgress ?~ _iaCycle ic _ -> ic & iaProgress .~ Nothing diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index 2d482a0b4..915759063 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -12,6 +12,7 @@ module Dodge.Render.List ( listCursorChooseBorderScale, ) where +import Dodge.SelectionSections import Data.Maybe import Dodge.Base.Window import Dodge.Data.CardinalPoint @@ -85,7 +86,8 @@ stackPicturesAtOff i = mconcat . zipWith (drawListElement 10 1 0) [i, i -1 ..] selSecDrawCursor :: Int -> ListDisplayParams -> SelectionSections a -> Picture selSecDrawCursor xsize ldp sss = fromMaybe mempty $ do (i, j) <- sss ^? sssExtra . sssSelPos . _Just - yint <- sss ^? sssSections . ix i . ssCursor . _Just . scurPos + --yint <- sss ^? sssSections . ix i . ssCursor . _Just . scurPos + yint <- selSecYint i j sss xint <- sss ^? sssSections . ix i . ssIndent si <- sss ^? sssSections . ix i . ssItems . ix j return $ diff --git a/src/Dodge/SelectionSections.hs b/src/Dodge/SelectionSections.hs index 1cb9e0f04..47788f69b 100644 --- a/src/Dodge/SelectionSections.hs +++ b/src/Dodge/SelectionSections.hs @@ -130,7 +130,7 @@ selSecYint i j sss = do return . (secpos +) . subtract (ss ^. ssOffset) . sum - . fmap (length . _siPictures) + . fmap (_siHeight) . fst $ IM.split j (ss ^. ssItems) where