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

Commit before moving to external weapon magazines

Browse Source
This commit is contained in:
justin
2023-05-30 11:07:30 +01:00
parent 02c34f99f1
commit b8f03f7d8c
5 changed files with 74 additions and 53 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/Item/Combine.hs
+28 -20
View File
@@ -1,38 +1,38 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Item.Combine where
import Dodge.Data.Item.Targeting
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import qualified Data.Map.Strict as M
import Dodge.Data.Equipment.Misc
import Dodge.Data.Item.Targeting
import Dodge.Data.Item.Use.Consumption
data ItemType = ItemType
{ _iyBase :: ItemBaseType
, _iyModules :: M.Map ModuleSlot ItemModuleType
}
deriving (Eq,Ord,Show,Read)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
deriving (Eq, Ord, Show, Read)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data Stack = NoStack | Stack ItAmount
deriving (Eq,Ord,Show,Read)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
deriving (Eq, Ord, Show, Read)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data CraftType
= PIPE
| TUBE
| HARDWARE
| SPRING
| HOSE
| TAPE
| CAN
| TIN
| STEELDRUM
@@ -78,26 +78,29 @@ data CraftType
| TIMEMODULE
| SIZEMODULE
| GRAVITYMODULE
| TARGETMODULE TargetType
deriving (Eq,Ord,Show,Read)
--deriving (Eq, Ord, Show, Enum, Read) --Generic, Flat)
deriving (Eq, Ord, Show, Read)
--deriving (Eq, Ord, Show, Enum, Read) --Generic, Flat)
data ItemBaseType
= NoItemType
| HELD {_ibtHeld :: HeldItemType}
| LEFT {_ibtLeft :: LeftItemType}
| EQUIP {_ibtEquip :: EquipItemType}
| AMMO {_ibtAmmo :: AmmoItemType}
| Consumable {_ibtConsumable :: ConsumableItemType}
| CRAFT CraftType
deriving (Eq,Ord,Show,Read)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
deriving (Eq, Ord, Show, Read)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data ConsumableItemType
= MEDKIT Int
| EXPLOSIVES
deriving (Eq,Ord,Show,Read)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
deriving (Eq, Ord, Show, Read)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data EquipItemType
= MAGSHIELD
@@ -112,16 +115,15 @@ data EquipItemType
| POWERLEGS
| SPEEDLEGS
| JUMPLEGS
| JETPACK
| FUELPACK
| BULLETBELTPACK
| BULLETBELTBRACER
| BATTERYPACK
| AUTODETECTOR Detector
deriving (Eq,Ord,Show,Read)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
deriving (Eq, Ord, Show, Read)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data LeftItemType
= BOOSTER
@@ -183,6 +185,11 @@ data HeldItemType
| KEYCARD Int
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data AmmoItemType
= TINMAGAZINE
| DRUMMAGAZINE
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data ItemModuleType
= EMPTYMODULE
| DRUMMAG
@@ -232,11 +239,12 @@ deriveJSON defaultOptions ''Detector
deriveJSON defaultOptions ''EquipItemType
deriveJSON defaultOptions ''LeftItemType
deriveJSON defaultOptions ''HeldItemType
deriveJSON defaultOptions ''AmmoItemType
deriveJSON defaultOptions ''ItemModuleType
deriveJSON defaultOptions ''ModuleSlot
deriveJSON defaultOptions ''ItemBaseType
deriveJSON defaultOptions ''ItemType
instance ToJSONKey ModuleSlot
instance FromJSONKey ModuleSlot
src/Dodge/Data/Item/Use/Consumption.hs
+11 -10
View File
@@ -1,7 +1,7 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
@@ -26,18 +26,18 @@ data HeldConsumption
| NoConsumption
deriving (Eq, Show, Read) --Generic, Flat)
data AmmoSource
data AmmoSource
= InternalSource InternalAmmo
| AboveSource
deriving (Eq, Show, Read) --Generic, Flat)
data InternalAmmo = InternalAmmo
{ _iaMax :: Int
, _iaLoaded :: Int
, _iaPrimed :: Bool
, _iaCycle :: [LoadAction]
, _iaProgress :: Maybe [LoadAction]
}
{ _iaMax :: Int
, _iaLoaded :: Int
, _iaPrimed :: Bool
, _iaCycle :: [LoadAction]
, _iaProgress :: Maybe [LoadAction]
}
deriving (Eq, Show, Read) --Generic, Flat)
data LeftConsumption
@@ -54,8 +54,9 @@ data LeftConsumption
deriving (Eq, Show, Read) --Generic, Flat)
newtype ItAmount = ItAmount {_getItAmount :: Int}
-- deriving (Eq, Ord, Read Show, Num, Real,) --Generic, Flat)
-- deriving (Eq, Ord, Read Show, Num, Real,) --Generic, Flat)
deriving newtype (Eq, Ord, Read, Show, Num, Real, Enum, Integral)
-- deriving stock (Generic)
-- deriving anyclass (Flat)
src/Dodge/Item.hs
+7
View File
@@ -7,6 +7,7 @@ module Dodge.Item (
itemFromBase,
) where
import Dodge.Item.Ammo
import Dodge.Data.Item
import Dodge.Item.Consumable
import Dodge.Item.Craftable
@@ -20,9 +21,15 @@ itemFromBase ibt = case ibt of
HELD ht -> itemFromHeldType ht
LEFT lt -> itemFromLeftType lt
EQUIP et -> itemFromEquipType et
AMMO at -> itemFromAmmoType at
Consumable et -> itemFromConsumableType et
CRAFT cr -> makeTypeCraft cr
itemFromAmmoType :: AmmoItemType -> Item
itemFromAmmoType at = case at of
TINMAGAZINE -> tinMagazine
DRUMMAGAZINE -> drumMagazine
itemFromConsumableType :: ConsumableItemType -> Item
itemFromConsumableType ct = case ct of
MEDKIT i -> medkit i
src/Dodge/Item/Display.hs
+27 -23
View File
@@ -2,7 +2,7 @@ module Dodge.Item.Display (
--itemDisplay,
itemDisplayOffset,
canAttachTargetingBelow,
-- selectedItemDisplay,
-- selectedItemDisplay,
itemString,
itemBaseName,
basicItemDisplay,
@@ -10,21 +10,24 @@ module Dodge.Item.Display (
import Control.Applicative
import Control.Monad
import Dodge.Item.Info
import Data.Maybe
import Dodge.Data.Creature
import Dodge.Item.Info
import Dodge.Item.SlotsTaken
import Dodge.Module
import LensHelp
import Padding
itemDisplayOffset :: Creature -> Item -> (Int,[String])
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
@@ -34,7 +37,7 @@ targetItemCanAttachAbove cr itm = fromMaybe False $ do
return $ canAttachTargetingBelow itm'
canAttachTargetingBelow :: Item -> Bool
canAttachTargetingBelow itm =
canAttachTargetingBelow itm =
isJust (itm ^? itType . iyModules . ix ModBulletTrajectory . imtBulletTrajectoryType)
|| Just LAUNCHHOME == (itm ^? itType . iyModules . ix ModLauncherHoming)
@@ -45,11 +48,10 @@ targetingTypeString tt = case tt of
TargetRBLine -> ""
TargetRBCreature -> "LIFEFORM"
TargetCursor -> "CURSOR"
itemDisplay :: Creature -> Item -> [String]
itemDisplay cr itm = --itemDisplayWithNumber (showConsumption cr it) it
itemDisplay cr itm =
--itemDisplayWithNumber (showConsumption cr it) it
zipWithDefaults id (leftPad 15 ' ') itemDisplayPad (basicItemDisplay itm) (itemNumberDisplay cr itm)
zipWithDefaults :: (a -> c) -> (b -> c) -> (a -> b -> c) -> [a] -> [b] -> [c]
@@ -57,18 +59,17 @@ zipWithDefaults f g h = go
where
go [] bs = map g bs
go as [] = map f as
go (a:as) (b:bs) = h a b : go as bs
go (a : as) (b : bs) = h a b : go as bs
itemDisplayPad :: [Char] -> String -> [Char]
itemDisplayPad ls rs
| rs == "" = ls
| otherwise = midPadL 15 ' ' ls (' ':rs)
| otherwise = midPadL 15 ' ' ls (' ' : rs)
basicItemDisplay :: Item -> [String]
basicItemDisplay itm =
Prelude.take (itSlotsTaken itm) $
itemBaseName itm :
itemBaseName itm :
catMaybes [maybeWarmupStatus itm, maybeRateStatus itm]
++ moduleStrings itm
++ repeat "*"
@@ -85,6 +86,7 @@ itemBaseName it = case _iyBase $ _itType it of
Nothing -> show hit
LEFT lit -> show lit
EQUIP eit -> showEquipItem eit
AMMO ait -> show ait
Consumable cit -> show cit
showEquipItem :: EquipItemType -> String
@@ -125,8 +127,8 @@ itemNumberDisplay cr itm = case iu of
showEquipmentNumber :: Creature -> Item -> [String]
showEquipmentNumber cr itm = case _eeUse ee of
EFuelSource x _ -> [show x]
EAmmoSource {} -> showAmmoSource cr itm
EBatterySource {_euseBatteryAmount = x} -> [show x]
EAmmoSource{} -> showAmmoSource cr itm
EBatterySource{_euseBatteryAmount = x} -> [show x]
_ -> [""]
where
ee = itm ^?! itUse . equipEffect
@@ -137,11 +139,13 @@ showAmmoSource cr itm = fromMaybe ["FAIL"] $ do
atype <- eu ^? euseAmmoSourceType
x <- fmap showIntKMG' $ eu ^? euseAmmoAmount
i <- itm ^? itLocation . ipInvID
(do
at' <- cr ^? crInv . ix (i + 1) . itUse . heldConsumption . laSourceType
as <- cr ^? crInv . ix (i + 1) . itUse . heldConsumption . laSource
guard (at' == atype && as == AboveSource)
return ["vvvv",x] ) <|> Just [x]
( do
at' <- cr ^? crInv . ix (i + 1) . itUse . heldConsumption . laSourceType
as <- cr ^? crInv . ix (i + 1) . itUse . heldConsumption . laSource
guard (at' == atype && as == AboveSource)
return ["vvvv", x]
)
<|> Just [x]
showReloadProgress :: Creature -> Item -> String
showReloadProgress cr itm = case ic ^? laSource of
src/Dodge/Item/Draw/SPic.hs
+1
View File
@@ -23,6 +23,7 @@ itemSPic it =
HELD ht -> heldItemSPic ht it
LEFT lt -> leftItemSPic lt it
EQUIP et -> equipItemSPic et it
AMMO {} -> defSPic
Consumable{} -> defSPic
equipItemSPic :: EquipItemType -> Item -> SPic