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

Fix at least one bug from item refactor, more remain

Browse Source
This commit is contained in:
justin
2025-08-24 21:01:02 +01:00
parent 94f6d5c630
commit c2daa86463
19 changed files with 95 additions and 95 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/ArmourChase.hs
+1 -1
View File
@@ -8,7 +8,7 @@ import Control.Lens
import Dodge.Creature.ChaseCrit
import Dodge.Data.Creature
import Dodge.Default
import Dodge.Item.Equipment
--import Dodge.Item.Equipment
import qualified IntMapHelp as IM
flockArmourChaseCrit :: Creature
src/Dodge/Creature/AutoCrit.hs
+2 -2
View File
@@ -2,11 +2,11 @@ module Dodge.Creature.AutoCrit (
autoCrit,
) where
import Dodge.Item.Held.Cane
--import Dodge.Item.Held.Cane
--import Control.Lens
import Dodge.Data.Creature
import Dodge.Default
import qualified IntMapHelp as IM
--import qualified IntMapHelp as IM
--import Picture
autoCrit :: Creature
src/Dodge/Creature/ChaseCrit.hs
+3 -3
View File
@@ -4,11 +4,11 @@ module Dodge.Creature.ChaseCrit (
chaseCrit,
) where
import Dodge.Data.Equipment.Misc
import Control.Lens
--import Dodge.Data.Equipment.Misc
--import Control.Lens
import Dodge.Data.Creature
import Dodge.Default
import Dodge.Item.Equipment
--import Dodge.Item.Equipment
import Picture
smallChaseCrit :: Creature
src/Dodge/Creature/HandPos.hs
+8 -8
View File
@@ -15,7 +15,7 @@ module Dodge.Creature.HandPos (
headPQ,
) where
import Dodge.Data.Equipment.Misc
--import Dodge.Data.Equipment.Misc
import qualified Data.IntMap.Strict as IM
import qualified Quaternion as Q
import Control.Lens
@@ -27,13 +27,13 @@ import ShapePicture
translatePointToRightHand :: IM.IntMap Item -> Creature -> Point3 -> Point3
translatePointToRightHand m cr p = fst (rightHandPQ m cr `Q.comp` (p,Q.qID))
equipSitePQ :: EquipSite -> IM.IntMap Item -> Creature -> Point3Q
equipSitePQ = \case
OnRightWrist -> rightHandPQ
OnLeftWrist -> leftHandPQ
OnBack -> backPQ
OnChest -> chestPQ
_ -> undefined
--equipSitePQ :: EquipSite -> IM.IntMap Item -> Creature -> Point3Q
--equipSitePQ = \case
-- OnRightWrist -> rightHandPQ
-- OnLeftWrist -> leftHandPQ
-- OnBack -> backPQ
-- OnChest -> chestPQ
-- _ -> undefined
rightHandPQ :: IM.IntMap Item -> Creature -> Point3Q
rightHandPQ m cr
src/Dodge/Creature/LauncherCrit.hs
+2 -2
View File
@@ -2,11 +2,11 @@ module Dodge.Creature.LauncherCrit (
launcherCrit,
) where
import Dodge.Item.Held.Launcher
--import Dodge.Item.Held.Launcher
--import Control.Lens
import Dodge.Data.Creature
import Dodge.Default
import qualified IntMapHelp as IM
--import qualified IntMapHelp as IM
--import Picture
launcherCrit :: Creature
src/Dodge/Creature/SpreadGunCrit.hs
+1 -2
View File
@@ -5,8 +5,7 @@ module Dodge.Creature.SpreadGunCrit (
--import Control.Lens
import Dodge.Data.Creature
import Dodge.Default
import Dodge.Item.Held.Stick
import qualified IntMapHelp as IM
--import qualified IntMapHelp as IM
--import Picture
spreadGunCrit :: Creature
src/Dodge/Creature/Statistics.hs
-1
View File
@@ -8,7 +8,6 @@ module Dodge.Creature.Statistics (
import Dodge.Data.LWorld
import Data.Maybe
import Dodge.Data.Creature
import qualified IntMapHelp as IM
import LensHelp
src/Dodge/Creature/Test.hs
+1 -1
View File
@@ -97,7 +97,7 @@ crInAimStance as m cr = crIsAiming cr && mitstance == Just as
mitstance = do
i <- cr ^? crManipulation . manObject . imRootSelectedItem
--itm <- invRootTrees' (cr ^. crInv) ^? ix i
itm <- fmap (fmap (\(a,b,_) -> (a,b))) $ invIMDT (fmap (\i -> m ^?! ix i) (cr ^. crInv)) ^? ix i
itm <- fmap (fmap (\(a,b,_) -> (a,b))) $ invIMDT (fmap (\k -> m ^?! ix k) (cr ^. crInv)) ^? ix i
return $ aimStance itm
--cr ^? crInv . ix i . itUse . heldAim . aimStance
src/Dodge/DisplayInventory.hs
+1 -5
View File
@@ -114,11 +114,7 @@ displayIndents 3 = 2
displayIndents 5 = 2
displayIndents _ = 0
updateDisplaySections ::
World ->
Configuration ->
IM.IntMap (SelectionSection ()) ->
IM.IntMap (SelectionSection ())
updateDisplaySections :: World -> Configuration -> IMSS () -> IMSS ()
updateDisplaySections w cfig =
updateSectionsPositioning
displayIndents
src/Dodge/FloorItem.hs
+13 -17
View File
@@ -1,36 +1,32 @@
module Dodge.FloorItem (
copyItemToFloor,
copyItemToFloorID,
-- copyItemToFloorID,
) where
import Dodge.Item.InvSize
import NewInt
import Control.Lens
import Data.Maybe
import Data.Monoid
import Dodge.Base
import Dodge.Data.World
import Dodge.Item.InvSize
import Geometry
import qualified IntMapHelp as IM
--import qualified IntMapHelp as IM
import NewInt
import System.Random
-- | Copy an item to the floor.
-- | Copy an item to the floor
copyItemToFloor :: Point2 -> Item -> World -> World
copyItemToFloor pos it = copyItemToFloorID pos it
-- | Copy an item to the floor, returns the floor item's id.
copyItemToFloorID :: Point2 -> Item -> World -> World
copyItemToFloorID pos it w =
w'
& cWorld . lWorld . floorItems %~ IM.insert (_unNInt $ _itID it) theflit
& cWorld . lWorld . items . ix (_unNInt $ _itID it) . itLocation .~ OnFloor
& hud . closeItems %~ (_itID it:)
-- & hud . hudElement . diSections . ix 3 . ssOffset .~ 0
-- ensures dropped item is at the top of the close item selection list
copyItemToFloor pos it w =
w'
& cWorld . lWorld . floorItems . at (_unNInt $ _itID it) ?~ theflit
& cWorld . lWorld . items . at (_unNInt $ _itID it) ?~ (it & itLocation .~ OnFloor)
& hud . closeItems %~ (_itID it :)
where
-- & hud . hudElement . diSections . ix 3 . ssOffset .~ 0
-- ensures dropped item is at the top of the close item selection list
(p', w') = findWallFreeDropPoint (_dimRad $ itDim it) pos w
rot = fst . randomR (- pi, pi) $ _randGen w
theflit = FlIt { _flItPos = p' , _flItRot = rot }
theflit = FlIt{_flItPos = p', _flItRot = rot}
cardinalVectors :: [Point2]
cardinalVectors =
src/Dodge/Inventory/Add.hs
+2 -2
View File
@@ -111,11 +111,11 @@ tryPutItemInInvAt i cid itid w = do
-- return (Just i, w')
createItemYou :: Item -> World -> World
createItemYou itm w = fromMaybe w' $ fmap snd $ tryPutItemInInv 0 itid w'
createItemYou itm w = w' -- fromMaybe w' $ fmap snd $ tryPutItemInInv 0 itid w'
where
itid = IM.newKey $ w ^. cWorld . lWorld . items
pos = w ^?! cWorld . lWorld . creatures . ix 0 . crPos
w' = copyItemToFloorID pos (itm & itID .~ NInt itid) w
w' = copyItemToFloor pos (itm & itID .~ NInt itid) w
-- | Pick up a specific item.
pickUpItem :: Int -> Int -> World -> World
src/Dodge/Inventory/Location.hs
+2 -1
View File
@@ -46,7 +46,8 @@ crUpdateItemLocations :: Int -> LWorld -> LWorld
crUpdateItemLocations crid lw = fromMaybe lw $ do
mo <- lw ^? creatures . ix crid . crManipulation . manObject
itids <- lw ^? creatures . ix crid . crInv
let crinv = IM.restrictKeys (lw ^. items) (IS.fromList $ IM.elems itids)
--let crinv = IM.restrictKeys (lw ^. items) (IS.fromList $ IM.elems itids)
let crinv = fmap (\k -> lw ^?! items . ix k) itids
return $ crSetRoots crid $ IM.foldlWithKey' (crUpdateInvidLocations mo crid) lw crinv
crSetRoots :: Int -> LWorld -> LWorld
src/Dodge/Item/Draw.hs
+2 -2
View File
@@ -19,8 +19,8 @@ import ShapePicture
itemEquipPict :: IM.IntMap Item -> Creature -> DTree CItem -> SPic
itemEquipPict m cr itmtree
| Just i <- itm ^? itLocation . ilInvID
, Just esite <- itm ^? itLocation . ilEquipSite . _Just
| --Just i <- itm ^? itLocation . ilInvID
Just esite <- itm ^? itLocation . ilEquipSite . _Just
, Just attachpos <- equipAttachPos <$> itm ^? itType . ibtEquip
= equipPosition esite m cr attachpos (itemSPic itm)
| itm ^? itLocation . ilInvID == cr ^? crManipulation . manObject . imRootSelectedItem
src/Dodge/Item/Location/Initialize.hs
+5 -5
View File
@@ -3,11 +3,11 @@ module Dodge.Item.Location.Initialize
--, initItemLocations
)
where
import NewInt
import Dodge.Data.LWorld
import Control.Lens
import qualified IntMapHelp as IM
import Data.Traversable
--import NewInt
--import Dodge.Data.LWorld
--import Control.Lens
--import qualified IntMapHelp as IM
--import Data.Traversable
--initItemLocations :: LWorld -> LWorld
----initItemLocations = initCrsItemLocations . initFlItemsLocations . initTusItemLocations
src/Dodge/TestString.hs
+7 -2
View File
@@ -27,11 +27,16 @@ import Dodge.Data.Universe
import qualified IntMapHelp as IM
import qualified Data.Map.Strict as M
import NewInt
import Data.Foldable
testStringInit :: Universe -> [String]
testStringInit u = map show (IM.keys $ u ^. uvWorld . cWorld . lWorld . items)
testStringInit u = map f (IM.elems $ u ^. uvWorld . cWorld . lWorld . items)
<> ["---"]
<> map show (IM.toList . fold $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInv)
<> ["---"]
<> map show (IM.keys $ u ^. uvWorld . cWorld . lWorld . floorItems)
<> map show (u ^. uvWorld . hud . closeItems)
where
f itm = show (itm ^. itID . unNInt) <> ":"<> show (itm ^. itLocation)
-- map shortShow (u ^.. uvWorld . cWorld . lWorld . debris . each . to g)
-- where
-- g db = (pz,z,norm v)