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

Cleanup, prepare ground to allow for drawing attached items

Browse Source
This commit is contained in:
justin
2024-09-30 15:09:21 +01:00
parent 18219d0bff
commit fd8adcea92
11 changed files with 245 additions and 273 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ghcidOutput
+15 -1
View File
@@ -1 +1,15 @@
All good (607 modules, at 14:27:18)
/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:9:1-39: warning: [-Wunused-imports]
The qualified import of ‘Linear.Quaternion’ is redundant
|
9 | import qualified Linear.Quaternion as Q
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:10:1-20: warning: [-Wunused-imports]
The import of ‘Geometry.Data’ is redundant
|
10 | import Geometry.Data
| ^^^^^^^^^^^^^^^^^^^^
/home/justin/Haskell/loop/src/Dodge/Data/ComposedItem.hs:13:1-43: warning: [-Wunused-imports]
The import of ‘Dodge.Data.Item.Use.Consumption.Ammo’ is redundant
|
13 | import Dodge.Data.Item.Use.Consumption.Ammo
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
saveSlot/LevelStart0
+1 -1
View File
File diff suppressed because one or more lines are too long
src/Dodge/Data/ComposedItem.hs
+23 -17
View File
@@ -1,28 +1,30 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.ComposedItem
where
module Dodge.Data.ComposedItem where
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Dodge.Data.Item.Use.Consumption.Ammo
-- it would be nice not to have to import the following...
import Dodge.Data.Item
import Dodge.Data.Item.Use.Consumption.Ammo
import Geometry.Data
import Linear.Quaternion (Quaternion (..))
data ComposeLinkType
data ComposeLinkType
= AmmoInLink Int AmmoType
| AmmoModLink
| AmmoTargetingLink
| AmmoPayloadLink
| AmmoEffectLink
| WeaponScopeLink
| WeaponTargetingLink
| WeaponScopeLink
| WeaponTargetingLink
| RemoteScreenLink
| AugmentedHUDLink
deriving (Eq,Ord,Show,Read)
deriving (Eq, Ord, Show, Read)
data ItemStructuralFunction
= WeaponPlatformSF
@@ -36,21 +38,25 @@ data ItemStructuralFunction
| AmmoTargetingSF AmmoType
| AmmoPayloadSF AmmoType
| AmmoEffectSF AmmoType
deriving (Eq,Ord,Show,Read)
deriving (Eq, Ord, Show, Read)
type PartiallyComposedItem = (Item, ItemStructuralFunction, LinkTest)
type PartiallyComposedItem lt = (Item, ItemStructuralFunction, LinkTest lt)
data LinkTest = LinkTest
{ _tryLeftLink :: PartiallyComposedItem -> Maybe LinkUpdate
, _tryRightLink :: PartiallyComposedItem -> Maybe LinkUpdate
data ItemAttachment = IAttach
{ _iatType :: ComposeLinkType
, _iatOrient :: Item -> Item -> Maybe (Point3, Quaternion Float)
}
data LinkUpdate = LinkUpdate
{ _luLinkType :: ComposeLinkType
, _luParentUpdate :: PartiallyComposedItem -> PartiallyComposedItem
, _luChildUpdate :: PartiallyComposedItem -> PartiallyComposedItem
data LinkTest lt = LTest
{ _tryLeftLink :: PartiallyComposedItem lt -> Maybe (LinkUpdate lt)
, _tryRightLink :: PartiallyComposedItem lt -> Maybe (LinkUpdate lt)
}
data LinkUpdate lt = LUpdate
{ _luLinkType :: lt
, _luParentUpdate :: PartiallyComposedItem lt -> PartiallyComposedItem lt
, _luChildUpdate :: PartiallyComposedItem lt -> PartiallyComposedItem lt
}
makeLenses ''LinkTest
makeLenses ''LinkUpdate
src/Dodge/Item/Draw.hs
+2 -1
View File
@@ -16,7 +16,8 @@ import Dodge.Item.Draw.SPic
import Dodge.Item.HeldOffset
import ShapePicture
itemEquipPict :: Creature -> LabelDoubleTree ComposeLinkType PartiallyComposedItem -> SPic
itemEquipPict :: Creature -> LabelDoubleTree ComposeLinkType (PartiallyComposedItem ComposeLinkType)
-> SPic
itemEquipPict cr itmtree = case itm ^. itUse of
UseHeld{} | itm ^? itLocation . ilIsRoot == Just True
-> overPosSP (heldItemOffset itm cr) (itemSPic itmtree)
src/Dodge/Item/Draw/SPic.hs
+1 -1
View File
@@ -26,7 +26,7 @@ import ShapePicture
-- hit <- itm ^? itType . iyBase . ibtHeld
-- return mempty
itemSPic :: LabelDoubleTree ComposeLinkType PartiallyComposedItem -> SPic
itemSPic :: LabelDoubleTree ComposeLinkType (PartiallyComposedItem ComposeLinkType) -> SPic
itemSPic itmtree = case it ^. itType of
CRAFT _ -> defSPic
HELD ht -> heldItemSPic ht it
src/Dodge/Item/Grammar.hs
+19 -25
View File
@@ -6,6 +6,8 @@ module Dodge.Item.Grammar (
invRootMap,
) where
import qualified Linear.Quaternion as Q
import Geometry.Data
import Control.Applicative
--import TreeHelp
@@ -18,21 +20,22 @@ import Dodge.Data.Item
import Dodge.DoubleTree
import ListHelp
useBreakListsLinkTest :: [(ItemStructuralFunction,ComposeLinkType)]
-> [(ItemStructuralFunction,ComposeLinkType)]
-> LinkTest
useBreakListsLinkTest llist rlist = LinkTest ltest rtest
useBreakListsLinkTest :: [(ItemStructuralFunction,a)]
-> [(ItemStructuralFunction,a)]
-> LinkTest a
useBreakListsLinkTest llist rlist = LTest ltest rtest
where
ltest (_,sf,_) = do
let xs = dropWhile ((/= sf) . fst) llist
(_,linktype) <- safeHead xs
return $ LinkUpdate linktype (set _3 (useBreakListsLinkTest (tail xs) rlist)) id
return $ LUpdate linktype (set _3 (useBreakListsLinkTest (tail xs) rlist)) id
rtest (_,sf,_) = do
let xs = dropWhile ((/= sf) . fst) rlist
(_,linktype) <- safeHead xs
return $ LinkUpdate linktype (set _3 (useBreakListsLinkTest llist (tail xs))) id
return $ LUpdate linktype (set _3 (useBreakListsLinkTest llist (tail xs))) id
basePartiallyComposedItem :: Item -> PartiallyComposedItem
basePartiallyComposedItem :: Item -> PartiallyComposedItem ComposeLinkType
basePartiallyComposedItem itm = case itm ^. itType of
HELD _ -> (itm, WeaponPlatformSF, useBreakListsLinkTest
(map (\(i,a) -> (AmmoMagSF a,AmmoInLink i a)) (IM.toList $ itm ^. itUse . heldAmmoTypes))
@@ -40,24 +43,24 @@ basePartiallyComposedItem itm = case itm ^. itType of
)
AMMOMAG _ -> ammoComposedItem itm
TARGETING {} -> (itm,WeaponTargetingSF, useBreakListsLinkTest [(AugmentedHUDSF,AugmentedHUDLink)] [])
ATTACH ZOOMSCOPE -> (itm,WeaponScopeSF, LinkTest (const Nothing) (const Nothing))
ATTACH HOMINGMODULE -> (itm,AmmoTargetingSF ProjectileAmmo, LinkTest (const Nothing) (const Nothing))
ATTACH ZOOMSCOPE -> (itm,WeaponScopeSF, LTest (const Nothing) (const Nothing))
ATTACH HOMINGMODULE -> (itm,AmmoTargetingSF ProjectileAmmo, LTest (const Nothing) (const Nothing))
ATTACH AUGMENTEDHUD -> nolinks AugmentedHUDSF
BULLETMOD BulletModTrajectory {} -> nolinks $ AmmoTargetingSF BulletAmmo
BULLETMOD BulletModPayload {} -> nolinks $ AmmoPayloadSF BulletAmmo
BULLETMOD BulletModEffect {} -> nolinks $ AmmoEffectSF BulletAmmo
ATTACH REMOTESCREEN -> nolinks RemoteScreenSF
ATTACH BULLETSYNTHESIZER -> (itm,AmmoModifierSF BulletAmmo, LinkTest (const Nothing) (const Nothing))
ATTACH BULLETSYNTHESIZER -> (itm,AmmoModifierSF BulletAmmo, LTest (const Nothing) (const Nothing))
LEFT {} -> isolate
EQUIP {} -> isolate
CONSUMABLE {} -> isolate
CRAFT {} -> isolate
-- _ ->
where
nolinks x = (itm,x, LinkTest (const Nothing) (const Nothing))
isolate = (itm,UncomposableIsolateSF, LinkTest (const Nothing) (const Nothing))
nolinks x = (itm,x, LTest (const Nothing) (const Nothing))
isolate = (itm,UncomposableIsolateSF, LTest (const Nothing) (const Nothing))
ammoComposedItem :: Item -> PartiallyComposedItem
ammoComposedItem :: Item -> PartiallyComposedItem ComposeLinkType
ammoComposedItem itm = fromMaybe (error "in ammoComposedItem, wrong item") $ do
atype <- itm ^? itUse . amagType
return (itm
@@ -74,13 +77,13 @@ ammoComposedItem itm = fromMaybe (error "in ammoComposedItem, wrong item") $ do
type LDTComb a b = LabelDoubleTree b a -> LabelDoubleTree b a -> Maybe (LabelDoubleTree b a)
leftIsParentCombine :: LDTComb PartiallyComposedItem ComposeLinkType
leftIsParentCombine :: LDTComb (PartiallyComposedItem a) a
leftIsParentCombine ltree rtree = do
lu <- (ltree ^. ldtValue . _3 . tryRightLink) (rtree ^. ldtValue)
return $ ltree & ldtValue %~ (lu ^. luParentUpdate)
& ldtRight %~ (++ [(lu ^. luLinkType, rtree & ldtValue %~ (lu ^. luChildUpdate))])
rightIsParentCombine :: LDTComb PartiallyComposedItem ComposeLinkType
rightIsParentCombine :: LDTComb (PartiallyComposedItem a) a
rightIsParentCombine ltree rtree = do
lu <- (rtree ^. ldtValue . _3 . tryLeftLink) (ltree ^. ldtValue)
return $ rtree & ldtValue %~ (lu ^. luParentUpdate)
@@ -111,20 +114,11 @@ joinItemsInList f xs = snd $ h (xs, [])
Nothing -> h (ys, y : z : zs)
Just w -> h (w : ys, zs)
invLDT :: IM.IntMap Item -> [LabelDoubleTree ComposeLinkType PartiallyComposedItem]
invLDT :: IM.IntMap Item -> [LabelDoubleTree ComposeLinkType (PartiallyComposedItem ComposeLinkType)]
invLDT =
joinItemsInList (leftRightCombine leftIsParentCombine rightIsParentCombine) . IM.elems
. fmap (singleLDT . basePartiallyComposedItem)
-- this has provoked an error: hopefully it will crop up at some point and get
-- debugged with suitable info
--invAdj :: IM.IntMap Item -> IM.IntMap (Maybe (Int,Int),[Int],[Int])
--invAdj = IM.unions . fmap (dtToLRAdj getid . ldtToDT) . invLDT
-- where
-- getid (itm, _,_,_) = fromMaybe
-- (error ("invAdj item " ++ show (_itID itm) ++ " location:" ++ show (itm ^? itLocation . ilInvID)) )
-- $ itm ^? itLocation . ilInvID
-- this assumes the creature inventory is well formed, specifically the
-- location ids
-- consider explicitly reseting the inventory ids (but this probably really
src/Dodge/Machine/Draw.hs
+1 -1
View File
@@ -63,7 +63,7 @@ drawTurret :: Turret -> Machine -> SPic
drawTurret tu mc = overPosSP (turretItemOffset itm tu mc) (itemSPic ittree)
where
itm = _tuWeapon tu
ittree = singleLDT (itm,UncomposableIsolateSF,LinkTest (const Nothing) (const Nothing))
ittree = singleLDT (itm,UncomposableIsolateSF,LTest (const Nothing) (const Nothing))
sensorSPic :: (PaletteColor, DecorationShape) -> Machine -> SPic
sensorSPic (pc, ds) mc =
src/Dodge/Render/HUD.hs
-1
View File
@@ -1,4 +1,3 @@
--{-# LANGUAGE TupleSections #-}
module Dodge.Render.HUD (
drawHUD,
) where
src/Dodge/Render/ShapePicture.hs
+1 -1
View File
@@ -164,7 +164,7 @@ floorItemSPic :: FloorItem -> SPic
floorItemSPic flit =
uncurryV translateSPxy (_flItPos flit) $
rotateSP (_flItRot flit)
(itemSPic $ singleLDT ((_flIt flit),UncomposableIsolateSF,LinkTest (const Nothing) (const Nothing)))
(itemSPic $ singleLDT ((_flIt flit),UncomposableIsolateSF,LTest (const Nothing) (const Nothing)))
btSPic :: Button -> SPic
btSPic bt =
src/Dodge/Tweak.hs
-25
View File
@@ -1,25 +0,0 @@
module Dodge.Tweak () where
import Control.Lens
import Dodge.Data.Item
--doTweak :: TweakType -> Int -> Item -> Item
--doTweak tt = case tt of
-- TweakPhaseV -> tweakPhaseV
-- TweakTractionPower -> tweakTractionPower
-- TweakSpinDrag -> \i -> itParams . shellSpinDrag .~ i
-- TweakSpinAmount -> \i -> itParams . shellSpinAmount .~ i
-- TweakThrustDelay -> \i -> itParams . shellThrustDelay .~ i
tweakTractionPower :: Int -> Item -> Item
tweakTractionPower 0 = itParams . attractionPower .~ 1
tweakTractionPower 1 = itParams . attractionPower .~ -1
tweakTractionPower 2 = itParams . attractionPower .~ -10
tweakTractionPower 3 = itParams . attractionPower .~ 0
tweakTractionPower _ = id
tweakPhaseV :: Int -> Item -> Item
tweakPhaseV 0 = itParams . phaseV .~ 0.2
tweakPhaseV 1 = itParams . phaseV .~ 1
tweakPhaseV 2 = itParams . phaseV .~ 5
tweakPhaseV _ = id
tags
+182 -199
View File
File diff suppressed because it is too large Load Diff