Major item refactor, still broken
This commit is contained in:
+13
-12
@@ -4,6 +4,7 @@ module Dodge.Item.Draw (
|
||||
itemEquipPict,
|
||||
) where
|
||||
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import qualified Quaternion as Q
|
||||
import Dodge.Data.Equipment.Misc
|
||||
import Dodge.Data.ComposedItem
|
||||
@@ -16,12 +17,12 @@ import Dodge.Item.Draw.SPic
|
||||
import Dodge.Item.HeldOffset
|
||||
import ShapePicture
|
||||
|
||||
itemEquipPict :: Creature -> DTree CItem -> SPic
|
||||
itemEquipPict cr itmtree
|
||||
itemEquipPict :: IM.IntMap Item -> Creature -> DTree CItem -> SPic
|
||||
itemEquipPict m cr itmtree
|
||||
| Just i <- itm ^? itLocation . ilInvID
|
||||
, Just esite <- cr ^? crInv . ix i . itLocation . ilEquipSite . _Just
|
||||
, Just esite <- itm ^? itLocation . ilEquipSite . _Just
|
||||
, Just attachpos <- equipAttachPos <$> itm ^? itType . ibtEquip
|
||||
= equipPosition esite cr attachpos (itemSPic itm)
|
||||
= equipPosition esite m cr attachpos (itemSPic itm)
|
||||
| itm ^? itLocation . ilInvID == cr ^? crManipulation . manObject . imRootSelectedItem
|
||||
= overPosSP (Q.prePos $ handHandleOrient loc cr) (itemTreeSPic itmtree)
|
||||
| otherwise = mempty
|
||||
@@ -37,15 +38,15 @@ equipAttachPos = \case
|
||||
BULLETBELTBRACER -> V3 (-9) 0 10
|
||||
_ -> 0
|
||||
|
||||
equipPosition :: EquipSite -> Creature -> Point3 -> SPic -> SPic
|
||||
equipPosition epos cr p sh = case epos of
|
||||
OnLeftWrist -> translateToLeftWrist cr sh
|
||||
OnRightWrist -> translateToRightWrist cr sh
|
||||
equipPosition :: EquipSite -> IM.IntMap Item -> Creature -> Point3 -> SPic -> SPic
|
||||
equipPosition epos m cr p sh = case epos of
|
||||
OnLeftWrist -> translateToLeftWrist m cr sh
|
||||
OnRightWrist -> translateToRightWrist m cr sh
|
||||
OnLegs ->
|
||||
translateToLeftLeg cr sh
|
||||
<> translateToRightLeg cr sh-- (mirrorSPxz sh)
|
||||
OnHead -> translateToHead cr sh
|
||||
OnChest -> translateToChest cr sh
|
||||
OnHead -> translateToHead m cr sh
|
||||
OnChest -> translateToChest m cr sh
|
||||
--OnBack -> translateToBack cr p sh
|
||||
OnBack -> overPosSP (\x -> fst $ backPQ cr `Q.comp` (p + x,Q.qID)) sh
|
||||
OnSpecial -> sh
|
||||
OnBack -> overPosSP (\x -> fst $ backPQ m cr `Q.comp` (p + x,Q.qID)) sh
|
||||
-- OnSpecial -> sh
|
||||
|
||||
@@ -26,26 +26,18 @@ import Dodge.Data.World
|
||||
pointerYourSelectedItem :: Applicative a => (Item -> a Item) -> World -> a World
|
||||
pointerYourSelectedItem f w = fromMaybe (pure w) $ do
|
||||
itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem
|
||||
Just $ (cWorld . lWorld . creatures . ix 0 . crInv . ix itinvid) f w
|
||||
itid <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix itinvid
|
||||
Just $ (cWorld . lWorld . items . ix itid) f w
|
||||
-- note the ilIsRoot/Selected/Attached booleans are irrelevant
|
||||
|
||||
pointerYourRootItem :: Applicative a => (Item -> a Item) -> World -> a World
|
||||
pointerYourRootItem f w = fromMaybe (pure w) $ do
|
||||
itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imRootSelectedItem
|
||||
Just $ (cWorld . lWorld . creatures . ix 0 . crInv . ix itinvid) f w
|
||||
itid <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix itinvid
|
||||
Just $ (cWorld . lWorld . items . ix itid) f w
|
||||
|
||||
pointerToItem :: Applicative f => Item -> (Item -> f Item) -> World -> f World
|
||||
pointerToItem x = case x ^. itLocation of
|
||||
OnFloor -> cWorld . lWorld . items . ix (x ^. itID . unNInt)
|
||||
OnTurret _ -> cWorld . lWorld . items . ix (x ^. itID . unNInt)
|
||||
InInv cid invid _ _ _ _ -> cWorld . lWorld . creatures . ix cid . crInv . ix invid
|
||||
InVoid -> const pure
|
||||
pointerToItem x = cWorld . lWorld . items . ix (x ^. itID . unNInt)
|
||||
|
||||
pointerToItemID :: Applicative f => NewInt ItmInt -> (Item -> f Item) -> World -> f World
|
||||
pointerToItemID itid f w = fromMaybe (pure w) $ do
|
||||
itloc <- w ^? cWorld . lWorld . itemLocations . ix (_unNInt itid)
|
||||
return $ (\x -> x f w) $ case itloc of
|
||||
OnFloor -> cWorld . lWorld . items . ix (itid ^. unNInt)
|
||||
OnTurret _ -> cWorld . lWorld . items . ix (itid ^. unNInt)
|
||||
InInv cid invid _ _ _ _ -> cWorld . lWorld . creatures . ix cid . crInv . ix invid
|
||||
InVoid -> const pure
|
||||
pointerToItemID itid = cWorld . lWorld . items . ix (itid ^. unNInt)
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
module Dodge.Item.Location.Initialize
|
||||
( initSpecificCrItemLocations
|
||||
, initItemLocations
|
||||
( -- initSpecificCrItemLocations
|
||||
--, initItemLocations
|
||||
)
|
||||
where
|
||||
import NewInt
|
||||
@@ -9,68 +9,68 @@ import Control.Lens
|
||||
import qualified IntMapHelp as IM
|
||||
import Data.Traversable
|
||||
|
||||
initItemLocations :: LWorld -> LWorld
|
||||
--initItemLocations = initCrsItemLocations . initFlItemsLocations . initTusItemLocations
|
||||
initItemLocations = initCrsItemLocations -- . initTusItemLocations
|
||||
|
||||
initCrsItemLocations :: LWorld -> LWorld
|
||||
initCrsItemLocations w = w' & creatures .~ newcreatures
|
||||
where
|
||||
(w', newcreatures) = mapAccumR initCrItemLocations w (w ^. creatures)
|
||||
|
||||
--initFlItemsLocations :: LWorld -> LWorld
|
||||
--initFlItemsLocations w = w' & floorItems .~ newfloorItems
|
||||
--initItemLocations :: LWorld -> LWorld
|
||||
----initItemLocations = initCrsItemLocations . initFlItemsLocations . initTusItemLocations
|
||||
--initItemLocations = initCrsItemLocations -- . initTusItemLocations
|
||||
--
|
||||
--initCrsItemLocations :: LWorld -> LWorld
|
||||
--initCrsItemLocations w = w' & creatures .~ newcreatures
|
||||
-- where
|
||||
-- (w', newfloorItems) = mapAccumR initFlItemLocation w (w ^. floorItems)
|
||||
|
||||
--initTusItemLocations :: LWorld -> LWorld
|
||||
--initTusItemLocations w = w' & machines .~ newmachines
|
||||
-- (w', newcreatures) = mapAccumR initCrItemLocations w (w ^. creatures)
|
||||
--
|
||||
----initFlItemsLocations :: LWorld -> LWorld
|
||||
----initFlItemsLocations w = w' & floorItems .~ newfloorItems
|
||||
---- where
|
||||
---- (w', newfloorItems) = mapAccumR initFlItemLocation w (w ^. floorItems)
|
||||
--
|
||||
----initTusItemLocations :: LWorld -> LWorld
|
||||
----initTusItemLocations w = w' & machines .~ newmachines
|
||||
---- where
|
||||
---- (w', newmachines) = mapAccumR initTuItemLocation w (w ^. machines)
|
||||
--
|
||||
--initSpecificCrItemLocations :: Int -> LWorld -> LWorld
|
||||
--initSpecificCrItemLocations crid w = w' & creatures . ix crid .~ newcr
|
||||
-- where
|
||||
-- (w', newmachines) = mapAccumR initTuItemLocation w (w ^. machines)
|
||||
|
||||
initSpecificCrItemLocations :: Int -> LWorld -> LWorld
|
||||
initSpecificCrItemLocations crid w = w' & creatures . ix crid .~ newcr
|
||||
where
|
||||
(w',newcr) = initCrItemLocations w (w ^?! creatures . ix crid)
|
||||
|
||||
initCrItemLocations :: LWorld -> Creature -> (LWorld, Creature)
|
||||
initCrItemLocations w cr = (w', cr & crInv .~ newinv)
|
||||
where
|
||||
(w',newinv) = imapAccumR (initCrItemLocation cr) w (_crInv cr)
|
||||
|
||||
-- does not worry about creature manipulation for now
|
||||
initCrItemLocation :: Creature -> Int -> LWorld -> Item -> (LWorld,Item)
|
||||
initCrItemLocation cr invid w it = (w & itemLocations . at locid ?~ loc
|
||||
,it & itID .~ NInt locid
|
||||
& itLocation .~ loc)
|
||||
where
|
||||
locid = IM.newKey ( w ^. itemLocations)
|
||||
loc = InInv
|
||||
{ _ilCrID = _crID cr
|
||||
, _ilInvID = invid
|
||||
, _ilIsRoot = False
|
||||
, _ilIsSelected = False
|
||||
, _ilIsAttached = False
|
||||
, _ilEquipSite = Nothing
|
||||
}
|
||||
|
||||
|
||||
--initFlItemLocation :: LWorld -> FloorItem -> (LWorld, FloorItem)
|
||||
--initFlItemLocation w flit = (w & itemLocations . at locid ?~ loc
|
||||
-- , flit & flIt . itID .~ NInt locid
|
||||
-- & flIt . itLocation .~ loc
|
||||
-- )
|
||||
-- (w',newcr) = initCrItemLocations w (w ^?! creatures . ix crid)
|
||||
--
|
||||
--initCrItemLocations :: LWorld -> Creature -> (LWorld, Creature)
|
||||
--initCrItemLocations w cr = (w', cr & crInv .~ newinv)
|
||||
-- where
|
||||
-- locid = IM.newKey (w ^. itemLocations )
|
||||
-- loc = OnFloor (_flItID flit)
|
||||
|
||||
--initTuItemLocation :: LWorld -> Machine -> (LWorld, Machine)
|
||||
--initTuItemLocation w mc = case mc ^? mcType . _McTurret . tuWeapon of
|
||||
-- Nothing -> (w, mc)
|
||||
-- Just _ ->
|
||||
-- let locid = IM.newKey ( w ^. itemLocations)
|
||||
-- loc = OnTurret (_mcID mc)
|
||||
-- in ( w & itemLocations . at locid ?~ loc
|
||||
-- , mc & mcType . _McTurret . tuWeapon . itID .~ NInt locid
|
||||
-- & mcType . _McTurret . tuWeapon . itLocation .~ loc
|
||||
-- )
|
||||
-- (w',newinv) = imapAccumR (initCrItemLocation cr) w (_crInv cr)
|
||||
--
|
||||
---- does not worry about creature manipulation for now
|
||||
--initCrItemLocation :: Creature -> Int -> LWorld -> Int -> (LWorld,Item)
|
||||
--initCrItemLocation cr invid w itid = (w & itemLocations . at locid ?~ loc
|
||||
-- ,it & itID .~ NInt locid
|
||||
-- & itLocation .~ loc)
|
||||
-- where
|
||||
-- locid = IM.newKey ( w ^. itemLocations)
|
||||
-- loc = InInv
|
||||
-- { _ilCrID = _crID cr
|
||||
-- , _ilInvID = invid
|
||||
-- , _ilIsRoot = False
|
||||
-- , _ilIsSelected = False
|
||||
-- , _ilIsAttached = False
|
||||
-- , _ilEquipSite = Nothing
|
||||
-- }
|
||||
--
|
||||
--
|
||||
----initFlItemLocation :: LWorld -> FloorItem -> (LWorld, FloorItem)
|
||||
----initFlItemLocation w flit = (w & itemLocations . at locid ?~ loc
|
||||
---- , flit & flIt . itID .~ NInt locid
|
||||
---- & flIt . itLocation .~ loc
|
||||
---- )
|
||||
---- where
|
||||
---- locid = IM.newKey (w ^. itemLocations )
|
||||
---- loc = OnFloor (_flItID flit)
|
||||
--
|
||||
----initTuItemLocation :: LWorld -> Machine -> (LWorld, Machine)
|
||||
----initTuItemLocation w mc = case mc ^? mcType . _McTurret . tuWeapon of
|
||||
---- Nothing -> (w, mc)
|
||||
---- Just _ ->
|
||||
---- let locid = IM.newKey ( w ^. itemLocations)
|
||||
---- loc = OnTurret (_mcID mc)
|
||||
---- in ( w & itemLocations . at locid ?~ loc
|
||||
---- , mc & mcType . _McTurret . tuWeapon . itID .~ NInt locid
|
||||
---- & mcType . _McTurret . tuWeapon . itLocation .~ loc
|
||||
---- )
|
||||
|
||||
Reference in New Issue
Block a user