Return to project, unsure about changes

This commit is contained in:
2024-05-25 13:10:50 +01:00
parent 08716e8ade
commit c862c862df
63 changed files with 1137641 additions and 52 deletions
+9 -2
View File
@@ -4,8 +4,10 @@ import TreeHelp
import Dodge.Data.World
import Dodge.HeldScroll
import qualified IntMapHelp as IM
import qualified Data.Map.Strict as M
import Control.Lens
import Control.Monad
import Data.Maybe
you :: World -> Creature
you w = w ^?! cWorld . lWorld . creatures . ix 0
@@ -35,8 +37,13 @@ yourScopeInvID w = do
yourInv :: World -> IM.IntMap Item
yourInv = _crInv . you
attachmentTree :: Creature -> [Tree Int]
attachmentTree cr = []
attachmentTree :: Creature -> M.Map AttachType Int
attachmentTree cr = fromMaybe mempty $ do
i <- cr ^? crManipulation . manObject . inInventory . ispItem
return $ upDownAttachments cr i i mempty
upDownAttachments :: Creature -> Int -> Int -> M.Map AttachType Int -> M.Map AttachType Int
upDownAttachments cr i j s = s
--yourInvSel :: World -> Int
--yourInvSel = crSel . you
+1 -1
View File
@@ -166,7 +166,7 @@ moduleCombinations =
, homingLaunchers ++ bulletWeapons
,
[ amod [cr MICROCHIP, cr HEATSENSOR] (TARGET TargetRBCreature)
, amod [cr MICROCHIP, cr LIGHTSENSOR] (TARGET TargetLaser)
, amod [cr MICROCHIP, cr LIGHTSENSOR] (TARGET TARGETLASER)
, amod [cr MICROCHIP, cr SOUNDSENSOR] (TARGET TargetRBPress)
]
)
+2
View File
@@ -22,6 +22,7 @@ module Dodge.Creature (
module Dodge.Creature.YourControl,
) where
import Dodge.Item.Scope
import Control.Lens
import Dodge.Creature.Action
import Dodge.Creature.ArmourChase
@@ -215,6 +216,7 @@ inventoryX c = case c of
]
'L' -> [scrollWatch]
'M' -> stackedInventory
'N' -> [zoomScope,targetingScope TARGETLASER, sniperRifle]
'T' -> testInventory
_ -> []
+8 -3
View File
@@ -278,10 +278,15 @@ crGetTargeting :: Creature -> Maybe TargetType
crGetTargeting cr = do
i <- cr ^? crManipulation . manObject . inInventory . ispItem
itm <- cr ^? crInv . ix i
--(cr ^? crInv . ix (i+1) . itUse . equipTargeting . _Just)
itm ^? itType . iyModules . ix ModTarget . imtTargetType
<|> (guard (canAttachTargetingBelow itm)
>> cr ^? crInv . ix (i+1) . itUse . equipTargeting . _Just)
<|> do
tt <- cr ^? crInv . ix (i-1) . itType . iyBase . ibtAttach . ibtAttachTarget
guard (canAttachTargeting tt itm)
return tt
<|> do
tt <- cr ^? crInv . ix (i+1) . itUse . equipTargeting . _Just
guard (canAttachTargeting tt itm)
return tt
weaponReloadSounds :: Creature -> World -> World
weaponReloadSounds cr w = case cr ^? crManipulation . manObject . inInventory . iselAction of
+5 -1
View File
@@ -89,7 +89,7 @@ data ItemBaseType
| EQUIP {_ibtEquip :: EquipItemType}
| CONSUMABLE {_ibtConsumable :: ConsumableItemType}
| CRAFT CraftType
| ATTACH AttachType
| ATTACH {_ibtAttach :: AttachType}
deriving (Eq, Ord, Show, Read)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
@@ -97,6 +97,9 @@ data ItemBaseType
data AttachType
= SCROLLATTACH ScrollAttachType
| AMMOATTACH AmmoAttachType
| TARGETATTACH {_ibtAttachTarget :: TargetType}
| BULPAYLOADATTACH
| BULTRAJECTORYATTACH
deriving (Eq, Ord, Show, Read)
data ScrollAttachType
@@ -239,6 +242,7 @@ makeLenses ''ItemType
makeLenses ''ItemBaseType
makeLenses ''HeldItemType
makeLenses ''ItemModuleType
makeLenses ''AttachType
deriveJSON defaultOptions ''Stack
deriveJSON defaultOptions ''CraftType
deriveJSON defaultOptions ''ConsumableItemType
+1 -1
View File
@@ -9,7 +9,7 @@ import Data.Aeson
import Data.Aeson.TH
data TargetType
= TargetLaser
= TARGETLASER
| TargetRBPress
| TargetRBLine
| TargetRBCreature
+1
View File
@@ -59,6 +59,7 @@ data ItemUse
data AttachParams
= ScrollAttachParams {_scrollAttachParams :: ScrollAttachParams}
| AmmoAttachParams
| TargetAttachParams
data ScrollAttachParams
= ZoomScrollParams
+1 -1
View File
@@ -63,7 +63,7 @@ parseItem (x : xs) =
<|> (readMaybe ("EQUIP {_ibtEquip=" ++ x ++ "}") <&> (,parseNum xs))
<|> (readMaybe ("LEFT {_ibtLEFT=" ++ x ++ "}") <&> (,parseNum xs))
<|> (readMaybe ("HELD (" ++ x ++ " {_xNum=" ++ show (parseNum xs) ++ "}") <&> (,1))
<|> (readMaybe ("ATTACH " ++ x) <&> (,parseNum xs))
<|> (readMaybe ("ATTACH (" ++ x ++ ")") <&> (,parseNum xs))
<|> (readMaybe ("CONSUMABLE {_ibtConsumable=" ++ x ++ "}") <&> (,parseNum xs))
<|> (readMaybe ("AMMO {_ibtAmmo=" ++ x ++ "}") <&> (,parseNum xs))
<|> parseItem (xs & ix 0 .++~ (x ++ " "))
+2
View File
@@ -14,6 +14,7 @@ import Dodge.Item.Craftable
import Dodge.Item.Equipment
import Dodge.Item.Held
import Dodge.Item.Weapon
import Dodge.Item.Scope
itemFromBase :: ItemBaseType -> Item
itemFromBase ibt = case ibt of
@@ -30,6 +31,7 @@ itemFromAttachType at = case at of
AMMOATTACH DRUMMAG -> drumMag
AMMOATTACH TINMAG -> tinMag
AMMOATTACH BULLETBELT -> beltMag
TARGETATTACH tt -> targetingScope tt
itemFromConsumableType :: ConsumableItemType -> Item
-5
View File
@@ -14,8 +14,3 @@ drumMag = tinMag & itType . iyBase .~ ATTACH (AMMOATTACH DRUMMAG)
beltMag :: Item
beltMag = tinMag & itType . iyBase .~ ATTACH (AMMOATTACH BULLETBELT)
zoomScope :: Item
zoomScope = tinMag
& itType . iyBase .~ ATTACH (SCROLLATTACH ZOOMSCOPE)
& itUse .~ AttachUse (ScrollAttachParams (ZoomScrollParams {_opticPos = 0, _opticZoom = 1, _opticDefaultZoom = 0.5}))
+19 -24
View File
@@ -1,7 +1,7 @@
module Dodge.Item.Display (
--itemDisplay,
itemDisplayOffset,
canAttachTargetingBelow,
canAttachTargeting,
-- selectedItemDisplay,
itemString,
itemBaseName,
@@ -20,34 +20,29 @@ import Padding
itemDisplayOffset :: Creature -> Item -> (Int, [String])
itemDisplayOffset cr itm = case itm ^. itType . iyBase of
EQUIP (TARGETINGHAT tt)
| targetItemCanAttachAbove cr itm ->
( -1
, leftPad 15 ' ' (targetingTypeString tt) :
(itemDisplay cr itm & ix 0 %~ (\s -> itemDisplayPad s (replicate (length (targetingTypeString tt)) '^')))
)
EQUIP (TARGETINGHAT tt) ->
(0, itemDisplay cr itm & ix 0 %~ (\s -> itemDisplayPad s (targetingTypeString tt)))
-- EQUIP (TARGETINGHAT tt)
-- | targetItemCanAttachAbove cr itm ->
-- ( -1
-- , leftPad 15 ' ' (targetingTypeString tt) :
-- (itemDisplay cr itm & ix 0 %~ (\s -> itemDisplayPad s (replicate (length (targetingTypeString tt)) '^')))
-- )
-- EQUIP (TARGETINGHAT tt) ->
-- (0, itemDisplay cr itm & ix 0 %~ (\s -> itemDisplayPad s (targetingTypeString tt)))
_ -> (0, itemDisplay cr itm)
targetItemCanAttachAbove :: Creature -> Item -> Bool
targetItemCanAttachAbove cr itm = fromMaybe False $ do
i <- itm ^? itLocation . ipInvID
itm' <- cr ^? crInv . ix (i - 1)
return $ canAttachTargetingBelow itm'
canAttachTargetingBelow :: Item -> Bool
canAttachTargetingBelow itm =
canAttachTargeting :: TargetType -> Item -> Bool
canAttachTargeting TARGETLASER _ = True
canAttachTargeting _ itm =
isJust (itm ^? itType . iyModules . ix ModBulletTrajectory . imtBulletTrajectoryType)
|| Just LAUNCHHOME == (itm ^? itType . iyModules . ix ModLauncherHoming)
targetingTypeString :: TargetType -> String
targetingTypeString tt = case tt of
TargetLaser -> "LASER"
TargetRBPress -> "POS"
TargetRBLine -> ""
TargetRBCreature -> "LIFEFORM"
TargetCursor -> "CURSOR"
--targetingTypeString :: TargetType -> String
--targetingTypeString tt = case tt of
-- TARGETLASER -> "LASER"
-- TargetRBPress -> "POS"
-- TargetRBLine -> ""
-- TargetRBCreature -> "LIFEFORM"
-- TargetCursor -> "CURSOR"
itemDisplay :: Creature -> Item -> [String]
itemDisplay cr itm =
-3
View File
@@ -68,9 +68,6 @@ sniperRifle =
& itType . iyBase .~ HELD SNIPERRIFLE
& itUse . heldAim . aimMuzzles . ix 0 . mzInaccuracy .~ 0
& itUse . heldAim . aimZoom .~ defaultItZoom{_izMax = 0.5, _izMin = 0.5,_izFac = 1}
-- & itUse . heldScroll .~ HeldScrollZoom -- zoomLongGun
-- & itType . iyModules . at ModTarget ?~ TARGET TargetLaser
-- & itUse . useTargeting ?~ TargetLaser
machineGun :: Item
machineGun =
+1 -1
View File
@@ -142,7 +142,7 @@ equipInfo eit = case eit of
targetingInfo :: TargetType -> String
targetingInfo tt = case tt of
TargetLaser -> "creates a laser, the end of which becomes the target."
TARGETLASER -> "creates a laser, the end of which becomes the target."
TargetRBPress -> "creates a fixed target."
TargetRBLine -> "creates a line target."
TargetRBCreature -> "targets a creature."
+20
View File
@@ -0,0 +1,20 @@
module Dodge.Item.Scope (
zoomScope,
targetingScope,
) where
import Control.Lens
import Dodge.Data.Item
import Dodge.Default.Item
zoomScope :: Item
zoomScope =
defaultHeldItem
& itType . iyBase .~ ATTACH (SCROLLATTACH ZOOMSCOPE)
& itUse .~ AttachUse (ScrollAttachParams (ZoomScrollParams{_opticPos = 0, _opticZoom = 1, _opticDefaultZoom = 0.5}))
targetingScope :: TargetType -> Item
targetingScope tt =
defaultHeldItem
& itType . iyBase .~ ATTACH (TARGETATTACH tt)
& itUse .~ AttachUse TargetAttachParams
+1 -1
View File
@@ -28,7 +28,7 @@ moduleName imt = case imt of
BULBODY thebody -> Just $ "+" ++ displayBulletBody thebody
BULTRAJ thetraj -> Just $ "+" ++ displayBulletTraj thetraj
TARGET TargetRBCreature -> Just "+CREATURETARGETING"
TARGET TargetLaser -> Just "+LASERTARGETING"
TARGET TARGETLASER -> Just "+LASERTARGETING"
TARGET TargetRBPress -> Just "+POSTIONALTARGETING"
TARGET TargetCursor -> Just "+CURSORTARGETING"
TARGET TargetRBLine -> Just "+LINETARGETING"
+1 -1
View File
@@ -17,7 +17,7 @@ tankSquareDec ::
Color ->
Color ->
Placement
tankSquareDec dec = tankShape (square 20) (dec 20 20 31)
tankSquareDec dec = tankShape (reverse $ square 20) (dec 20 20 31)
tankShape :: [Point2] -> (Color -> Color -> Shape) -> Color -> Color -> Placement
tankShape baseshape facade col col' = sps0 $ decoratedBlock (BlShConst $ facade col col') Metal col 31 baseshape
+2 -2
View File
@@ -19,7 +19,7 @@ import qualified SDL
updateTargeting :: Maybe TargetType -> Creature -> World -> World
updateTargeting tu = case tu of
Nothing -> clearTargeting
Just TargetLaser -> targetLaserUpdate'
Just TARGETLASER -> targetLaserUpdate'
Just TargetRBPress -> upCT (flip targetRBPressUpdate . _crTargeting)
Just TargetRBLine -> upCT (flip targetRBPressUpdate . _crTargeting)
Just TargetRBCreature -> upCT targetRBCreatureUp
@@ -90,7 +90,7 @@ targetLaserUpdate cr w t
, t
& ctPos .~ fmap fst mp
& ctActive .~ True
& ctType ?~ TargetLaser
& ctType ?~ TARGETLASER
)
| otherwise =
( w
+1 -1
View File
@@ -15,7 +15,7 @@ drawTargeting :: TargetType -> Creature -> Configuration -> World -> Picture
drawTargeting td = case td of
TargetRBCreature -> targetRBCreatureDraw
TargetRBLine -> targetDistanceDraw
TargetLaser -> targetSimpleDraw
TARGETLASER -> targetSimpleDraw
TargetRBPress -> targetSimpleDraw
TargetCursor -> targetSimpleDraw
+6 -5
View File
@@ -19,11 +19,12 @@ import Dodge.Data.Universe
--import qualified Data.Map.Strict as M
--import qualified IntMapHelp as IM
testStringInit :: Universe -> [String]
testStringInit u = [fromMaybe "" $ do
cr <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0
i <- cr ^? crManipulation . manObject . inInventory . ispItem
fmap (show . canAttachTargetingBelow) (cr ^? crInv . ix i)
]
testStringInit _ = []
-- [fromMaybe "" $ do
-- cr <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0
-- i <- cr ^? crManipulation . manObject . inInventory . ispItem
-- fmap (show . canAttachTargeting) (cr ^? crInv . ix i)
-- ]
-- getPrettyShort (u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crHotkeys)