Cleanup invSelectionItem

ghcidOutput

@@ -1 +1 @@
-All good (611 modules, at 12:49:31)
+All good (609 modules, at 13:12:14)

src/Dodge/Combine.hs

@@ -12,7 +12,6 @@ import Dodge.Data.Combine
 import Dodge.Data.Universe
 import Dodge.Item.Display
 import Dodge.Item.InventoryColor
---import Dodge.Module
 import qualified IntMapHelp as IM
 import SimpleTrie
 
@@ -36,59 +35,14 @@ combineItemListYouX :: World -> [([Int], Item)]
 combineItemListYouX = map (first concat) . flatLookupItems . yourInv
 
 combineList :: World -> [SelectionItem CombinableItem]
-combineList = map f . combineListInfo
+combineList = map f . combineItemListYouX
   where
-    f (is, (strs, itm)) =
+    f (is, itm) =
         SelectionItem
             { _siPictures = basicItemDisplay itm
             , _siHeight = _itInvSize itm
             , _siIsSelectable = True
             , _siColor = itemInvColor itm
             , _siOffX = 0
-            , _siPayload = CombinableItem is itm strs
+            , _siPayload = CombinableItem is itm []
             }
-
-combineListInfo :: World -> [([Int], ([String], Item))]
-combineListInfo w = map (cmm inv) $ combineItemListYouX w
-  where
-    inv = yourInv w
---combineListInfo w = filter f . map (cmm inv) $ combineItemListYouX w
---  where
---    inv = yourInv w
---    f (is, (_, itm)) = _itType itm `notElem` fmap _itType (IM.restrictKeys inv (IS.fromList is))
-
-cmm :: IM.IntMap Item -> ([Int], Item) -> ([Int], ([String], Item))
-cmm _ (is, itm) = (is, ([], itm))
-
---cmm :: IM.IntMap Item -> ([Int], Item) -> ([Int], ([String], Item))
---cmm inv (is, itm) = (is, itm & itType . iyModules %%~ flip combineModuleMaps mms)
---  where
---    mms = map (_iyModules . _itType . (inv IM.!)) is
-
---combineModuleMaps ::
---    M.Map ModuleSlot ItemModuleType ->
---    [M.Map ModuleSlot ItemModuleType] ->
---    ([String], M.Map ModuleSlot ItemModuleType)
---combineModuleMaps = foldM combineTwoModuleMaps
-
---combineTwoModuleMaps ::
---    M.Map ModuleSlot ItemModuleType ->
---    M.Map ModuleSlot ItemModuleType ->
---    ([String], M.Map ModuleSlot ItemModuleType)
---combineTwoModuleMaps =
---    mergeA
---        preserveMissing
---        (filterAMissing f)
---        (zipWithAMatched g)
---  where
---    f _ EMPTYMODULE = ([], False)
---    f _ md = ([rm "REMOVES" md], False)
---    g _ EMPTYMODULE md = ([], md)
---    g _ md EMPTYMODULE = ([], md)
---    g _ md2 md1 = ([rm "REPLACES" md1 ++ rm " WITH" md2], md2)
---    rm str md = str ++ " " ++ fullModuleName md
-
--- g above could be a monoid of some description...
-
---fullModuleName :: ItemModuleType -> String
---fullModuleName = fromMaybe "EMPTYMODULE" . moduleName

src/Dodge/Creature/State.hs

@@ -298,7 +298,6 @@ updateItemTargeting tt cr itm w = w & case tt of
     TargetCursor -> cWorld . lWorld . creatures . ix (_crID cr) 
             . crInv . ix (_ilInvID $ _itLocation itm) . itUse .~ TargetingUse 
                 (Just (mouseWorldPos (w ^. input) (w ^. wCam))) Nothing True
-    _ -> id
   where 
     isattached = itm ^?! itLocation . ilIsAttached 
     rbpressed = SDL.ButtonRight `M.member` _mouseButtons (_input w)

src/Dodge/Data/Item/Targeting.hs

@@ -11,7 +11,6 @@ import Data.Aeson.TH
 data TargetingType
     = TARGETLASER
     | TargetRBPress
-    | TargetRBLine
     | TargetRBCreature
     | TargetCursor
     deriving (Eq, Ord, Show, Read, Enum, Bounded) --Generic, Flat)

src/Dodge/DisplayInventory.hs

@@ -9,6 +9,7 @@ module Dodge.DisplayInventory (
     updateCombinePositioning,
 ) where
 
+import Control.Lens
 import Dodge.Inventory.SelectionList
 import Control.Monad
 import qualified Data.IntMap.Strict as IM
@@ -24,7 +25,6 @@ import Dodge.Inventory.CheckSlots
 import Dodge.ListDisplayParams
 import Dodge.SelectionList
 import Dodge.Item.Grammar
-import LensHelp
 import ListHelp
 import Picture.Base
 import Regex
@@ -113,8 +113,7 @@ updateDisplaySections w cfig sss =
     coitems' =
         IM.fromDistinctAscList . zip [0 ..] $
             map closeObjectToSelectionItem (w ^. hud . closeObjects)
-    --invitems' = MIM.merge MIM.dropMissing MIM.dropMissing (MIM.zipWithMatched $ const addindent) indents $ IM.mapWithKey (invSelectionItem cr) inv
+    invitems' = IM.mapWithKey (\k (x,y,_) -> invSelectionItem cr k x y) inv
-    invitems' = IM.mapWithKey (invSelectionItem cr) inv
     cr = you w
     inv = invIndentIM  $ _crInv (you w)
     --indents = indentInv inv

src/Dodge/Inventory/SelectionList.hs

@@ -14,25 +14,25 @@ import LensHelp
 import Picture.Base
 
 invSelectionItem' :: Creature -> Int -> Item -> SelectionItem ()
-invSelectionItem' cr i it =
+invSelectionItem' cr i it = invSelectionItem cr i it 0
-    SelectionItem
+--    SelectionItem
-        { _siPictures = pics & ix 0 %~ (++ anyequippos ++ anyhotkey)
+--        { _siPictures = pics & ix 0 %~ (++ anyequippos ++ anyhotkey)
-        , _siHeight = _itInvSize it
+--        , _siHeight = _itInvSize it
-        , _siIsSelectable = True
+--        , _siIsSelectable = True
-        , _siColor = col
+--        , _siColor = col
-        , _siOffX = 0
+--        , _siOffX = 0
-        , _siPayload = ()
+--        , _siPayload = ()
-        }
+--        }
-  where
+--  where
-    anyhotkey = maybe [] ((' ':) .hotkeyToString) (cr ^? crInvHotkeys . ix i)
+--    anyhotkey = maybe [] ((' ':) .hotkeyToString) (cr ^? crInvHotkeys . ix i)
-    anyequippos = maybe [] (rightPad 8 ' ' . (' ':) . eqPosText) (cr ^? crInvEquipped . ix i)
+--    anyequippos = maybe [] (rightPad 8 ' ' . (' ':) . eqPosText) (cr ^? crInvEquipped . ix i)
-    col = itemInvColor it
+--    col = itemInvColor it
-    pics =  case _itCurseStatus it of
+--    pics =  case _itCurseStatus it of
-        UndroppableIdentified -> itemDisplay cr it
+--        UndroppableIdentified -> itemDisplay cr it
-        _ -> itemDisplay cr it
+--        _ -> itemDisplay cr it
 
-invSelectionItem :: Creature -> Int -> (Item,Int,a) -> SelectionItem ()
+invSelectionItem :: Creature -> Int -> Item -> Int -> SelectionItem ()
-invSelectionItem cr i (it,indent,_) =
+invSelectionItem cr i it indent =
     SelectionItem
         { _siPictures = pics & ix 0 %~ (++ anyequippos ++ anyhotkey)
         , _siHeight = _itInvSize it

src/Dodge/Item/Weapon/Targeting.hs

@@ -1,16 +0,0 @@
-module Dodge.Item.Weapon.Targeting (
---    useTargetPos,
-) where
-
---import Control.Lens
---import Dodge.Data.World
---import Geometry.Data
-
---useTargetPos ::
---    (Maybe Point2 -> Creature -> World -> World) ->
---    Creature ->
---    World ->
---    World
---useTargetPos f cr w = case cr ^? crTargeting . ctPos of
---    Nothing -> w
---    Just p -> f p cr w

src/Dodge/LockAndKey.hs

@@ -25,8 +25,6 @@ lockRoomMultiItems =
 lockRoomKeyItems :: RandomGen g => [(Int -> State g (MetaTree Room String), State g ItemType)]
 lockRoomKeyItems =
     [ (lasCenSensEdge, takeOne [HELD LAUNCHER, HELD LASGUN, HELD SPARKGUN, HELD FLATSHIELD, HELD FORCEFIELDGUN])
---    , (sensorRoomRunPast ELECTRICAL, takeOne [CRAFT (ENERGYBALLCRAFT TeslaBall), HELD SPARKGUN])
---    , (sensorRoomRunPast FLAMING, takeOne [HELD FLAMESPITTER, CRAFT (ENERGYBALLCRAFT IncBall)])
     , (sensorRoomRunPast LASERING, return $ HELD LASGUN)
     , (const slowDoorRoomRunPast, return $ HELD (MINIGUNX 3))
     , (const longRoomRunPast, takeOne [HELD SNIPERRIFLE, HELD FLATSHIELD])

src/Dodge/Targeting.hs

@@ -1,120 +0,0 @@
-module Dodge.Targeting (
---    updateTargeting,
-) where
-
---import Color
---import qualified Data.Map.Strict as M
---import Data.Maybe
---import Dodge.Base.Collide
---import Dodge.Base.Coordinate
---import Dodge.Creature.Test
---import Dodge.Data.World
---import Dodge.Item.Weapon.LaserPath
---import Dodge.Zoning.Creature
---import FoldableHelp
---import Geometry.Vector
---import LensHelp
---import qualified SDL
-
---updateTargeting :: Maybe TargetingType -> Creature -> World -> World
---updateTargeting tu = case tu of
---    Nothing -> clearTargeting
---    Just TARGETLASER -> targetLaserUpdate'
---    Just TargetRBPress -> upCT (flip targetRBPressUpdate . _crTargeting)
---    Just TargetRBLine  -> upCT (flip targetRBPressUpdate . _crTargeting)
---    Just TargetRBCreature -> upCT targetRBCreatureUp
---    Just TargetCursor -> upCT (flip targetCursorUpdate . _crTargeting)
-
---clearTargeting :: Creature -> World -> World
---clearTargeting cr = cWorld . lWorld . creatures . ix (_crID cr) . crTargeting .~ defaultTargeting
---
---defaultTargeting :: CreatureTargeting
---defaultTargeting = CreatureTargeting Nothing Nothing Nothing False
---
---upCT :: (Creature -> World -> CreatureTargeting) -> Creature -> World -> World
---upCT f cr w = w & cWorld . lWorld . creatures . ix (_crID cr) . crTargeting .~ f cr w
---
---targetRBCreatureUp :: Creature -> World -> CreatureTargeting
---targetRBCreatureUp cr w
---    | SDL.ButtonRight `M.member` _mouseButtons (_input w) && isJust (t ^? ctID . _Just)
---        && canSeeTarget =
---        t & updatePos & ctActive .~ True
---            & ctType ?~ TargetRBCreature
---    | otherwise = t & ctID .~ fmap _crID newtarg & updatePos & ctActive .~ False
---            & ctType ?~ TargetRBCreature
---  where
---    t = _crTargeting cr
---    newtarg =
---        safeMinimumOn (dist mwp . _crPos)
---            . filter (canseepos . _crPos)
---            $ crsNearCirc mwp 40 w
---    canseepos p = hasLOS (_crPos cr) p w
---    mwp = mouseWorldPos (w ^. input) (w ^. wCam)
---    updatePos t' = t' & ctPos .~ posFromMaybeID (_ctID t')
---    posFromMaybeID Nothing = Nothing
---    posFromMaybeID (Just i) = w ^? cWorld . lWorld . creatures . ix i . crPos
---    canSeeTarget = fromMaybe False $ do
---        cid <- t ^? ctID . _Just
---        cpos <- w ^? cWorld . lWorld . creatures . ix cid . crPos
---        Just $ hasLOS cpos (_crPos cr) w
---
---targetCursorUpdate :: World -> CreatureTargeting -> CreatureTargeting
---targetCursorUpdate w ct =
---    ct
---        & ctPos . _Just .~ mouseWorldPos (w ^. input) (w ^. wCam)
---        & ctActive .~ True
---            & ctType ?~ TargetCursor
---
---targetRBPressUpdate :: World -> CreatureTargeting -> CreatureTargeting
---targetRBPressUpdate w t
---    | SDL.ButtonRight `M.member` _mouseButtons (_input w) =
---        t
---            & ctPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. wCam)) Just
---            & ctActive .~ True
---            & ctType ?~ TargetRBPress
---    | otherwise =
---        t
---            & ctPos %~ const Nothing
---            & ctActive .~ False
---            & ctType ?~ TargetRBPress
---
---targetLaserUpdate' :: Creature -> World -> World
---targetLaserUpdate' cr w =
---    let (w', ct') = targetLaserUpdate cr w (_crTargeting cr)
---     in w' & cWorld . lWorld . creatures . ix (_crID cr) . crTargeting .~ ct'
---
---targetLaserUpdate :: Creature -> World -> CreatureTargeting -> (World, CreatureTargeting)
---targetLaserUpdate cr w t
---    | crIsAiming cr =
---        --( addLaserPic w
---        ( w
---        , t
---            & ctPos .~ fmap fst mp
---            & ctActive .~ True
---            & ctType ?~ TARGETLASER
---        )
---    | otherwise =
---        ( w
---        , t & ctPos %~ const Nothing
---            & ctActive .~ False
---        )
---  where
---    (mp, _) = reflectLaserAlong 0.2 sp ep w
---    sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
---    ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos (w ^. input) (w ^. wCam) -.- sp)
-----    addLaserPic =
-----        cWorld . lWorld . lasers
-----            .:~ LaserStart
-----                { _lpPhaseV = 1
-----                , _lpDir = _crDir cr
-----                , _lpPos = sp
-----                , _lpColor = col
-----                , _lpType = TargetingLaser
-----                }
---    --wpammo = _itConsumption it
---    --    reloadFrac
---    --        | _laLoaded wpammo == 0 = 1
---    --        | otherwise = case _laTransfer wpammo of
---    --            Transfer _ rs -> fromIntegral rs / fromIntegral (_laReloadTime wpammo)
---    --            NoTransfer -> 1
-----    col = blue -- mixColors reloadFrac (1-reloadFrac) blue red

src/Dodge/Targeting/Draw.hs

@@ -14,7 +14,6 @@ import Picture
 drawTargeting :: TargetingType -> Creature -> Configuration -> World -> Picture
 drawTargeting td = case td of
     TargetRBCreature -> targetRBCreatureDraw
-    TargetRBLine -> targetDistanceDraw
     TARGETLASER -> targetSimpleDraw
     TargetRBPress -> targetSimpleDraw
     TargetCursor -> targetSimpleDraw
@@ -22,8 +21,6 @@ drawTargeting td = case td of
 targetSimpleDraw :: Creature -> Configuration -> World -> Picture
 targetSimpleDraw = targetDraw activeTargetCursorPic
 
-targetDistanceDraw :: Creature -> Configuration -> World -> Picture
-targetDistanceDraw _ _ _ = mempty 
 --targetDistanceDraw cr _ w = mempty 
 --  fromMaybe mempty $ do
 --    p <- cr ^? crTargeting . ctPos . _Just