justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Cleanup invSelectionItem

Browse Source
This commit is contained in:
justin
2024-09-30 13:17:10 +01:00
parent fc5539cb38
commit ad76359dcf
11 changed files with 384 additions and 583 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ghcidOutput
+1 -1
View File
@@ -1 +1 @@
All good (611 modules, at 12:49:31)
All good (609 modules, at 13:12:14)
src/Dodge/Combine.hs
+3 -49
View File
@@ -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
-1
View File
@@ -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
-1
View File
@@ -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
+2 -3
View File
@@ -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 (invSelectionItem cr) inv
invitems' = IM.mapWithKey (\k (x,y,_) -> invSelectionItem cr k x y) inv
cr = you w
inv = invIndentIM $ _crInv (you w)
--indents = indentInv inv
src/Dodge/Inventory/SelectionList.hs
+18 -18
View File
@@ -14,25 +14,25 @@ import LensHelp
import Picture.Base
invSelectionItem' :: Creature -> Int -> Item -> SelectionItem ()
invSelectionItem' cr i it =
SelectionItem
{ _siPictures = pics & ix 0 %~ (++ anyequippos ++ anyhotkey)
, _siHeight = _itInvSize it
, _siIsSelectable = True
, _siColor = col
, _siOffX = 0
, _siPayload = ()
}
where
anyhotkey = maybe [] ((' ':) .hotkeyToString) (cr ^? crInvHotkeys . ix i)
anyequippos = maybe [] (rightPad 8 ' ' . (' ':) . eqPosText) (cr ^? crInvEquipped . ix i)
col = itemInvColor it
pics = case _itCurseStatus it of
UndroppableIdentified -> itemDisplay cr it
_ -> itemDisplay cr it
invSelectionItem' cr i it = invSelectionItem cr i it 0
-- SelectionItem
-- { _siPictures = pics & ix 0 %~ (++ anyequippos ++ anyhotkey)
-- , _siHeight = _itInvSize it
-- , _siIsSelectable = True
-- , _siColor = col
-- , _siOffX = 0
-- , _siPayload = ()
-- }
-- where
-- anyhotkey = maybe [] ((' ':) .hotkeyToString) (cr ^? crInvHotkeys . ix i)
-- anyequippos = maybe [] (rightPad 8 ' ' . (' ':) . eqPosText) (cr ^? crInvEquipped . ix i)
-- col = itemInvColor it
-- pics = case _itCurseStatus it of
-- UndroppableIdentified -> itemDisplay cr it
-- _ -> itemDisplay cr it
invSelectionItem :: Creature -> Int -> (Item,Int,a) -> SelectionItem ()
invSelectionItem cr i (it,indent,_) =
invSelectionItem :: Creature -> Int -> Item -> Int -> SelectionItem ()
invSelectionItem cr i it indent =
SelectionItem
{ _siPictures = pics & ix 0 %~ (++ anyequippos ++ anyhotkey)
, _siHeight = _itInvSize it
src/Dodge/Item/Weapon/Targeting.hs
-16
View File
@@ -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
-2
View File
@@ -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
-120
View File
@@ -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
-3
View File
@@ -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
tags
+360 -369
View File
File diff suppressed because it is too large Load Diff