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

Implement targeting launcher shells using separate item

Browse Source
This commit is contained in:
justin
2024-09-29 16:24:26 +01:00
parent 7d72fa3c5d
commit 88c3e02459
36 changed files with 747 additions and 610 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ghcidOutput
+1 -12
View File
@@ -1,12 +1 @@
/home/justin/Haskell/loop/src/Dodge/Creature/Impulse/UseItem.hs:(36,22)-(46,19): warning: [-Wincomplete-patterns]
Pattern match(es) are non-exhaustive
In a case alternative: Patterns not matched: TargetingUse _ _ _
|
36 | itemEffect cr it w = case it ^. ldtValue . itUse of
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^...
/home/justin/Haskell/loop/src/Dodge/Item/Display.hs:(109,28)-(121,21): warning: [-Wincomplete-patterns]
Pattern match(es) are non-exhaustive
In a case alternative: Patterns not matched: TargetingUse _ _ _
|
109 | itemNumberDisplay cr itm = case iu of
| ^^^^^^^^^^...
All good (616 modules, at 16:22:03)
saveSlot/LevelStart0
+1 -1
View File
File diff suppressed because one or more lines are too long
src/Dodge/Creature.hs
+9 -1
View File
@@ -246,6 +246,14 @@ inventoryX c = case c of
, megaShellMag
, homingModule
]
'V' ->
[targetingScope tt | tt <- [minBound .. maxBound]]
<>
[launcher
, megaShellMag
, homingModule
, remoteScreen
]
_ -> []
testInventory :: [Item]
@@ -278,7 +286,6 @@ stackedInventory =
, remoteScreen
, megaShellMag
, targetingScope TARGETLASER
, zoomScope
, burstRifle
, megaTinMag
, teslaGun
@@ -286,6 +293,7 @@ stackedInventory =
, flameThrower
, chemFuelPouch
, bulletSynthesizer
, zoomScope
, drumMag
, launcherX 3
, megaShellMag
src/Dodge/Creature/Impulse/UseItem.hs
+6 -5
View File
@@ -1,7 +1,7 @@
module Dodge.Creature.Impulse.UseItem (
useRootItem,
useItemLeftClick,
itemEffect,
itemUseEffect,
useItemHotkey,
) where
@@ -29,11 +29,11 @@ useRootItem crid w = fromMaybe w $ do
itRef <- cr ^? crManipulation . manObject . imRootItem
it <- invTrees (_crInv cr) ^? ix itRef
return $
itemEffect cr it w
itemUseEffect cr it w
& worldEventFlags . at InventoryChange ?~ ()
itemEffect :: Creature -> LabelDoubleTree ComposeLinkType Item -> World -> World
itemEffect cr it w = case it ^. ldtValue . itUse of
itemUseEffect :: Creature -> LabelDoubleTree ComposeLinkType Item -> World -> World
itemUseEffect cr it w = case it ^. ldtValue . itUse of
HeldUse{ _heldMods = usemods} ->
heldEffect usemods it cr w
& pointerToItem itm . itUse . heldHammer .~ HammerDown
@@ -42,6 +42,7 @@ itemEffect cr it w = case it ^. ldtValue . itUse of
(ConsumeUse eff) -> useC eff (_ldtValue it) cr w
CraftUse{} -> w
AttachUse{} -> selectUse it cr w
TargetingUse {} -> w
AmmoMagUse{} -> w
ScopeUse{} -> w
where
@@ -118,7 +119,7 @@ useItemLeftClick' cr' w = fromMaybe w $ do
itRef <- cr ^? crManipulation . manObject . imSelectedItem
it <- invTrees (_crInv cr) ^? ix itRef
return $
itemEffect cr it w
itemUseEffect cr it w
& worldEventFlags . at InventoryChange ?~ ()
-- & f
-- where
src/Dodge/Creature/State.hs
+86 -20
View File
@@ -3,9 +3,15 @@ module Dodge.Creature.State (
doDamage,
) where
import Dodge.Item.Display -- this should not really be imported... TODO move canAttachTargetingBelow
import Control.Applicative
import Data.Foldable
import Dodge.Zoning.Creature
import FoldableHelp
import Data.Maybe
import qualified Data.Map.Strict as M
import qualified SDL
import Dodge.Creature.Test
--import Dodge.Item.Display -- this should not really be imported... TODO move canAttachTargetingBelow
--import Control.Applicative
--import Data.Foldable
--import Data.Maybe
import Dodge.Base
import Dodge.Corpse.Make
@@ -24,7 +30,7 @@ import Dodge.ItEffect
--import Dodge.LightSource.Torch
import Dodge.Prop.Gib
import Dodge.SoundLogic
import Dodge.Targeting
--import Dodge.Targeting
import Geometry
import qualified IntMapHelp as IM
import LensHelp
@@ -235,19 +241,20 @@ equipmentEffects cr = flip (foldl' $ flip $ useEquipment cr) (IM.keys $ _crInvEq
-- a loop going over all inventory items
invSideEff :: Creature -> World -> World
invSideEff cr w =
updateTargeting (crGetTargeting cr) cr $
-- updateTargeting (crGetTargeting cr) cr $
-- weaponReloadSounds cr $
IM.foldl' f w (_crInv cr)
where
-- be careful with side effects that affect creature targeting
f w' it =
itemInvSideEffect cr it $
--doItemTargeting i cr w' & maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)
w' & maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)
itemInvSideEffect :: Creature -> Item -> World -> World
itemInvSideEffect _ _ = id
itemInvSideEffect cr itm = case _iyBase $ _itType itm of
TARGETING tt -> updateItemTargeting tt cr itm
_ -> id
--itemInvSideEffect cr it
-- | hastorchattach = createAttachLight cr it
-- | otherwise = id
@@ -259,6 +266,65 @@ itemInvSideEffect _ _ = id
-- where
-- attachoff = it ^?! itDimension . dimAttachPos
updateItemTargeting :: TargetingType -> Creature -> Item -> World -> World
updateItemTargeting tt cr itm w = w & case tt of
_ | not isattached
-> cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm) . itUse %~
( (tgPos .~ Nothing)
. (tgActive .~ False)
)
TARGETLASER | crIsAiming cr -> cWorld . lWorld . lasers
.:~ LaserStart
{ _lpPhaseV = 1
, _lpDir = _crDir cr
, _lpPos = sp
, _lpColor = col
, _lpType = TargetingLaser (_itID itm)
}
TARGETLASER -> cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm)
. itUse . tgPos .~ Nothing
TargetRBPress | rbpressed
-> cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm) . itUse %~
( (tgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. wCam)) Just)
. (tgActive .~ True)
)
TargetRBPress
-> cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm) . itUse %~
( (tgPos .~ Nothing)
. (tgActive .~ False)
)
TargetRBCreature -> cWorld . lWorld . creatures . ix (_crID cr)
. crInv . ix (_ilInvID $ _itLocation itm) . itUse %~ setRBCreatureTargeting cr w
TargetCursor -> cWorld . lWorld . creatures . ix (_crID cr)
. crInv . ix (_ilInvID $ _itLocation itm) . itUse .~ TargetingUse
(Just (mouseWorldPos (w ^. input) (w ^. wCam))) Nothing True
_ -> id
where
isattached = itm ^?! itLocation . ilIsAttached
rbpressed = SDL.ButtonRight `M.member` _mouseButtons (_input w)
sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
col = blue -- mixColors reloadFrac (1-reloadFrac) blue red
setRBCreatureTargeting :: Creature -> World -> ItemUse -> ItemUse
setRBCreatureTargeting cr w ituse
| SDL.ButtonRight `M.member` _mouseButtons (_input w) && isJust (ituse ^? tgID . _Just)
&& canSeeTarget = ituse & updatePos & tgActive .~ True
| otherwise = ituse & tgID .~ fmap _crID newtarg & updatePos & tgActive .~ False
where
newtarg =
safeMinimumOn (dist mwp . _crPos)
. filter (canseepos . _crPos)
$ crsNearCirc mwp 40 w
canseepos p = hasLOS (_crPos cr) p w
mwp = mouseWorldPos (w ^. input) (w ^. wCam)
updatePos t' = t' & tgPos .~ posFromMaybeID (_tgID t')
posFromMaybeID Nothing = Nothing
posFromMaybeID (Just i) = w ^? cWorld . lWorld . creatures . ix i . crPos
canSeeTarget = fromMaybe False $ do
cid <- ituse ^? tgID . _Just
cpos <- w ^? cWorld . lWorld . creatures . ix cid . crPos
Just $ hasLOS cpos (_crPos cr) w
itemUpdate :: Item -> Item
itemUpdate =
updateAutoRecharge
@@ -280,19 +346,19 @@ updateAutoRecharge it = case it ^? itUse . leftConsumption of
-- I feel like there should be a centralised function that supersumes this
-- i.e. a function that deals with all states that depend upon item positioning
-- in the inventory
crGetTargeting :: Creature -> Maybe TargetType
crGetTargeting cr = do
i <- cr ^? crManipulation . manObject . imRootItem
itm <- cr ^? crInv . ix i
itm ^? itType . iyModules . ix ModTarget . imtTargetType
<|> 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
--crGetTargeting :: Creature -> Maybe TargetingType
--crGetTargeting cr = do
-- i <- cr ^? crManipulation . manObject . imRootItem
-- itm <- cr ^? crInv . ix i
-- itm ^? itType . iyModules . ix ModTarget . imtTargetType
-- <|> do
-- tt <- cr ^? crInv . ix (i-1) . itType . iyBase . ibtTargeting
-- 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
src/Dodge/Data/Creature.hs
+2 -2
View File
@@ -77,14 +77,14 @@ data Creature = Creature
, _crName :: String
, _crStatistics :: CreatureStatistics
, _crCamouflage :: CamouflageStatus
, _crTargeting :: CreatureTargeting
-- , _crTargeting :: CreatureTargeting
}
--deriving (Eq, Show, Read) --Generic, Flat)
data CreatureTargeting = CreatureTargeting
{ _ctPos :: Maybe Point2
, _ctType :: Maybe TargetType
, _ctType :: Maybe TargetingType
, _ctID :: Maybe Int
, _ctActive :: Bool
}
src/Dodge/Data/Item/Combine.hs
+4 -4
View File
@@ -77,7 +77,7 @@ data CraftType
| TIMEMODULE
| SIZEMODULE
| GRAVITYMODULE
| TARGETMODULE TargetType
| TARGETMODULE TargetingType
deriving (Eq, Ord, Show, Read)
--deriving (Eq, Ord, Show, Enum, Read) --Generic, Flat)
@@ -90,13 +90,13 @@ data ItemBaseType
| CRAFT CraftType
| ATTACH {_ibtAttach :: AttachType}
| AMMOMAG {_ibtAmmoMag :: AmmoMagType}
| TARGETING {_ibtTargeting :: TargetingType}
deriving (Eq, Ord, Show, Read)
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data AttachType
= ZOOMSCOPE
| TARGETATTACH {_ibtAttachTarget :: TargetType}
| BULLETSYNTHESIZER
| REMOTESCREEN
| HOMINGMODULE
@@ -130,7 +130,7 @@ data EquipItemType
| INVISIBILITYEQUIPMENT EquipSite
| BRAINHAT
| HAT
| TARGETINGHAT TargetType
| TARGETINGHAT TargetingType
| HEADLAMP
| POWERLEGS
| SPEEDLEGS
@@ -208,7 +208,7 @@ data ItemModuleType
| BULPAY BulletSpawn
| BULBODY BulletEffect
| BULTRAJ {_imtBulletTrajectoryType :: BulletTrajectoryType}
| TARGET {_imtTargetType :: TargetType}
| TARGET {_imtTargetType :: TargetingType}
| INCENDLAS
| SPLITLAS
| STATICLAS
src/Dodge/Data/Item/Targeting.hs
+2 -2
View File
@@ -8,7 +8,7 @@ module Dodge.Data.Item.Targeting where
import Data.Aeson
import Data.Aeson.TH
data TargetType
data TargetingType
= TARGETLASER
| TargetRBPress
| TargetRBLine
@@ -16,4 +16,4 @@ data TargetType
| TargetCursor
deriving (Eq, Ord, Show, Read, Enum, Bounded) --Generic, Flat)
deriveJSON defaultOptions ''TargetType
deriveJSON defaultOptions ''TargetingType
src/Dodge/Data/Item/Use.hs
+1 -1
View File
@@ -57,7 +57,7 @@ data ItemUse
}
| EquipUse
{ _equipEffect :: EquipEffect
, _equipTargeting :: Maybe TargetType
, _equipTargeting :: Maybe TargetingType
}
| CraftUse
| -- {_useAmount :: ItAmount}
src/Dodge/Data/Item/Use/Consumption/Ammo.hs
+9 -1
View File
@@ -20,10 +20,16 @@ import Dodge.Data.Payload
data ProjectileDraw = DrawShell | DrawRemoteShell | DrawDrone | DrawBlankProjectile
deriving (Show, Eq, Ord, Enum, Bounded, Read) --Generic, Flat)
data ProjectileHoming
= NoHoming
| HomeUsingRemoteScreen {_phRemoteID :: NewInt ItmInt}
| HomeUsingTargeting {_phTargetingID :: NewInt ItmInt}
deriving (Show, Eq, Ord, Read) --Generic, Flat)
data ProjectileUpdate
= ThrustPU {_pjuStart :: Int, _pjuEnd :: Int}
| StartSpinPU {_pjuTime :: Int, _pjuCID :: Int, _pjuSpinAmound :: Int}
| RemoteDirectionPU {_pjuStart :: Int, _pjuEnd :: Int, _pjuControllerID :: Maybe (NewInt ItmInt)}
| RemoteDirectionPU {_pjuStart :: Int, _pjuEnd :: Int, _pjuControllerID :: ProjectileHoming}
| ReduceSpinPU {_pjuReduceSpin :: Float}
| DestroyPU {_pjuScreenID :: Maybe (NewInt ItmInt), _pjuTimer :: Int}
| TimePU
@@ -50,7 +56,9 @@ data GasCreate = CreatePoisonGas | CreateFlame
makeLenses ''ProjectileUpdate
makeLenses ''AmmoType
makeLenses ''ProjectileHoming
deriveJSON defaultOptions ''GasFuel
deriveJSON defaultOptions ''ProjectileHoming
deriveJSON defaultOptions ''ProjectileDraw
deriveJSON defaultOptions ''ProjectileUpdate
deriveJSON defaultOptions ''GasCreate
src/Dodge/Data/LWorld.hs
+2 -2
View File
@@ -31,7 +31,7 @@ module Dodge.Data.LWorld (
module Dodge.Data.Machine,
module Dodge.Data.Magnet,
module Dodge.Data.Modification,
module Dodge.Data.PathGraph,
-- module Dodge.Data.PathGraph,
module Dodge.Data.PosEvent,
module Dodge.Data.PressPlate,
module Dodge.Data.Projectile,
@@ -77,7 +77,7 @@ import Dodge.Data.LinearShockwave
import Dodge.Data.Machine
import Dodge.Data.Magnet
import Dodge.Data.Modification
import Dodge.Data.PathGraph
--import Dodge.Data.PathGraph
import Dodge.Data.PosEvent
import Dodge.Data.PressPlate
import Dodge.Data.Projectile
src/Dodge/Data/Laser.hs
+3 -1
View File
@@ -5,6 +5,8 @@
module Dodge.Data.Laser where
import NewInt
import Dodge.Data.Item.Location
import Color
import Control.Lens
import Data.Aeson
@@ -13,7 +15,7 @@ import Geometry.Data
data LaserType
= DamageLaser {_laserTypeDamage :: Int}
| TargetingLaser
| TargetingLaser {_laserEmmiter :: NewInt ItmInt}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data LaserStart = LaserStart
src/Dodge/Data/PathGraph.hs
+10 -10
View File
@@ -18,17 +18,17 @@ import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Data.Graph.Inductive
import Data.Map.Strict (Map)
--import Data.Map.Strict (Map)
import qualified Data.Set as Set
import Geometry.Data
data PathGraph = PathGraph
{ _pgGraph :: Gr Point2 PathEdge
, _pgNodeMap :: Map Point2 Int
, _pgNodeCount :: Int
, _pgEdgeMap :: Map (V2 Point2) PathEdgeNodes
}
deriving (Eq, Show, Read) --, Generic)
--data PathGraph = PathGraph
-- { _pgGraph :: Gr Point2 PathEdge
-- , _pgNodeMap :: Map Point2 Int
-- , _pgNodeCount :: Int
-- , _pgEdgeMap :: Map (V2 Point2) PathEdgeNodes
-- }
-- deriving (Eq, Show, Read) --, Generic)
data PathEdgeNodes = PathEdgeNodes
{ _penStart :: Int
@@ -59,11 +59,11 @@ data EdgeObstacle
--deriving instance (Flat (Gr Point2 PathEdge))
makeLenses ''PathGraph
--makeLenses ''PathGraph
makeLenses ''PathEdge
makeLenses ''PathEdgeNodes
deriveJSON defaultOptions ''EdgeObstacle
deriveJSON defaultOptions ''PathEdge
deriveJSON defaultOptions ''PathEdgeNodes
deriveJSON defaultOptions ''Gr
deriveJSON defaultOptions ''PathGraph
--deriveJSON defaultOptions ''PathGraph
src/Dodge/Default/Creature.hs
+1 -1
View File
@@ -57,7 +57,7 @@ defaultCreature =
, _crName = "DEFAULTCRNAME"
, _crStatistics = CreatureStatistics 50 50 50
, _crCamouflage = FullyVisible
, _crTargeting = defaultCreatureTargeting
-- , _crTargeting = defaultCreatureTargeting
}
defaultCreatureTargeting :: CreatureTargeting
src/Dodge/HeldUse.hs
+41 -24
View File
@@ -18,7 +18,7 @@ import Dodge.Data.DoubleTree
--import Color
import Data.Maybe
--import Data.Traversable
import Dodge.Base.Coordinate
--import Dodge.Base.Coordinate
--import Dodge.Bullet
import Dodge.Creature.HandPos
import Dodge.Data.World
@@ -31,11 +31,11 @@ import Dodge.Item.Weapon.TriggerType
import Dodge.Projectile.Create
import Dodge.SoundLogic
import Dodge.Tesla.Arc
import Dodge.Wall.ForceField
import Dodge.Wall.Move
--import Dodge.Wall.ForceField
--import Dodge.Wall.Move
import Dodge.WorldEvent.Flash
import Geometry
import qualified IntMapHelp as IM
--import qualified IntMapHelp as IM
import LensHelp
import RandomHelp
import Sound.Data
@@ -55,7 +55,7 @@ bulGunEffect' :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> Wo
bulGunEffect' t cr w = fromMaybe (error "error in bulGunEffect") $ do
muzzles <- t ^? ldtValue . itUse . heldAim . aimMuzzles
let (upitm,loadedmuzzles) = mapAccumR loadMuzzle t muzzles
cmew = foldl' (useLoadedAmmo (_ldtValue t) cr) (CME 0 0 False,w) $ zip [0..] loadedmuzzles
cmew = foldl' (useLoadedAmmo t cr) (CME 0 0 False,w) $ zip [0..] loadedmuzzles
return $ uncurry (applyCME (_ldtValue t) cr) cmew
& cWorld . lWorld . lTestString .~ map (show . _mzAmmoSlot) muzzles
& doWeaponRepetitions upitm cr
@@ -184,23 +184,26 @@ isAmmoIntLink :: Int -> ComposeLinkType -> Bool
isAmmoIntLink i (AmmoInLink j _) = i == j
isAmmoIntLink _ _ = False
useLoadedAmmo :: Item -> Creature -> (CumulativeMuzzleEffect,World)
useLoadedAmmo :: LabelDoubleTree ComposeLinkType Item
-> Creature
-> (CumulativeMuzzleEffect,World)
-> (Int,Maybe (Muzzle,Int,LabelDoubleTree ComposeLinkType Item))
-> (CumulativeMuzzleEffect,World)
useLoadedAmmo _ _ (cme,w) (_,Nothing) = (cme, w)
useLoadedAmmo itm cr (cme,w) (mzid,Just (mz,x,magtree)) = (,) (cme & cmeSound .~ True) $
useLoadedAmmo itmtree cr (cme,w) (mzid,Just (mz,x,magtree)) = (,) (cme & cmeSound .~ True) $
removeAmmoFromMag x mid cr . makeMuzzleFlare mz itm cr $ case _mzEffect mz of
MuzzleShootBullet -> shootBullet itm cr w (mz,x,mid)
MuzzleLaser -> shootLaser' itm cr mz w
MuzzleTesla -> shootTeslaArc itm cr mz w
MuzzleTractor -> shootTractorBeam itm cr w
MuzzleLauncher -> createProjectile magtree mz itm cr w
MuzzleLauncher -> createProjectile magtree mz itmtree cr w
MuzzleNozzle {} -> useGasParams mid mz itm cr $ walkNozzle mzid mz itm cr w
MuzzleShatter -> shootShatter itm cr w
MuzzleForceField -> useForceFieldGun itm cr w
MuzzleDetector -> itemDetectorEffect itm cr w
where
mid = magtree ^? ldtValue . itLocation . ilInvID
itm = itmtree ^. ldtValue
itemDetectorEffect :: Item -> Creature -> World -> World
itemDetectorEffect itm cr w = fromMaybe w $ do
@@ -485,32 +488,46 @@ shootTeslaArc itm cr mz w =
-- the rmb, it is possible for this to do nothing
-- TODO investigate more and fix
useForceFieldGun :: Item -> Creature -> World -> World
useForceFieldGun itm cr w = fromMaybe w $ do
a <- cr ^? crTargeting . ctPos . _Just
let mwp = mouseWorldPos (w ^. input) (w ^. wCam)
b = if dist a mwp < 100 then mwp else a +.+ 100 *.* normalizeV (mwp -.- a)
wlline = (a, b)
return $
w
& cWorld . lWorld . walls %~ IM.insertWith (\_ x -> x) i forceField{_wlID = i}
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID (_itLocation itm)) . itParams . paramMID ?~ i
& moveWallIDUnsafe i wlline
where
i = fromMaybe (IM.newKey (_walls (_lWorld (_cWorld w)))) $ itm ^? itParams . paramMID . _Just
useForceFieldGun _ _ = id
--useForceFieldGun itm cr w = fromMaybe w $ do
-- a <- cr ^? crTargeting . ctPos . _Just
-- let mwp = mouseWorldPos (w ^. input) (w ^. wCam)
-- b = if dist a mwp < 100 then mwp else a +.+ 100 *.* normalizeV (mwp -.- a)
-- wlline = (a, b)
-- return $
-- w
-- & cWorld . lWorld . walls %~ IM.insertWith (\_ x -> x) i forceField{_wlID = i}
-- & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID (_itLocation itm)) . itParams . paramMID ?~ i
-- & moveWallIDUnsafe i wlline
-- where
-- i = fromMaybe (IM.newKey (_walls (_lWorld (_cWorld w)))) $ itm ^? itParams . paramMID . _Just
determineProjectileTracking :: LabelDoubleTree ComposeLinkType Item
-> LabelDoubleTree ComposeLinkType Item
-> ProjectileHoming
determineProjectileTracking magtree itmtree = case lookup RemoteScreenLink (magtree ^. ldtLeft) of
Just screen -> HomeUsingRemoteScreen (screen ^. ldtValue . itID)
Nothing -> fromMaybe NoHoming $ do
_ <- lookup AmmoTargetingLink (magtree ^. ldtLeft) -- should not have to give a direction
targetingtree <- lookup WeaponTargetingLink (itmtree ^. ldtRight) -- left or right for these
return $ HomeUsingTargeting (targetingtree ^. ldtValue . itID)
createProjectile
:: LabelDoubleTree ComposeLinkType Item
-> Muzzle -> Item -> Creature -> World -> World
createProjectile magtree muz itm cr = fromMaybe failsound $ do
-> Muzzle
-> LabelDoubleTree ComposeLinkType Item
-> Creature -> World -> World
createProjectile magtree muz itmtree cr = fromMaybe failsound $ do
magid <- magtree ^? ldtValue . itLocation . ilInvID
ammoitem <- cr ^? crInv . ix magid
let mscreen = lookup RemoteScreenLink (magtree ^. ldtLeft)
let homing = determineProjectileTracking magtree itmtree
j <- ammoitem ^? itLocation . ilInvID
aparams <- ammoitem ^? itUse . amagParams
return $ createShell (mscreen ^? _Just . ldtValue) aparams muz itm cr
return $ createShell homing aparams muz itm cr
. startthesound
. useammo j
where
itm = itmtree ^. ldtValue
useammo j = cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix j . itUse . amagLoadStatus . iaLoaded -~ 1
-- the sound should be moved to the projectile firing
src/Dodge/Item.hs
+1 -1
View File
@@ -25,6 +25,7 @@ itemFromBase ibt = case ibt of
CRAFT cr -> makeTypeCraft cr
ATTACH at -> itemFromAttachType at
AMMOMAG t -> itemFromAmmoMag t
TARGETING tt -> targetingScope tt
itemFromAmmoMag :: AmmoMagType -> Item
itemFromAmmoMag at = case at of
@@ -39,7 +40,6 @@ itemFromAmmoMag at = case at of
itemFromAttachType :: AttachType -> Item
itemFromAttachType at = case at of
ZOOMSCOPE -> zoomScope
TARGETATTACH tt -> targetingScope tt
BULLETSYNTHESIZER -> bulletSynthesizer
REMOTESCREEN -> remoteScreen
-- ROCKETHOMER -> rocketHomer
src/Dodge/Item/Display.hs
+4 -2
View File
@@ -16,7 +16,7 @@ import Dodge.Module
import LensHelp
import Padding
canAttachTargeting :: TargetType -> Item -> Bool
canAttachTargeting :: TargetingType -> Item -> Bool
canAttachTargeting TARGETLASER _ = True
canAttachTargeting _ itm =
isJust (itm ^? itType . iyModules . ix ModBulletTrajectory . imtBulletTrajectoryType)
@@ -70,11 +70,12 @@ itemBaseName itm = case _iyBase $ _itType itm of
CONSUMABLE cit -> show cit
ATTACH ait -> showAttachItem ait itm
AMMOMAG ait -> show ait
TARGETING tt -> show tt
showAttachItem :: AttachType -> Item -> String
showAttachItem t itm = case t of
ZOOMSCOPE -> "ZOOMSCOPE"
TARGETATTACH x -> show x
-- TARGETATTACH x -> show x
BULLETSYNTHESIZER -> "BSYNTH"
REMOTESCREEN -> "REMOTE SCREEN " ++ show (itm ^? itUse . atLinkedProjectile . _Just)
HOMINGMODULE -> "HOMING MOD"
@@ -119,6 +120,7 @@ itemNumberDisplay cr itm = case iu of
AmmoMagUse {} -> [showLoadedAmount itm]
ScopeUse OpticScope {_opticZoom = x} -> [show x]
ScopeUse {} -> []
TargetingUse {_tgPos = mp} -> [maybe "" show mp]
-- this could be cleaner here...
where
iu = itm ^?! itUse
src/Dodge/Item/Draw/SPic.hs
+1
View File
@@ -34,6 +34,7 @@ itemSPic it =
CONSUMABLE{} -> defSPic
ATTACH {} -> defSPic
AMMOMAG {} -> defSPic
TARGETING {} -> defSPic
equipItemSPic :: EquipItemType -> Item -> SPic
equipItemSPic et _ = case et of
src/Dodge/Item/Equipment.hs
+1 -1
View File
@@ -108,7 +108,7 @@ hat =
& itUse . equipEffect . eeSite .~ GoesOnHead
& itType . iyBase .~ EQUIP HAT
targetingHat :: TargetType -> Item
targetingHat :: TargetingType -> Item
targetingHat tt =
defaultEquipment
& itUse . equipEffect . eeSite .~ GoesOnHead
src/Dodge/Item/Grammar.hs
+1 -1
View File
@@ -38,7 +38,7 @@ basePartiallyComposedItem itm = case itm ^. itType . iyBase of
[(WeaponTargetingSF,WeaponTargetingLink), (WeaponScopeSF,WeaponScopeLink)]
)
AMMOMAG _ -> ammoComposedItem itm
ATTACH TARGETATTACH{} -> (itm,WeaponTargetingSF, LinkTest (const Nothing) (const Nothing))
TARGETING {} -> (itm,WeaponTargetingSF, LinkTest (const Nothing) (const Nothing))
ATTACH ZOOMSCOPE -> (itm,WeaponScopeSF, LinkTest (const Nothing) (const Nothing))
ATTACH HOMINGMODULE -> (itm,AmmoTargetingSF ProjectileAmmo, LinkTest (const Nothing) (const Nothing))
ATTACH REMOTESCREEN -> (itm,RemoteScreenSF, LinkTest (const Nothing) (const Nothing))
src/Dodge/Item/Info.hs
+1 -1
View File
@@ -138,7 +138,7 @@ equipInfo eit = case eit of
BATTERYPACK -> "A collection of batteries with a universal adapter."
AUTODETECTOR d -> "A device that detects " ++ detectorInfo d ++ " in an expanding radius. Pulses automatically. "
targetingInfo :: TargetType -> String
targetingInfo :: TargetingType -> String
targetingInfo tt = case tt of
TARGETLASER -> "creates a laser, the end of which becomes the target."
TargetRBPress -> "creates a fixed target."
src/Dodge/Item/InventoryColor.hs
+1
View File
@@ -12,4 +12,5 @@ itemInvColor itm = case itm ^. itType . iyBase of
CONSUMABLE {} -> blue
CRAFT {} -> green
ATTACH {} -> orange
TARGETING {} -> chartreuse
AMMOMAG {} -> greyN 0.8
src/Dodge/Item/Location.hs
+11
View File
@@ -1,4 +1,5 @@
module Dodge.Item.Location (
pointerToItemID,
pointerToItemLocation,
getItem,
pointerToItem,
@@ -50,3 +51,13 @@ pointerToItem ::
World ->
f World
pointerToItem = pointerToItemLocation . _itLocation
pointerToItemID ::
Applicative f =>
NewInt ItmInt ->
(Item -> f Item) ->
World ->
f World
pointerToItemID itid f w = fromMaybe (pure w) $ do
itloc <- w ^? cWorld . lWorld . itemLocations . ix (_unNInt itid)
return $ pointerToItemLocation itloc f w
src/Dodge/Item/Scope.hs
+3 -3
View File
@@ -16,11 +16,11 @@ zoomScope =
-- & itUse .~ AttachUse (ScrollAttachParams (ZoomScrollParams{_opticPos = 0, _opticZoom = 1, _opticDefaultZoom = 0.5}))
& itUse .~ ScopeUse OpticScope{_opticPos = 0, _opticZoom = 1, _opticDefaultZoom = 0.5}
targetingScope :: TargetType -> Item
targetingScope :: TargetingType -> Item
targetingScope tt =
defaultHeldItem
& itType . iyBase .~ ATTACH (TARGETATTACH tt)
& itUse .~ AttachUse Nothing
& itType . iyBase .~ TARGETING tt
& itUse .~ TargetingUse Nothing Nothing False
homingModule :: Item
homingModule =
src/Dodge/Item/Weapon/Targeting.hs
+12 -12
View File
@@ -1,16 +1,16 @@
module Dodge.Item.Weapon.Targeting (
useTargetPos,
-- useTargetPos,
) where
import Control.Lens
import Dodge.Data.World
import Geometry.Data
--import Control.Lens
--import Dodge.Data.World
--import Geometry.Data
useTargetPos ::
(Maybe Point2 -> Creature -> World -> World) ->
Creature ->
World ->
World
useTargetPos f cr w = case cr ^? crTargeting . ctPos of
Nothing -> w
Just p -> f p cr w
--useTargetPos ::
-- (Maybe Point2 -> Creature -> World -> World) ->
-- Creature ->
-- World ->
-- World
--useTargetPos f cr w = case cr ^? crTargeting . ctPos of
-- Nothing -> w
-- Just p -> f p cr w
src/Dodge/Laser/Update.hs
+9 -6
View File
@@ -1,7 +1,10 @@
module Dodge.Laser.Update where
module Dodge.Laser.Update
( updateLaser
) where
import Dodge.Item.Location
import Control.Lens
import Data.Maybe
--import Data.Maybe
import Dodge.Data.World
import Dodge.Item.Weapon.LaserPath
import Dodge.WorldEvent.Damage
@@ -9,13 +12,13 @@ import Geometry
updateLaser :: World -> LaserStart -> (World, Laser)
updateLaser w pt =
( w'
( case _lpType pt of
DamageLaser dam -> damThingHitWith
(\p1 p2 p3 -> Damage LASERING dam p1 p2 p3 NoDamageEffect) sp xp thHit w
TargetingLaser itid -> w & pointerToItemID itid . itUse . tgPos ?~ last ps
, Laser{_lzPoints = sp : ps, _lzColor = _lpColor pt, _lzType = _lpType pt}
)
where
w' = fromMaybe w $ do
dam <- pt ^? lpType . laserTypeDamage
return $ damThingHitWith (\p1 p2 p3 -> Damage LASERING dam p1 p2 p3 NoDamageEffect) sp xp thHit w
phasev = _lpPhaseV pt
sp = _lpPos pt
dir = _lpDir pt
src/Dodge/Projectile/Create.hs
+14 -9
View File
@@ -2,15 +2,22 @@ module Dodge.Projectile.Create (
createShell,
) where
import Dodge.Item.Location
import Data.Maybe
import Dodge.Data.World
import Geometry
import qualified IntMapHelp as IM
import LensHelp
homingDrawType :: ProjectileHoming -> ProjectileDraw
homingDrawType ht = case ht of
NoHoming -> DrawShell
HomeUsingRemoteScreen {} -> DrawRemoteShell
HomeUsingTargeting {} -> DrawRemoteShell
-- assumes the mscreen is in your inventory
createShell :: Maybe Item -> AmmoParams -> Muzzle -> Item -> Creature -> World -> World
createShell mscreen aparams muz it cr w = w
createShell :: ProjectileHoming -> AmmoParams -> Muzzle -> Item -> Creature -> World -> World
createShell homing aparams muz it cr w = w
& updatescreen
& cWorld . lWorld . projectiles . at i
?~ Shell
@@ -18,7 +25,7 @@ createShell mscreen aparams muz it cr w = w
, _prjZ = 20
, _prjStartPos = pos
, _prjVel = rotateV dir (V2 1 0)
, _prjDraw = maybe DrawShell (const DrawRemoteShell) mscreen
, _prjDraw = homingDrawType homing
, _prjID = i
, _prjAcc = rotateV dir (V2 3 0)
, _prjDir = dir
@@ -26,10 +33,10 @@ createShell mscreen aparams muz it cr w = w
, _prjPayload = _ampPayload aparams
, _prjTimer = 350
, _prjUpdates =
[ CollisionEffectPU (mscreen ^? _Just . itID) --Just screenid)
[ CollisionEffectPU (homing ^? phRemoteID) --Just screenid)
, TimePU
, StartSpinPU 335 (_crID cr) (_shellSpinAmount params)
, RemoteDirectionPU (350 - thrustdelay) 0 (mscreen ^? _Just . itID)
, RemoteDirectionPU (350 - thrustdelay) 0 homing
, ThrustPU (350 - thrustdelay) 0
, ReduceSpinPU (1 - fromIntegral (_shellSpinDrag params) * 2 / 200)
]
@@ -38,10 +45,8 @@ createShell mscreen aparams muz it cr w = w
thrustdelay = _shellThrustDelay params
params = _itParams it
updatescreen = fromMaybe id $ do
screeninvid <- mscreen ^? _Just . itLocation . ilInvID
return $
cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix screeninvid
. itUse
screenid <- homing ^? phRemoteID
return $ pointerToItemID screenid . itUse
. atLinkedProjectile
?~ i
i = IM.newKey $ w ^. cWorld . lWorld . projectiles
src/Dodge/Projectile/Update.hs
+26 -10
View File
@@ -3,6 +3,7 @@ module Dodge.Projectile.Update
( updateProjectile
) where
import Dodge.Movement.Turn
import NewInt
import Dodge.Payload
import Control.Lens
@@ -108,16 +109,31 @@ trySpinByCID cid i pj w = w & cWorld . lWorld . projectiles . ix pjid . prjSpin
spinFactor = 5 * (6 - fromIntegral i)
-- note this only allows YOU to remotely track projectiles
pjRemoteSetDirection :: Maybe (NewInt ItmInt) -> Projectile -> World -> World
pjRemoteSetDirection mscreenid pj w = fromMaybe w $ do
screenid <- fmap _unNInt mscreenid
let newdir
| w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem
== w ^? cWorld . lWorld . itemLocations . ix screenid . ilInvID
= (w ^. wCam . camRot) + argV (_mousePos (_input w))
| otherwise = _prjDir pj
turntonewdir = magV (_prjAcc pj) *.* unitVectorAtAngle newdir
return $ w & cWorld . lWorld . projectiles . ix (_prjID pj) . prjAcc .~ turntonewdir
pjRemoteSetDirection :: ProjectileHoming -> Projectile -> World -> World
pjRemoteSetDirection ph pj w = case ph of
NoHoming -> w
HomeUsingRemoteScreen screenid ->
let newdir
| w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem
== w ^? cWorld . lWorld . itemLocations . ix (_unNInt screenid) . ilInvID
= (w ^. wCam . camRot) + argV (_mousePos (_input w))
| otherwise = _prjDir pj
in w & cWorld . lWorld . projectiles . ix (_prjID pj) . prjAcc
.~ magV (_prjAcc pj) *.* unitVectorAtAngle newdir
HomeUsingTargeting itid -> fromMaybe w $ do
tp <- w ^? pointerToItemID itid . itUse . tgPos . _Just
return $ w & cWorld . lWorld . projectiles . ix (_prjID pj) . prjAcc
%~ vecTurnTo 0.2 (_prjPos pj) tp
--pjRemoteSetDirection mscreenid pj w = fromMaybe w $ do
-- screenid <- fmap _unNInt mscreenid
-- let newdir
-- | w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem
-- == w ^? cWorld . lWorld . itemLocations . ix screenid . ilInvID
-- = (w ^. wCam . camRot) + argV (_mousePos (_input w))
-- | otherwise = _prjDir pj
-- turntonewdir = magV (_prjAcc pj) *.* unitVectorAtAngle newdir
-- return $ w & cWorld . lWorld . projectiles . ix (_prjID pj) . prjAcc .~ turntonewdir
reduceSpinBy :: Float -> Int -> World -> World
reduceSpinBy x pjid = cWorld . lWorld . projectiles . ix pjid . prjSpin *~ x
src/Dodge/Render/ShapePicture.hs
+6 -5
View File
@@ -69,11 +69,12 @@ drawSweep cr w = fromMaybe mempty $ do
mwp = mouseWorldPos theinput campos
anyTargeting :: Configuration -> World -> SPic
anyTargeting cfig w = fromMaybe mempty $ do
tt <- cr ^? crTargeting . ctType . _Just
return $ noShape $ drawTargeting tt cr cfig w
where
cr = you w
anyTargeting _ _ = mempty
--anyTargeting cfig w = fromMaybe mempty $ do
-- tt <- cr ^? crTargeting . ctType . _Just
-- return $ noShape $ drawTargeting tt cr cfig w
-- where
-- cr = you w
drawCreature :: Creature -> SPic
drawCreature cr = case _crType cr of
src/Dodge/Targeting.hs
+115 -114
View File
@@ -1,119 +1,120 @@
module Dodge.Targeting (
updateTargeting,
-- updateTargeting,
) where
import Color
import qualified Data.Map.Strict as M
import Data.Maybe
import Dodge.Base.Collide
import Dodge.Base.Coordinate
import Dodge.Creature.Test
import Dodge.Data.World
import Dodge.Item.Weapon.LaserPath
import Dodge.Zoning.Creature
import FoldableHelp
import Geometry.Vector
import LensHelp
import qualified SDL
--import Color
--import qualified Data.Map.Strict as M
--import Data.Maybe
--import Dodge.Base.Collide
--import Dodge.Base.Coordinate
--import Dodge.Creature.Test
--import Dodge.Data.World
--import Dodge.Item.Weapon.LaserPath
--import Dodge.Zoning.Creature
--import FoldableHelp
--import Geometry.Vector
--import LensHelp
--import qualified SDL
updateTargeting :: Maybe TargetType -> Creature -> World -> World
updateTargeting tu = case tu of
Nothing -> clearTargeting
Just TARGETLASER -> targetLaserUpdate'
Just TargetRBPress -> upCT (flip targetRBPressUpdate . _crTargeting)
Just TargetRBLine -> upCT (flip targetRBPressUpdate . _crTargeting)
Just TargetRBCreature -> upCT targetRBCreatureUp
Just TargetCursor -> upCT (flip targetCursorUpdate . _crTargeting)
--updateTargeting :: Maybe TargetingType -> Creature -> World -> World
--updateTargeting tu = case tu of
-- Nothing -> clearTargeting
-- Just TARGETLASER -> targetLaserUpdate'
-- Just TargetRBPress -> upCT (flip targetRBPressUpdate . _crTargeting)
-- Just TargetRBLine -> upCT (flip targetRBPressUpdate . _crTargeting)
-- Just TargetRBCreature -> upCT targetRBCreatureUp
-- Just TargetCursor -> upCT (flip targetCursorUpdate . _crTargeting)
clearTargeting :: Creature -> World -> World
clearTargeting cr = cWorld . lWorld . creatures . ix (_crID cr) . crTargeting .~ defaultTargeting
defaultTargeting :: CreatureTargeting
defaultTargeting = CreatureTargeting Nothing Nothing Nothing False
upCT :: (Creature -> World -> CreatureTargeting) -> Creature -> World -> World
upCT f cr w = w & cWorld . lWorld . creatures . ix (_crID cr) . crTargeting .~ f cr w
targetRBCreatureUp :: Creature -> World -> CreatureTargeting
targetRBCreatureUp cr w
| SDL.ButtonRight `M.member` _mouseButtons (_input w) && isJust (t ^? ctID . _Just)
&& canSeeTarget =
t & updatePos & ctActive .~ True
& ctType ?~ TargetRBCreature
| otherwise = t & ctID .~ fmap _crID newtarg & updatePos & ctActive .~ False
& ctType ?~ TargetRBCreature
where
t = _crTargeting cr
newtarg =
safeMinimumOn (dist mwp . _crPos)
. filter (canseepos . _crPos)
$ crsNearCirc mwp 40 w
canseepos p = hasLOS (_crPos cr) p w
mwp = mouseWorldPos (w ^. input) (w ^. wCam)
updatePos t' = t' & ctPos .~ posFromMaybeID (_ctID t')
posFromMaybeID Nothing = Nothing
posFromMaybeID (Just i) = w ^? cWorld . lWorld . creatures . ix i . crPos
canSeeTarget = fromMaybe False $ do
cid <- t ^? ctID . _Just
cpos <- w ^? cWorld . lWorld . creatures . ix cid . crPos
Just $ hasLOS cpos (_crPos cr) w
targetCursorUpdate :: World -> CreatureTargeting -> CreatureTargeting
targetCursorUpdate w ct =
ct
& ctPos . _Just .~ mouseWorldPos (w ^. input) (w ^. wCam)
& ctActive .~ True
& ctType ?~ TargetCursor
targetRBPressUpdate :: World -> CreatureTargeting -> CreatureTargeting
targetRBPressUpdate w t
| SDL.ButtonRight `M.member` _mouseButtons (_input w) =
t
& ctPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. wCam)) Just
& ctActive .~ True
& ctType ?~ TargetRBPress
| otherwise =
t
& ctPos %~ const Nothing
& ctActive .~ False
& ctType ?~ TargetRBPress
targetLaserUpdate' :: Creature -> World -> World
targetLaserUpdate' cr w =
let (w', ct') = targetLaserUpdate cr w (_crTargeting cr)
in w' & cWorld . lWorld . creatures . ix (_crID cr) . crTargeting .~ ct'
targetLaserUpdate :: Creature -> World -> CreatureTargeting -> (World, CreatureTargeting)
targetLaserUpdate cr w t
| crIsAiming cr =
( addLaserPic w
, t
& ctPos .~ fmap fst mp
& ctActive .~ True
& ctType ?~ TARGETLASER
)
| otherwise =
( w
, t & ctPos %~ const Nothing
& ctActive .~ False
)
where
(mp, _) = reflectLaserAlong 0.2 sp ep w
sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos (w ^. input) (w ^. wCam) -.- sp)
addLaserPic =
cWorld . lWorld . lasers
.:~ LaserStart
{ _lpPhaseV = 1
, _lpDir = _crDir cr
, _lpPos = sp
, _lpColor = col
, _lpType = TargetingLaser
}
--wpammo = _itConsumption it
-- reloadFrac
-- | _laLoaded wpammo == 0 = 1
-- | otherwise = case _laTransfer wpammo of
-- Transfer _ rs -> fromIntegral rs / fromIntegral (_laReloadTime wpammo)
-- NoTransfer -> 1
col = blue -- mixColors reloadFrac (1-reloadFrac) blue red
--clearTargeting :: Creature -> World -> World
--clearTargeting cr = cWorld . lWorld . creatures . ix (_crID cr) . crTargeting .~ defaultTargeting
--
--defaultTargeting :: CreatureTargeting
--defaultTargeting = CreatureTargeting Nothing Nothing Nothing False
--
--upCT :: (Creature -> World -> CreatureTargeting) -> Creature -> World -> World
--upCT f cr w = w & cWorld . lWorld . creatures . ix (_crID cr) . crTargeting .~ f cr w
--
--targetRBCreatureUp :: Creature -> World -> CreatureTargeting
--targetRBCreatureUp cr w
-- | SDL.ButtonRight `M.member` _mouseButtons (_input w) && isJust (t ^? ctID . _Just)
-- && canSeeTarget =
-- t & updatePos & ctActive .~ True
-- & ctType ?~ TargetRBCreature
-- | otherwise = t & ctID .~ fmap _crID newtarg & updatePos & ctActive .~ False
-- & ctType ?~ TargetRBCreature
-- where
-- t = _crTargeting cr
-- newtarg =
-- safeMinimumOn (dist mwp . _crPos)
-- . filter (canseepos . _crPos)
-- $ crsNearCirc mwp 40 w
-- canseepos p = hasLOS (_crPos cr) p w
-- mwp = mouseWorldPos (w ^. input) (w ^. wCam)
-- updatePos t' = t' & ctPos .~ posFromMaybeID (_ctID t')
-- posFromMaybeID Nothing = Nothing
-- posFromMaybeID (Just i) = w ^? cWorld . lWorld . creatures . ix i . crPos
-- canSeeTarget = fromMaybe False $ do
-- cid <- t ^? ctID . _Just
-- cpos <- w ^? cWorld . lWorld . creatures . ix cid . crPos
-- Just $ hasLOS cpos (_crPos cr) w
--
--targetCursorUpdate :: World -> CreatureTargeting -> CreatureTargeting
--targetCursorUpdate w ct =
-- ct
-- & ctPos . _Just .~ mouseWorldPos (w ^. input) (w ^. wCam)
-- & ctActive .~ True
-- & ctType ?~ TargetCursor
--
--targetRBPressUpdate :: World -> CreatureTargeting -> CreatureTargeting
--targetRBPressUpdate w t
-- | SDL.ButtonRight `M.member` _mouseButtons (_input w) =
-- t
-- & ctPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. wCam)) Just
-- & ctActive .~ True
-- & ctType ?~ TargetRBPress
-- | otherwise =
-- t
-- & ctPos %~ const Nothing
-- & ctActive .~ False
-- & ctType ?~ TargetRBPress
--
--targetLaserUpdate' :: Creature -> World -> World
--targetLaserUpdate' cr w =
-- let (w', ct') = targetLaserUpdate cr w (_crTargeting cr)
-- in w' & cWorld . lWorld . creatures . ix (_crID cr) . crTargeting .~ ct'
--
--targetLaserUpdate :: Creature -> World -> CreatureTargeting -> (World, CreatureTargeting)
--targetLaserUpdate cr w t
-- | crIsAiming cr =
-- --( addLaserPic w
-- ( w
-- , t
-- & ctPos .~ fmap fst mp
-- & ctActive .~ True
-- & ctType ?~ TARGETLASER
-- )
-- | otherwise =
-- ( w
-- , t & ctPos %~ const Nothing
-- & ctActive .~ False
-- )
-- where
-- (mp, _) = reflectLaserAlong 0.2 sp ep w
-- sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
-- ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos (w ^. input) (w ^. wCam) -.- sp)
---- addLaserPic =
---- cWorld . lWorld . lasers
---- .:~ LaserStart
---- { _lpPhaseV = 1
---- , _lpDir = _crDir cr
---- , _lpPos = sp
---- , _lpColor = col
---- , _lpType = TargetingLaser
---- }
-- --wpammo = _itConsumption it
-- -- reloadFrac
-- -- | _laLoaded wpammo == 0 = 1
-- -- | otherwise = case _laTransfer wpammo of
-- -- Transfer _ rs -> fromIntegral rs / fromIntegral (_laReloadTime wpammo)
-- -- NoTransfer -> 1
---- col = blue -- mixColors reloadFrac (1-reloadFrac) blue red
src/Dodge/Targeting/Draw.hs
+43 -38
View File
@@ -2,16 +2,16 @@ module Dodge.Targeting.Draw (
drawTargeting,
) where
import Data.Maybe
import Dodge.Base
--import Data.Maybe
--import Dodge.Base
import Dodge.Data.Universe
import Geometry.Data
import Geometry.Vector
import LensHelp
--import Geometry.Vector
--import LensHelp
import Picture
import ShortShow
--import ShortShow
drawTargeting :: TargetType -> Creature -> Configuration -> World -> Picture
drawTargeting :: TargetingType -> Creature -> Configuration -> World -> Picture
drawTargeting td = case td of
TargetRBCreature -> targetRBCreatureDraw
TargetRBLine -> targetDistanceDraw
@@ -23,48 +23,53 @@ targetSimpleDraw :: Creature -> Configuration -> World -> Picture
targetSimpleDraw = targetDraw activeTargetCursorPic
targetDistanceDraw :: Creature -> Configuration -> World -> Picture
targetDistanceDraw cr _ w = fromMaybe mempty $ do
p <- cr ^? crTargeting . ctPos . _Just
let p1 = worldPosToScreen cam p
mwp = mouseWorldPos (w ^. input) (w ^. wCam)
p2 = worldPosToScreen cam mwp
thecol = if dist p mwp > 100 then red else white
return .
setLayer FixedCoordLayer $
color thecol $
line [p1, p2]
<> transMidLine p1 p2 (scale 0.1 0.1 . text . shortShow $ dist p mwp)
where
cam = w ^. wCam
targetDistanceDraw _ _ _ = mempty
--targetDistanceDraw cr _ w = mempty
-- fromMaybe mempty $ do
-- p <- cr ^? crTargeting . ctPos . _Just
-- let p1 = worldPosToScreen cam p
-- mwp = mouseWorldPos (w ^. input) (w ^. wCam)
-- p2 = worldPosToScreen cam mwp
-- thecol = if dist p mwp > 100 then red else white
-- return .
-- setLayer FixedCoordLayer $
-- color thecol $
-- line [p1, p2]
-- <> transMidLine p1 p2 (scale 0.1 0.1 . text . shortShow $ dist p mwp)
-- where
-- cam = w ^. wCam
targetDraw :: Picture -> Creature -> Configuration -> World -> Picture
targetDraw f cr _ _ = fromMaybe mempty $ do
p <- cr ^? crTargeting . ctPos . _Just
return .
setLayer DebugLayer $
color white $
uncurryV translate p f
targetDraw _ _ _ _ = mempty
--targetDraw f cr _ _ = mempty
-- fromMaybe mempty $ do
-- p <- cr ^? crTargeting . ctPos . _Just
-- return .
-- setLayer DebugLayer $
-- color white $
-- uncurryV translate p f
activeTargetCursorPic :: Picture
activeTargetCursorPic =
fold
[rotate a $ line [V2 15 0, V2 10 0] <> targCorner | a <- [0, 0.5 * pi, pi, 1.5 * pi]]
transMidLine :: Point2 -> Point2 -> Picture -> Picture
transMidLine p1 p2 = translate 20 (f p1 p2) . uncurryV translate (0.5 *.* (p1 +.+ p2))
where
f (V2 x y) (V2 x' y')
| y > y' && x > x' = max (-10) (x' - x)
| y > y' && x < x' = min 10 (x' - x)
| x > x' = min 10 (x - x')
| otherwise = max (-10) (x - x')
--transMidLine :: Point2 -> Point2 -> Picture -> Picture
--transMidLine p1 p2 = translate 20 (f p1 p2) . uncurryV translate (0.5 *.* (p1 +.+ p2))
-- where
-- f (V2 x y) (V2 x' y')
-- | y > y' && x > x' = max (-10) (x' - x)
-- | y > y' && x < x' = min 10 (x' - x)
-- | x > x' = min 10 (x - x')
-- | otherwise = max (-10) (x - x')
targetRBCreatureDraw :: Creature -> Configuration -> World -> Picture
targetRBCreatureDraw cr = targetDraw thepic cr
where
thepic
| _ctActive $ _crTargeting cr = activeTargetCursorPic
| otherwise = targetCursorPic
targetRBCreatureDraw cr = targetDraw targetCursorPic cr
--targetRBCreatureDraw cr = targetDraw thepic cr
-- where
-- thepic
-- | _ctActive $ _crTargeting cr = activeTargetCursorPic
-- | otherwise = targetCursorPic
targCorner :: Picture
targCorner = line [V2 (x - y) x, V2 x x, V2 x (x - y)]
src/Dodge/TestString.hs
+1 -1
View File
@@ -20,7 +20,7 @@ import Dodge.Data.Universe
import qualified IntMapHelp as IM
testStringInit :: Universe -> [String]
testStringInit = const mempty
testStringInit u = [maybe mempty show $ u ^? uvWorld . cWorld . lWorld . projectiles . ix 0 . prjUpdates . ix 3 . pjuControllerID]
--testStringInit u = (topTestPart u
-- <>) $ map showh $
---- (IM.toList . IM.filter (\itloc -> itloc ^? ilCrID == Just 0) $ (u ^. uvWorld . cWorld . lWorld . itemLocations)) <>
src/Dodge/Update.hs
+11 -5
View File
@@ -6,6 +6,7 @@ Description : Simulation update
-}
module Dodge.Update (updateUniverse) where
import Data.Monoid
import NewInt
import Control.Monad
import Dodge.Update.Input.InGame
@@ -384,10 +385,12 @@ updateCreatureSoundPositions w =
--updateIMr :: (World -> IM.IntMap a) -> (a -> a -> World -> World) -> World -> World
--updateIMr fim fup w = foldr (dbArg fup) w (fim w)
updateIMl :: (World -> IM.IntMap a) -> (a -> a -> World -> World) -> World -> World
updateIMl fim fup w = foldl' (flip $ dbArg fup) w (fim w)
updateIMl fim fup w = alaf Endo foldMap (dbArg fup) (fim w) w
--updateIMl fim fup w = foldl' (flip $ dbArg fup) w (fim w)
updateIMl' :: (World -> IM.IntMap a) -> (a -> World -> World) -> World -> World
updateIMl' fim fup w = foldl' (flip fup) w (fim w)
updateIMl' fim fup w = alaf Endo foldMap fup (fim w) w
--updateIMl' fim fup w = foldl' (flip fup) w (fim w)
updateCreatureGroups :: World -> World
updateCreatureGroups w =
@@ -561,10 +564,13 @@ ppEvents :: World -> World
ppEvents w = IM.foldl' (flip $ \pp -> doPressPlateEvent (_ppEvent pp) pp) w $ w ^. cWorld . lWorld . pressPlates
updateSeenWalls :: World -> World
updateSeenWalls w = foldl' markWallSeen w (map (_wlID . snd) $ allVisibleWalls w)
updateSeenWalls w = alaf Endo foldMap (markWallSeen . _wlID . snd) (allVisibleWalls w) w
--updateSeenWalls w = foldl' markWallSeen w (map (_wlID . snd) $ allVisibleWalls w)
markWallSeen :: World -> Int -> World
markWallSeen w i = w & cWorld . seenWalls . at i ?~ ()
markWallSeen :: Int -> World -> World
markWallSeen i = cWorld . seenWalls . at i ?~ ()
--markWallSeen :: World -> Int -> World
--markWallSeen w i = w & cWorld . seenWalls . at i ?~ ()
--markWallSeen !w !i = w & cWorld . lWorld . walls %~ IM.adjust markSeen i
-- in the past there might have been a space leak, which the following was meant
src/Dodge/WorldEffect.hs
+1 -1
View File
@@ -49,7 +49,7 @@ doWdWd we = case we of
doItCrWdWd :: ItCrWdWd -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
doItCrWdWd icww = case icww of
ItCrWdId -> \_ _ -> id
ItCrWdItemEffect -> flip itemEffect
ItCrWdItemEffect -> flip itemUseEffect
accessTerminal :: Maybe Int -> World -> World
accessTerminal mtmid w = fromMaybe w $ do
src/NewInt.hs
+1 -1
View File
@@ -13,7 +13,7 @@ import Data.Aeson
import Data.Aeson.TH
newtype NewInt a = NInt { _unNInt :: Int}
deriving newtype (Eq,Ord,Show,Num,Read)
deriving newtype (Eq,Ord,Show,Num,Read,Integral,Real,Enum)
newtype NewIntMap a b = NIntMap { _unNIntMap :: IM.IntMap b}
deriving (Eq,Ord,Show,Read)
tags
+306 -312
View File
File diff suppressed because it is too large Load Diff