Return to project, unsure about changes
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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)
|
||||
]
|
||||
)
|
||||
|
||||
@@ -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
|
||||
_ -> []
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -9,7 +9,7 @@ import Data.Aeson
|
||||
import Data.Aeson.TH
|
||||
|
||||
data TargetType
|
||||
= TargetLaser
|
||||
= TARGETLASER
|
||||
| TargetRBPress
|
||||
| TargetRBLine
|
||||
| TargetRBCreature
|
||||
|
||||
@@ -59,6 +59,7 @@ data ItemUse
|
||||
data AttachParams
|
||||
= ScrollAttachParams {_scrollAttachParams :: ScrollAttachParams}
|
||||
| AmmoAttachParams
|
||||
| TargetAttachParams
|
||||
|
||||
data ScrollAttachParams
|
||||
= ZoomScrollParams
|
||||
|
||||
@@ -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 ++ " "))
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
@@ -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 =
|
||||
|
||||
@@ -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 =
|
||||
|
||||
@@ -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."
|
||||
|
||||
@@ -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
@@ -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"
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user