This commit is contained in:
2025-08-27 18:55:25 +01:00
parent 86696deb56
commit 40d2d316cb
35 changed files with 316 additions and 431 deletions
+16 -29
View File
@@ -1,29 +1,26 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Item.Draw (
itemSPic,
itemEquipPict,
) where
import qualified Quaternion as Q
import Dodge.Data.Equipment.Misc
import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree
import Geometry.Data
module Dodge.Item.Draw (itemEquipPict) where
import Control.Lens
import Dodge.Creature.HandPos
import Dodge.Data.ComposedItem
import Dodge.Data.Creature
import Dodge.Data.DoubleTree
import Dodge.Data.Equipment.Misc
import Dodge.Item.Draw.SPic
import Dodge.Item.HeldOffset
import Geometry.Data
import qualified Quaternion as Q
import ShapePicture
itemEquipPict :: Creature -> DTree CItem -> SPic
itemEquipPict cr itmtree
| --Just i <- itm ^? itLocation . ilInvID
Just esite <- itm ^? itLocation . ilEquipSite . _Just
, Just attachpos <- equipAttachPos <$> itm ^? itType . ibtEquip
= equipPosition esite cr attachpos (itemSPic itm)
| itm ^? itLocation . ilInvID == cr ^? crManipulation . manObject . imRootSelectedItem
= overPosSP (Q.prePos $ handHandleOrient loc cr) (itemTreeSPic itmtree)
| Just esite <- itm ^? itLocation . ilEquipSite . _Just
, Just attachpos <- equipAttachPos <$> itm ^? itType . ibtEquip =
equipPosition esite cr attachpos (itemSPic itm)
| itm ^? itLocation . ilInvID == cr ^? crManipulation . manObject . imRootSelectedItem =
overPosSP (Q.prePos $ handHandleOrient loc cr) (itemTreeSPic itmtree)
| otherwise = mempty
where
itm = itmtree ^. dtValue . _1
@@ -31,23 +28,13 @@ itemEquipPict cr itmtree
equipAttachPos :: EquipItemType -> Point3Q
equipAttachPos = \case
BATTERYPACK -> (V3 (-8) 0 10, Q.qID)
BATTERYPACK -> (V3 (-8) 0 10, Q.qID)
FUELPACK -> (V3 (-9) 0 10, Q.qID)
BULLETBELTPACK -> (V3 (-9) 0 10, Q.qID)
BULLETBELTBRACER -> (V3 (-9) 0 10, Q.qID)
_ -> (0, Q.qID)
equipPosition :: EquipSite -> Creature -> Point3Q -> SPic -> SPic
equipPosition es cr q = overPosSP
(\x -> fst $ equipSitePQ es cr `Q.comp` q `Q.comp` (x,Q.qID))
-- case epos of
-- --OnLeftWrist -> translateToLeftWrist cr
-- --OnRightWrist -> translateToRightWrist cr
-- OnLeftWrist -> overPosSP (translateToES cr OnLeftWrist)
-- OnRightWrist -> overPosSP (translateToES cr OnRightWrist)
-- OnLegs ->
-- translateToLeftLeg cr
-- <> translateToRightLeg cr-- (mirrorSPxz sh)
-- OnHead -> overPosSP (translateToES cr OnHead)
-- OnChest -> overPosSP (translateToES cr OnChest)
-- OnBack -> overPosSP (\x -> fst $ backPQ cr `Q.comp` (p + x,Q.qID))
equipPosition es cr q =
overPosSP
(\x -> fst $ equipSitePQ es cr `Q.comp` q `Q.comp` (x, Q.qID))
-76
View File
@@ -1,76 +0,0 @@
module Dodge.Item.Location.Initialize
( -- initSpecificCrItemLocations
--, initItemLocations
)
where
--import NewInt
--import Dodge.Data.LWorld
--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
---- 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',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 -> 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
---- )