Cleanup
This commit is contained in:
+16
-29
@@ -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))
|
||||
|
||||
@@ -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
|
||||
---- )
|
||||
Reference in New Issue
Block a user