From ec51efabcaca9ff43d14dc145f39ac44de12ca98 Mon Sep 17 00:00:00 2001 From: justin Date: Sat, 11 Dec 2021 23:11:13 +0000 Subject: [PATCH] Set lasGun muzzle position correctly --- src/Dodge/Creature/Action.hs | 7 +-- src/Dodge/Creature/Impulse.hs | 71 +++++++++++++------------- src/Dodge/Item/Weapon/BatteryGuns.hs | 24 ++++----- src/Dodge/Placement/Instance/Turret.hs | 4 +- 4 files changed, 47 insertions(+), 59 deletions(-) diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index 47509a12d..a600d3ab0 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -2,8 +2,7 @@ {- | Actions performed by creatures within the world -} module Dodge.Creature.Action - ( performActionsR - , performActions + ( performActions , stripNoItems , setMinInvSize , dropUnselected @@ -42,7 +41,6 @@ import Control.Lens --import Control.Applicative import Data.Maybe import Data.List (findIndex) -import Control.Monad.Reader --import qualified Data.Map as M performActions :: World -> Creature -> Creature performActions w cr = cr @@ -51,9 +49,6 @@ performActions w cr = cr where (iss, mayas) = unzip $ map (performAction cr w) $ cr ^. crActionPlan . crAction -performActionsR :: Creature -> Reader World Creature -performActionsR cr = reader $ \w -> performActions w cr - type OutAction = ( [Impulse] , Maybe Action ) performAimAt :: Creature -> World -> Int -> Point2 -> OutAction diff --git a/src/Dodge/Creature/Impulse.hs b/src/Dodge/Creature/Impulse.hs index 05bf5489b..252c1ac0f 100644 --- a/src/Dodge/Creature/Impulse.hs +++ b/src/Dodge/Creature/Impulse.hs @@ -1,6 +1,8 @@ +{-# LANGUAGE TupleSections #-} module Dodge.Creature.Impulse ( impulsiveAI , followImpulses + , followThenClearImpulses ) where import Dodge.Data import Dodge.Creature.Vocalization @@ -19,51 +21,50 @@ impulsiveAI :: (World -> Creature -> Creature) -> Creature -> World -> (World -> World , Creature) -impulsiveAI impf cr w = followImpulses w $ impf w cr +impulsiveAI f cr w = followImpulses w $ f w cr + +followThenClearImpulses :: World -> Creature -> (World -> World, Creature) +followThenClearImpulses w = second f . followImpulses w + where + f = crActionPlan . crImpulse .~ [] followImpulses :: World -> Creature -> (World -> World, Creature) -followImpulses w cr = foldr - foldf - (id, cr) - (_crImpulse $ _crActionPlan cr) +followImpulses w cr = foldr f (id, cr) (_crImpulse $ _crActionPlan cr) where - foldf imp (f,cr') = first ( . f) $ followImpulse cr' w imp + f imp (theupdate,cr') = first (. theupdate) $ followImpulse cr' w imp followImpulse :: Creature -> World -> Impulse -> (World -> World , Creature) followImpulse cr w imp = case imp of - Bark sid -> (soundStart (CrMouth cid) cpos sid Nothing, resetCrVocCoolDown cr) - Move p -> (id, crMvBy p cr) - MoveForward x -> (id, crMvForward x cr) - Turn a -> (id, creatureTurn a cr) - TurnToward p a -> (id, creatureTurnToward p a cr) - TurnTo p -> (id, creatureTurnTo p cr) - ChangePosture post -> (id, cr & crStance . posture .~ post) - UseItem -> (tryUseItem cr, cr) - SwitchToItem i -> (id, cr & crInvSel .~ i) - Melee cid' -> (hitCr cid' + Bark sid -> (soundStart (CrMouth cid) cpos sid Nothing, resetCrVocCoolDown cr) + Move p -> crup $ crMvBy p cr + MoveForward x -> crup $ crMvForward x cr + Turn a -> crup $ creatureTurn a cr + TurnToward p a -> crup $ creatureTurnToward p a cr + TurnTo p -> crup $ creatureTurnTo p cr + ChangePosture post -> crup $ cr & crStance . posture .~ post + UseItem -> (tryUseItem cr, cr) + SwitchToItem i -> crup $ cr & crInvSel .~ i + Melee cid' -> (hitCr cid' , crMvBy (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crMeleeCooldown .~ 20) - RandomTurn a -> (id, creatureTurn (rr a) cr) - MakeSound sid -> ( soundStart (CrSound (_crID cr)) (_crPos cr) sid Nothing , cr ) - DropItem -> undefined - ChangeStrategy strat -> (id, cr & crActionPlan . crStrategy .~ strat) - AddGoal gl -> (id, cr & crActionPlan . crGoal .:~ gl ) - ArbitraryImpulseFunction f -> (id, f w cr) - ArbitraryImpulse f -> followImpulse cr w (f cr w) - ImpulseUseTargetCID f -> case cr ^? crIntention . targetCr . _Just of + RandomTurn a -> crup $ creatureTurn (rr a) cr + MakeSound sid -> ( soundStart (CrSound (_crID cr)) (_crPos cr) sid Nothing , cr ) + DropItem -> undefined + ChangeStrategy strat -> crup $ cr & crActionPlan . crStrategy .~ strat + AddGoal gl -> crup $ cr & crActionPlan . crGoal .:~ gl + ArbitraryImpulseFunction f -> crup $ f w cr + ArbitraryImpulse f -> followImpulse cr w (f cr w) + ImpulseUseTargetCID f -> case cr ^? crIntention . targetCr . _Just of Just tcr -> followImpulse cr w (f $ _crID tcr) - _ -> (id,cr) + _ -> crup cr ImpulseUseTarget f -> case cr ^? crIntention . targetCr . _Just of Just tcr -> followImpulse cr w (f tcr) - _ -> (id,cr) --- ImpulseUseTarget f -> fromMaybe (id,cr) $ do --- cid <- cr ^? crIntention . targetCr . _Just --- tcr <- w ^? creatures . ix cid --- return $ followImpulse cr w (f tcr) + _ -> crup cr ImpulseUseAheadPos f -> followImpulse cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr))) - MvForward -> (id, crMvForward speed cr) - MvTurnToward p -> (id, creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr) --- _ -> (id , cr) + MvForward -> crup $ crMvForward speed cr + MvTurnToward p -> crup + $ creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr where + crup = (id,) mvType = _crMvType cr speed = _mvSpeed mvType turnRad = _mvTurnRad mvType @@ -72,6 +73,6 @@ followImpulse cr w imp = case imp of cid = _crID cr posFromID cid' = _crPos $ _creatures w IM.! cid' rr a = fst $ randomR (-a,a) $ _randGen w - hitCr i = over (creatures . ix i . crState . crDamage) (addDam i) + hitCr i = (creatures . ix i . crState . crDamage %~ addDam i) . soundStart (CrSound cid) cpos hitS Nothing - addDam i dams = Blunt 100 cpos (posFromID i) (posFromID i) : dams + addDam i = ( Blunt 100 cpos (posFromID i) (posFromID i) : ) diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index b65680b68..cf5d306b4 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -6,6 +6,7 @@ module Dodge.Item.Weapon.BatteryGuns ) where import Dodge.Data +import Dodge.Creature.HandPos import Dodge.Particle.TeslaArc import Dodge.SoundLogic.LoadSound import Dodge.WorldEvent @@ -24,11 +25,11 @@ import Picture import Shape import ShapePicture import Dodge.Picture +import LensHelp -import Data.Function +--import Data.Function --import qualified Data.Sequence as Seq import Data.List -import Control.Lens import System.Random --import Data.Maybe import Data.Tuple @@ -76,7 +77,7 @@ lasGun = defaultAutoGun , _ammoLoaded = 200 , _reloadTime = 80 } - , _itUse = ruseInstant (const aLaser) NoHammer + , _itUse = ruseInstant aLaser NoHammer [ ammoCheckI , withTempLight 1 100 (V3 1 1 0) , withSoundForI tone440sawtoothquietS 2 @@ -146,7 +147,7 @@ tractorGun = lasGun aTeslaArc :: Creature -> World -> World aTeslaArc cr w = set randGen g w - & particles %~ (makeTeslaArcAt col pos dir :) + & particles .:~ makeTeslaArcAt col pos dir where pos = _crPos cr +.+ (_crRad cr +1) *.* unitVectorAtAngle dir dir = _crDir cr @@ -157,20 +158,14 @@ aTeslaArc cr w = set randGen g w chooseColor 2 = blue chooseColor _ = cyan -aLaser :: Creature -> World -> World -aLaser cr = particles %~ (makeLaserAt phasev pos dir : ) +aLaser :: Item -> Creature -> World -> World +aLaser it cr = particles .:~ makeLaserAt phasev pos dir where - pos = _crPos cr +.+ ((_crRad cr +3) *.* unitVectorAtAngle dir) + pos = _crPos cr +.+ (aimingMuzzlePos cr it) *.* unitVectorAtAngle dir dir = _crDir cr phasev = _phaseV . _itParams $ _crInv cr IM.! j j = _crInvSel cr ---charToPhaseV :: Fractional p => Char -> p ---charToPhaseV 'V' = 0.2 ---charToPhaseV '/' = 1 ---charToPhaseV 'Z' = 5 ---charToPhaseV _ = error "Trying to set an undefined phaseV" - makeLaserAt :: Float -> Point2 -> Float -> Particle makeLaserAt phasev pos dir = Particle { _ptDraw = const blank @@ -232,7 +227,7 @@ moveLaser phasev pos dir w pt ] aTractorBeam :: Item -> Creature -> World -> World -aTractorBeam _ cr w = over props (IM.insert i (tractorBeamAt i spos outpos dir)) w +aTractorBeam _ cr w = w & props . at i ?~ tractorBeamAt i spos outpos dir where i = newProjectileKey w cpos = _crPos cr @@ -254,7 +249,6 @@ tractorBeamAt i pos outpos dir = ProjectileTimed } where d = unitVectorAtAngle dir - {- | The interaction of this with objects, walls etc needs more thought. -} updateTractor :: Prop -> World -> World diff --git a/src/Dodge/Placement/Instance/Turret.hs b/src/Dodge/Placement/Instance/Turret.hs index 1140a73e7..48f0f2249 100644 --- a/src/Dodge/Placement/Instance/Turret.hs +++ b/src/Dodge/Placement/Instance/Turret.hs @@ -75,9 +75,7 @@ updateTurret rotSpeed mc w & crRad .~ 1 & crDir .~ mcdir & crPict .~ (\cr _ _ -> drawCrEquipment cr) - -- & crPict .~ basicCrPict red - -- & crUpdate .~ (\cr -> crUpCrUp stepReloading cr . invSideEff cr) - & crUpdate .~ stateUpdateDamage clearDamage (flip followImpulses) + & crUpdate .~ stateUpdateDamage clearDamage (flip followThenClearImpulses) & crStance . posture .~ Aiming Just cid -> w' & creatures . ix cid . crPos .~ mcpos