diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index 1d4c13ba5..d7d4c5821 100644 --- a/src/Dodge/Base.hs +++ b/src/Dodge/Base.hs @@ -14,11 +14,11 @@ import Dodge.Data import Dodge.Base.Zone import Dodge.Base.Window import Dodge.Base.Collide ---import Dodge.Config.Data import Geometry import Picture import Control.Lens + --import Control.Monad.State import Data.List --import Data.Function diff --git a/src/Dodge/Config/KeyConfig.hs b/src/Dodge/Config/KeyConfig.hs index ed7162c3f..5c27d13f0 100644 --- a/src/Dodge/Config/KeyConfig.hs +++ b/src/Dodge/Config/KeyConfig.hs @@ -1,5 +1,5 @@ {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} +--{-# LANGUAGE OverloadedStrings #-} module Dodge.Config.KeyConfig where --import Data.Aeson diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 5dc9429ff..0d394e99d 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -7,12 +7,12 @@ module Dodge.Creature , spreadGunCrit , autoCrit , chaseCrit + , armourChaseCrit , smallChaseCrit ) where --import Dodge.Creature.Stance.Data import Dodge.Creature.State.Data -import Dodge.Creature.ImpulseRat --import Dodge.Creature.ReaderUpdate --import Dodge.Creature.AlertLevel --import Dodge.Creature.SetTarget @@ -25,6 +25,7 @@ import Dodge.Creature.LtAutoCrit import Dodge.Creature.SpreadGunCrit import Dodge.Creature.AutoCrit import Dodge.Creature.ChaseCrit +import Dodge.Creature.ArmourChase import Dodge.Data import Dodge.Default import Dodge.Base @@ -37,7 +38,7 @@ import Dodge.Creature.Inanimate import Dodge.Creature.State import Dodge.Creature.Picture import Dodge.Creature.Rationality -import Dodge.Creature.ChooseTarget +--import Dodge.Creature.ChooseTarget --import Dodge.Item import Dodge.Picture.Layer import Picture @@ -61,16 +62,6 @@ spawnerCrit = defaultCreature , _crPict = basicCrPict blue , _crInv = IM.empty -- IM.fromList [(0,frontArmour)] } -armourChaseCrit :: Creature -armourChaseCrit = defaultCreature - { _crUpdate = stateUpdate $ meleeCooldown $ impulsiveAI $ chaseTarget targetYouLOS - , _crHP = 300 - , _crPict = basicCrPict green - , _crInv = IM.fromList - [(0,frontArmour) - ,(1,medkit 200) - ] - } miniGunCrit :: Creature miniGunCrit = defaultCreature { _crPict = basicCrPict red @@ -174,7 +165,7 @@ startInventory = IM.fromList (zip [0..20] ,lasGun ,autoGun ,flamer - --,poisonSprayer + ,poisonSprayer ,launcher --,lasGun --,grenade diff --git a/src/Dodge/Creature/ArmourChase.hs b/src/Dodge/Creature/ArmourChase.hs new file mode 100644 index 000000000..06c11268e --- /dev/null +++ b/src/Dodge/Creature/ArmourChase.hs @@ -0,0 +1,35 @@ +module Dodge.Creature.ArmourChase + where +import Dodge.Data +import Dodge.Default +import Dodge.Creature.State +import Dodge.Creature.Rationality +import Dodge.Creature.ReaderUpdate +import Dodge.Creature.AlertLevel +import Dodge.Creature.ChooseTarget +import Dodge.Creature.Picture +import Dodge.Item.Equipment +import Dodge.Item.Consumable +import Picture + +import qualified Data.IntMap.Strict as IM +import Control.Lens +import Control.Monad.Reader + +armourChaseCrit :: Creature +armourChaseCrit = defaultCreature + { _crUpdate = stateUpdate $ impulsiveAIR $ + doStrategyActionsR >=> + performActionsR >=> + overrideMeleeCloseTargetR >=> + chaseTargetR targetYouLOS >=> + basicPerceptionUpdateR [0] >=> + targetYouWhenCognizantR >=> + return . (crMeleeCooldown . _Just %~ (max 0 . subtract 1)) + , _crHP = 300 + , _crPict = basicCrPict green + , _crInv = IM.fromList + [(0,frontArmour) + ,(1,medkit 200) + ] + } diff --git a/src/Dodge/Creature/AutoCrit.hs b/src/Dodge/Creature/AutoCrit.hs index f24a40854..7c25c8143 100644 --- a/src/Dodge/Creature/AutoCrit.hs +++ b/src/Dodge/Creature/AutoCrit.hs @@ -21,7 +21,7 @@ import qualified Data.IntMap.Strict as IM autoCrit :: Creature autoCrit = defaultCreature { _crPict = basicCrPict red - , _crUpdate = stateUpdate $ impulsiveAIR $ sentinelAI + , _crUpdate = stateUpdate $ impulsiveAIR sentinelAI , _crActionPlan = ActionPlan { _crImpulse = [] , _crAction = [] diff --git a/src/Dodge/Creature/Boid.hs b/src/Dodge/Creature/Boid.hs new file mode 100644 index 000000000..cb917f719 --- /dev/null +++ b/src/Dodge/Creature/Boid.hs @@ -0,0 +1,255 @@ +module Dodge.Creature.Boid + where +import Dodge.Data +import Dodge.Base +import Dodge.Creature.State.Data +import Dodge.Creature.ImpulseRat +import Geometry + +import Control.Monad.Reader +import Control.Lens +import qualified Data.IntMap as IM + +interpWith :: Float -> Point2 -> Point2 -> Point2 +interpWith x a b = x *.* a +.+ (1 - x) *.* b + +invertEncircleDistP :: Float -> Creature -> Point2 -> Creature -> Point2 +invertEncircleDistP d tcr cenp cr = ypos +.+ + d *.* (reflectIn (cenp -.- ypos) $ safeNormalizeV (cpos -.- cenp)) + where + cpos = _crPos cr + ypos = _crPos tcr + +encircleDistP :: Float -> Creature -> Point2 -> Creature -> Point2 +encircleDistP d tcr cenp cr = ypos +.+ d *.* safeNormalizeV (cpos -.- cenp) + where + cpos = _crPos cr + ypos = _crPos tcr + +encircleP :: Creature -> Point2 -> Creature -> Point2 +encircleP tcr cenp cr = ypos +.+ 50 *.* safeNormalizeV (cpos -.- cenp) + where + cpos = _crPos cr + ypos = _crPos tcr + --f x = 150 * sigmoid (x-10) + +encircleCloseP :: Creature -> Point2 -> Creature -> Point2 +encircleCloseP tcr cenp cr = ypos +.+ f (max 0 (magV (ypos -.- cenp) - 80) ) *.* safeNormalizeV (cpos -.- cenp) + where + cpos = _crPos cr + ypos = _crPos tcr + f x = 150 * sigmoid (x-10) + +forbidFlee + :: (Creature -> Point2 -> Creature -> Point2) + -> Creature + -> Point2 + -> Creature + -> Point2 +forbidFlee f tcr cenp cr + | ptargTest = tpos + | otherwise = ptarg + where + cpos = _crPos cr + tpos = _crPos tcr + ptarg = f tcr cenp cr + ptargTest = isLHS cpos (cpos +.+ rotateV (negate (pi/2)) (cpos -.- tpos)) ptarg + -- && isRHS cpos (cpos +.+ rotateV (pi/3) (cpos -.- tpos)) ptarg + --targBehindCrit = isLHS cpos (vNormal $ cpos +.+ unitVectorAtAngle (_crDir cr)) ptarg + +pincerP :: Creature -> Point2 -> Creature -> Point2 +pincerP tcr cenp cr = tpos +.+ splitp -- +.+ 25 *.* (normalizeV $ tpos -.- cenp) + where + cpos = _crPos cr + tpos = _crPos tcr + splitp + | isLHS cenp cpos tpos + = 150 *.* orthCenpTpos + | otherwise + = negate 150 *.* orthCenpTpos + --d = min 150 (dist cpos tpos) + --orthCenpTpos = safeNormalizeV (vNormal $ tpos -.- cpos) + orthCenpTpos = safeNormalizeV (vNormal $ tpos -.- cenp) + +pincerP''' :: Creature -> Point2 -> Creature -> Point2 +pincerP''' tcr cenp cr = interpWith (sigmoid $ 0.05 * dtcen) cenawayp cenclosep + where + cpos = _crPos cr + tpos = _crPos tcr + dtcen = dist tpos cenp + f x = 150 * sigmoid (x-10) + cenawayp + | dist cenp tpos < dist cpos tpos = tpos +.+ splitp + | otherwise = cenp +.+ splitp + splitp + | isLHS cenp cpos tpos + = f (max 0 (magV (tpos -.- cenp) - 80) ) *.* orthCenpTpos + | otherwise + = negate ( f $ max 0 $ magV (tpos -.- cenp) - 80) *.* orthCenpTpos + orthCenpTpos = safeNormalizeV (vNormal $ tpos -.- cenp) + cenclosep + = tpos +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* safeNormalizeV (cpos -.- cenp) + +pincerP' :: Creature -> Point2 -> Creature -> Point2 +pincerP' tcr cenp cr + | dist cenp tpos > dist cpos tpos + = cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* safeNormalizeV (cpos -.- cenp) + | otherwise = tpos +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* safeNormalizeV (cpos -.- cenp) + where + cpos = _crPos cr + tpos = _crPos tcr + f x = 150 * sigmoid (x-10) + +pincerP'' :: Creature -> Point2 -> Creature -> Point2 +pincerP'' tcr cenp cr + | dist cenp tpos > dist cpos tpos && isLHS cenp cpos tpos + = cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* safeNormalizeV (vNormal $ tpos -.- cenp) + | dist cenp tpos > dist cpos tpos + = cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* safeNormalizeV (vNormal $ cenp -.- tpos) + | otherwise = tpos +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* safeNormalizeV (cpos -.- cenp) + where + cpos = _crPos cr + tpos = _crPos tcr + f x = 150 * sigmoid (x-10) + +encircle :: Creature -> IM.IntMap Creature -> Creature -> Point2 +encircle tcr crs cr + | length crs <= 1 = ypos + | otherwise = ypos +.+ f (max 0 (magV (ypos -.- cenp) - 80) ) *.* safeNormalizeV (cpos -.- cenp) + where + cpos = _crPos cr + ypos = _crPos tcr + f x = 150 * sigmoid (x-10) + cenp = centroid (map _crPos $ IM.elems crs) + +lineOrth :: Creature -> IM.IntMap Creature -> Creature -> Point2 +lineOrth tcr crs cr = p + where + ypos = _crPos tcr + cpos = _crPos cr + ps = map _crPos $ IM.elems crs + cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps + p | dist cen ypos < 20 = ypos + | otherwise = errorClosestPointOnLine 500 ypos (ypos +.+ vNormal (cen -.- ypos)) cpos + +holdForm :: Creature -> IM.IntMap Creature -> Creature -> Point2 +holdForm ycr crs cr = p + where + ypos = _crPos ycr + cpos = _crPos cr + ps = map _crPos $ IM.elems crs + cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps + p | dist cen ypos < 20 = ypos + | otherwise = ypos +.+ cpos -.- cen + +lineUp :: Creature -> IM.IntMap Creature -> Creature -> Point2 +lineUp ycr crs cr = p + where + ypos = _crPos ycr + cpos = _crPos cr + ps = map _crPos $ IM.elems crs + cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps + p = (0.05 *.* ypos) +.+ (0.95 *.* errorClosestPointOnLine 500 cen ypos cpos) + +-- not nice, a kind of encircle +spreadOut :: Creature -> IM.IntMap Creature -> Creature -> Point2 +spreadOut ycr crs cr = p + where + ypos = _crPos ycr + cpos = _crPos cr + ps = map _crPos $ IM.elems crs + cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps + p | dist cen ypos < 30 = ypos + | otherwise = ypos +.+ (spreadFactor *.* cpos -.- cen) + spreadFactor + | dist ypos cpos > 90 = 1 + | otherwise = 1.5 + +swarmUsingCenter + :: (Creature -> Point2 -> Creature -> Creature) + -> (Point2 -> Creature -> Creature) + -> World + -> Creature + -> Creature +swarmUsingCenter updT upd w cr = case _crTarget cr of + Nothing -> upd cenp cr + Just tcr -> updT tcr cenp cr + where + cid = _crID cr + cenp = _crGroupCenter $ _creatureGroups w IM.! _crGroupID (_crGroup $ _creatures w IM.! cid) + +flockChaseTarget + :: (Creature -> IM.IntMap Creature -> Creature -> Creature) -- ^ Update with target + -> (IM.IntMap Creature -> Creature -> Creature) -- ^ Update without target + -> World + -> Creature + -> Creature +flockChaseTarget updT upd w cr = case _crTarget cr of + Nothing -> upd crs cr + Just tcr -> updT tcr crs cr + where + is = _swarm $ _crGroup cr + crs = IM.restrictKeys (_creatures w) is + +flockPointTarget + :: (Creature -> IM.IntMap Creature -> Creature -> Point2) + -> (Creature -> World -> Maybe Creature) -- ^ Function for determining target + -> World + -> Creature + -> Creature +flockPointTarget f targFunc w cr = case targFunc cr w of + Nothing -> cr + Just crTarg -> cr & crActionPlan . crImpulse .~ mvPointMeleeTarg p cr crTarg + where + is = _swarm $ _crGroup cr + crs = IM.restrictKeys (_creatures w) is + p = f crTarg crs cr + +flockToPointUsing + :: (Creature -> Point2 -> Creature -> Point2) + -> (Point2 -> Creature -> Creature -> [Impulse]) + -> Creature + -> Reader World Creature +flockToPointUsing pf mvf cr = reader $ \w -> case _crTarget cr of + Nothing -> cr + Just tcr -> cr & crActionPlan . crImpulse .~ mvf ptarg cr tcr + where + cenp = _crGroupCenter $ _creatureGroups w IM.! _crGroupID (_crGroup cr) + ptarg = pf tcr cenp cr + +flockFunc + :: (Creature -> Point2 -> Creature -> Point2) + -> (Creature -> World -> Maybe Creature) -- ^ Function for determining target + -> Creature + -> Reader World Creature +flockFunc f targFunc cr = reader $ \w -> case targFunc cr w of + Nothing -> cr + Just crTarg -> cr & crActionPlan . crImpulse .~ mvPointMeleeTarg p cr crTarg + where + cenp = _crGroupCenter $ _creatureGroups w IM.! (_crGroupID (_crGroup cr)) + p = f crTarg cenp cr + +flockCenterFunc + :: (Creature -> Point2 -> Creature -> Point2) + -> (Creature -> World -> Maybe Creature) -- ^ Function for determining target + -> Creature + -> Reader World Creature +flockCenterFunc f targFunc cr = reader $ \w -> case targFunc cr w of + Nothing -> cr + Just crTarg -> cr & crActionPlan . crImpulse .~ mvPointMeleeTarg p cr crTarg + where + cenp = _crGroupCenter $ _creatureGroups w IM.! (_crGroupID (_crGroup cr)) + p = f crTarg cenp cr + +flockPointTargetR + :: (Creature -> IM.IntMap Creature -> Creature -> Point2) + -> (Creature -> World -> Maybe Creature) -- ^ Function for determining target + -> Creature + -> Reader World Creature +flockPointTargetR f targFunc cr = reader $ \w -> case targFunc cr w of + Nothing -> cr + Just crTarg -> cr & crActionPlan . crImpulse .~ mvPointMeleeTarg p cr crTarg + where + is = _swarm $ _crGroup cr + crs = IM.restrictKeys (_creatures w) is + p = f crTarg crs cr diff --git a/src/Dodge/Creature/ImpulseRat.hs b/src/Dodge/Creature/ImpulseRat.hs index e6e384ee8..dadee1de4 100644 --- a/src/Dodge/Creature/ImpulseRat.hs +++ b/src/Dodge/Creature/ImpulseRat.hs @@ -1,130 +1,14 @@ module Dodge.Creature.ImpulseRat where import Dodge.Data -import Dodge.Base +--import Dodge.Base --import Dodge.Creature.ChooseTarget -import Dodge.Creature.State.Data +--import Dodge.Creature.State.Data import Geometry -import qualified Data.IntMap as IM +--import qualified Data.IntMap as IM import Control.Lens -import Control.Monad.Reader - -encircle :: Creature -> IM.IntMap Creature -> Creature -> Point2 -encircle tcr crs cr - | length crs <= 1 = ypos - | otherwise = ypos +.+ f (max 0 (magV (ypos -.- cenp) - 80) ) *.* safeNormalizeV (cpos -.- cenp) - where - cpos = _crPos cr - ypos = _crPos tcr - f x = 150 * sigmoid (x-10) - cenp = (1 / fromIntegral (length crs)) *.* foldr1 (+.+) (map _crPos $ IM.elems crs) - -lineOrth :: Creature -> IM.IntMap Creature -> Creature -> Point2 -lineOrth tcr crs cr = p - where - ypos = _crPos tcr - cpos = _crPos cr - ps = map _crPos $ IM.elems crs - cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps - p | dist cen ypos < 20 = ypos - | otherwise = errorClosestPointOnLine 500 ypos (ypos +.+ vNormal (cen -.- ypos)) cpos - -holdForm :: Creature -> IM.IntMap Creature -> Creature -> Point2 -holdForm ycr crs cr = p - where - ypos = _crPos ycr - cpos = _crPos cr - ps = map _crPos $ IM.elems crs - cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps - p | dist cen ypos < 20 = ypos - | otherwise = ypos +.+ cpos -.- cen - -lineUp :: Creature -> IM.IntMap Creature -> Creature -> Point2 -lineUp ycr crs cr = p - where - ypos = _crPos ycr - cpos = _crPos cr - ps = map _crPos $ IM.elems crs - cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps - p = (0.05 *.* ypos) +.+ (0.95 *.* errorClosestPointOnLine 500 cen ypos cpos) - --- not nice, a kind of encircle -spreadOut :: Creature -> IM.IntMap Creature -> Creature -> Point2 -spreadOut ycr crs cr = p - where - ypos = _crPos ycr - cpos = _crPos cr - ps = map _crPos $ IM.elems crs - cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps - p | dist cen ypos < 30 = ypos - | otherwise = ypos +.+ (spreadFactor *.* cpos -.- cen) - spreadFactor - | dist ypos cpos > 90 = 1 - | otherwise = 1.5 - -swarmUsingCenter - :: (Creature -> Point2 -> Creature -> Creature) - -> (Point2 -> Creature -> Creature) - -> World - -> Creature - -> Creature -swarmUsingCenter updT upd w cr = case _crTarget cr of - Nothing -> upd cenp cr - Just tcr -> updT tcr cenp cr - where - cid = _crID cr - cenp = _crGroupCenter $ _creatureGroups w IM.! (_crGroupID $ _crGroup $ _creatures w IM.! cid) - -flockChaseTarget - :: (Creature -> IM.IntMap Creature -> Creature -> Creature) -- ^ Update with target - -> (IM.IntMap Creature -> Creature -> Creature) -- ^ Update without target - -> World - -> Creature - -> Creature -flockChaseTarget updT upd w cr = case _crTarget cr of - Nothing -> upd crs cr - Just tcr -> updT tcr crs cr - where - is = _swarm $ _crGroup cr - crs = IM.restrictKeys (_creatures w) is - -flockPointTarget - :: (Creature -> IM.IntMap Creature -> Creature -> Point2) - -> (Creature -> World -> Maybe Creature) -- ^ Function for determining target - -> World - -> Creature - -> Creature -flockPointTarget f targFunc w cr = case targFunc cr w of - Nothing -> cr - Just crTarg -> cr & crActionPlan . crImpulse .~ chaseTarg' p cr crTarg - where - is = _swarm $ _crGroup cr - crs = IM.restrictKeys (_creatures w) is - p = f crTarg crs cr - -flockPointTargetR - :: (Creature -> IM.IntMap Creature -> Creature -> Point2) - -> (Creature -> World -> Maybe Creature) -- ^ Function for determining target - -> Creature - -> Reader World Creature -flockPointTargetR f targFunc cr = reader $ \w -> case targFunc cr w of - Nothing -> cr - Just crTarg -> cr & crActionPlan . crImpulse .~ chaseTarg' p cr crTarg - where - is = _swarm $ _crGroup cr - crs = IM.restrictKeys (_creatures w) is - p = f crTarg crs cr - - ---swarmUseCenter --- :: (Creature -> Point2 -> Creature -> Point2) --- :: (Creature -> IM.IntMap Creature -> Creature -> Point2) --- -> (Creature -> World -> Maybe Creature) -- ^ Function for determining target --- -> World --- -> Creature --- -> Creature ---swarmUseCenter +--import Control.Monad.Reader chaseTarget @@ -149,9 +33,34 @@ overrideMeleeCloseTarget _ cr = case _crTarget cr of where cpos = _crPos cr +meleeHeadingMove + :: Float -- ^ max turn speed + -> Float -- ^ min turn speed + -> Float -- ^ turn speed cutoff angle + -> Float -- ^ move speed + -> Point2 -- ^ target point + -> Creature -- ^ start creature + -> Creature -- ^ target creature + -> [Impulse] +meleeHeadingMove maxta minta tacutoff speed tp cr tcr + | dist tpos cpos < combinedRad + 5 + && abs (_crDir cr - argV (tpos -.- cpos)) < tacutoff + && _crMeleeCooldown cr == Just 0 + = [Melee (_crID tcr), Turn pi] + | dist tpos cpos < combinedRad + 5 + && abs (_crDir cr - argV (tpos -.- cpos)) < tacutoff + = [ TurnToward tpos minta ] + | abs (_crDir cr - argV (tp -.- cpos)) < tacutoff + = [MoveForward speed , TurnToward tp maxta , RandomTurn maxta ] + | otherwise = [MoveForward speed , TurnToward tp minta, RandomTurn maxta ] + where + cpos = _crPos cr + tpos = _crPos tcr + combinedRad = _crRad cr + _crRad tcr + -chaseTarg' :: Point2 -> Creature -> Creature -> [Impulse] -chaseTarg' p cr crT +mvPointMeleeTarg :: Point2 -> Creature -> Creature -> [Impulse] +mvPointMeleeTarg p cr crT | dist tpos cpos < combinedRad + 5 && abs (_crDir cr - argV (tpos -.- cpos)) < pi/4 && _crMeleeCooldown cr == Just 0 @@ -160,8 +69,8 @@ chaseTarg' p cr crT && abs (_crDir cr - argV (tpos -.- cpos)) < pi/4 = [ TurnToward tpos 0.05 ] | abs (_crDir cr - argV (p -.- cpos)) < pi/4 - = [MoveForward 2.5 , TurnToward p 0.2 , RandomTurn 0.2 ] - | otherwise = [MoveForward 2.5 , TurnToward p 0.05, RandomTurn 0.2 ] + = [MoveForward 3 , TurnToward p 0.2 , RandomTurn 0.2 ] + | otherwise = [MoveForward 3 , TurnToward p 0.05, RandomTurn 0.2 ] where cpos = _crPos cr tpos = _crPos crT diff --git a/src/Dodge/Creature/LauncherCrit.hs b/src/Dodge/Creature/LauncherCrit.hs index d86765c81..772352283 100644 --- a/src/Dodge/Creature/LauncherCrit.hs +++ b/src/Dodge/Creature/LauncherCrit.hs @@ -36,8 +36,9 @@ launcherCrit = defaultCreature >=> doStrategyActionsR >=> reloadOverrideR >=> targetYouWhenCognizantR - >=> (overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0)))) - $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait) + >=> overrideInternalR + (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0)))) + (\ _ -> crActionPlan . crStrategy .~ WatchAndWait) , _crActionPlan = ActionPlan { _crImpulse = [] , _crAction = [] diff --git a/src/Dodge/Creature/LtAutoCrit.hs b/src/Dodge/Creature/LtAutoCrit.hs index 11e7e4c9c..73ed4bb07 100644 --- a/src/Dodge/Creature/LtAutoCrit.hs +++ b/src/Dodge/Creature/LtAutoCrit.hs @@ -44,8 +44,9 @@ ltAutoCrit = defaultCreature >=> doStrategyActionsR >=> reloadOverrideR >=> targetYouWhenCognizantR - >=> (overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0)))) - $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait) + >=> overrideInternalR + (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0)))) + (\ _ -> crActionPlan . crStrategy .~ WatchAndWait) , _crActionPlan = ActionPlan { _crImpulse = [] , _crAction = [] diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index c30eb1e98..2471c13e1 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/src/Dodge/Creature/Picture.hs @@ -6,7 +6,7 @@ module Dodge.Creature.Picture , circLine ) where import Dodge.Data -import Dodge.Creature.Stance.Data +--import Dodge.Creature.Stance.Data import Dodge.Creature.State.Data --import Dodge.Creature.AlertLevel.Data import Dodge.Picture.Layer @@ -67,7 +67,7 @@ drawEquipment drawEquipment cr = pictures $ map f $ IM.toList (_crInv cr) where f (i,it) = case it ^? itEquipPict of - Just g | (cr ^? crStance . posture) == Just Aiming -> g cr i + Just g -> g cr i _ -> blank circLine :: Float -> Picture diff --git a/src/Dodge/Creature/Rationality.hs b/src/Dodge/Creature/Rationality.hs index 9ebba8811..e1e760e2e 100644 --- a/src/Dodge/Creature/Rationality.hs +++ b/src/Dodge/Creature/Rationality.hs @@ -28,7 +28,9 @@ impulsiveAIR -> (World -> World, StdGen) -> Creature -> ((World -> World, StdGen) , Maybe Creature) -impulsiveAIR impf w (f,g) cr = followImpulses w (f,g) . ($ w) . runReader . impf $ cr +impulsiveAIR impf w (f,g) = followImpulses w (f,g') . ($ w) . runReader . impf + where + (g',_) = split g impulsiveAI :: (World -> Creature -> Creature) -- ^ Internal AI update, should determine impulses diff --git a/src/Dodge/Creature/ReaderUpdate.hs b/src/Dodge/Creature/ReaderUpdate.hs index 574bb9ac7..55fddad72 100644 --- a/src/Dodge/Creature/ReaderUpdate.hs +++ b/src/Dodge/Creature/ReaderUpdate.hs @@ -67,7 +67,7 @@ reloadOverrideR cr | cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo == Just 0 && cr ^. crStance . posture == Aiming = return $ cr & crActionPlan . crStrategy .~ StrategyActions Reload reloadActions - | otherwise = return $ cr + | otherwise = return cr where reloadActions = [ holsterWeapon diff --git a/src/Dodge/Creature/SentinelAI.hs b/src/Dodge/Creature/SentinelAI.hs index 915361296..f8fdbb9d0 100644 --- a/src/Dodge/Creature/SentinelAI.hs +++ b/src/Dodge/Creature/SentinelAI.hs @@ -48,7 +48,6 @@ sentinelAI = sentinelExtraWatchUpdate ) ] >=> reloadOverrideR - where sentinelFireType :: (Int -> Action) @@ -66,8 +65,9 @@ sentinelFireType f = performActionsR >=> doStrategyActionsR >=> reloadOverrideR >=> targetYouWhenCognizantR - >=> (overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0)))) - $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait) + >=> overrideInternalR + (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0)))) + (\ _ -> crActionPlan . crStrategy .~ WatchAndWait) where drawwp = DoActionIfElse NoAction crIsAiming (DoActionThen drawWeapon (WaitThen 50 NoAction)) aiming = AimAtCloseSlow @@ -89,8 +89,8 @@ sentinelExtraWatchUpdate xs = performActionsR >=> doStrategyActionsR -- >=> reloadOverrideR >=> targetYouWhenCognizantR - >=> (overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0)))) - $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait) + >=> overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0)))) + (\ _ -> crActionPlan . crStrategy .~ WatchAndWait) shootAtAdvance :: Int -> [Action] diff --git a/src/Dodge/Creature/SpreadGunCrit.hs b/src/Dodge/Creature/SpreadGunCrit.hs index 3dfb4e4f8..553534c5a 100644 --- a/src/Dodge/Creature/SpreadGunCrit.hs +++ b/src/Dodge/Creature/SpreadGunCrit.hs @@ -44,8 +44,8 @@ spreadGunCrit = defaultCreature >=> doStrategyActionsR >=> reloadOverrideR >=> targetYouWhenCognizantR - >=> (overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0)))) - $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait) + >=> overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0)))) + (\ _ -> crActionPlan . crStrategy .~ WatchAndWait) , _crActionPlan = ActionPlan { _crImpulse = [] , _crAction = [] diff --git a/src/Dodge/Creature/SwarmCrit.hs b/src/Dodge/Creature/SwarmCrit.hs index c075372a6..4291cf134 100644 --- a/src/Dodge/Creature/SwarmCrit.hs +++ b/src/Dodge/Creature/SwarmCrit.hs @@ -5,10 +5,11 @@ module Dodge.Creature.SwarmCrit import Dodge.Data import Dodge.Default import Dodge.Creature.Picture +import Dodge.Creature.Boid --import Dodge.Creature.Test --import Dodge.Creature.ActionRat import Dodge.Creature.ImpulseRat -import Dodge.Creature.ChooseTarget +--import Dodge.Creature.ChooseTarget --import Dodge.Creature.SetTarget import Dodge.Creature.Rationality import Dodge.Creature.ReaderUpdate @@ -30,7 +31,7 @@ import Control.Monad.Reader swarmCrit :: Creature swarmCrit = defaultCreature { _crUpdate = stateUpdate $ impulsiveAIR $ - flockPointTargetR encircle targetYouLOS + flockToPointUsing (encircleDistP (100)) (meleeHeadingMove 0.1 0.1 (pi/4) 3.9) >=> return . (crMeleeCooldown . _Just %~ (max 0 . subtract 1)) >=> basicPerceptionUpdateR [0] >=> doStrategyActionsR @@ -46,3 +47,12 @@ swarmCrit = defaultCreature , _crFaction = ColorFaction yellow , _crMeleeCooldown = Just 0 } + +--swarmCritMoveFunc :: Creature -> Point2 -> Creature -> Point2 +--swarmCritMoveFunc tcr cenp cr +-- | targBehindCrit +-- where +-- cpos = _crPos cr +-- ypos = _crPos tcr + + diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index cf27b689c..b55c9f2de 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -24,7 +24,7 @@ yourControl w (f,g) cr = , Just . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed 0 cr ) where - speed = _varMovementSpeedModifier w * equipFactor + speed = 3 * equipFactor equipFactor = product $ map equipSpeed $ IM.elems $ _crInv $ _creatures w IM.! 0 {- | Turn key presses into creature movement. -} wasdWithAiming @@ -50,7 +50,6 @@ wasdWithAiming w speed i cr *.* rotateV (_cameraRot w) (_mousePos w) _ -> normalizeAngle $ argV (_mousePos w) + _cameraRot w - wasdM :: World -> SDL.Scancode -> Point2 wasdM w scancode | scancode == moveUpKey (_keyConfig w) = ( 0, 1) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 964fb2603..1058dc203 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -91,8 +91,6 @@ data World = World , _seenLocations :: IM.IntMap (World -> Point2,String) , _selLocation :: Int , _keyConfig :: KeyConfigSDL - , _varMovementSpeedModifier :: Float - , _varMovementStrafeSpeedModifier :: Float , _debugMode :: Bool , _config :: Configuration , _sideEffects :: [PreloadData SoundOrigin -> IO (PreloadData SoundOrigin)] diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 6cbb387a4..f1ccf3291 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -272,8 +272,6 @@ defaultWorld = World ] , _selLocation = 0 , _keyConfig = defaultKeyConfigSDL - , _varMovementSpeedModifier = 3 - , _varMovementStrafeSpeedModifier = 3 , _debugMode = True , _config = defaultConfig , _sideEffects = [] diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 872511123..f674c2075 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -125,7 +125,7 @@ wheelDownEvent w = case _carteDisplay w of upInvPos :: World -> World upInvPos w = stopSoundFrom (CrReloadSound 0) $ w - & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . (subtract 1) + & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract 1 where n = length $ IM.keys $ _crInv $ _creatures w IM.! _yourID w downInvPos :: World -> World diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index f50a6833f..6eab849b4 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -60,8 +60,6 @@ handlePressedKey _ scode w debugKey :: Scancode -> World -> Maybe World debugKey scancode w - | scancode == ScancodeF7 = Just $ w & varMovementSpeedModifier -~ 1 - | scancode == ScancodeF8 = Just $ w & varMovementSpeedModifier +~ 1 | scancode == ScancodeF5 = Just $ dropLight w | scancode == ScancodeF6 = Just $ dropLight' w debugKey _ w = Just w diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 73fc028f0..14d236cdf 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -50,14 +50,14 @@ roomTreex = do t = treeFromTrunk [[StartRoom] ,[Corridor] + ,[Corridor] ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 - & rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200] ]++) + & rmPS %~ ([sPS (0,50) 0 $ PutCrit armourChaseCrit ]++) ] ,[Corridor] ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 - & rmPS %~ ([sPS (0,50) 0 $ PutCrit autoCrit ]++) + & rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200,202] ]++) ] - ,[Corridor] ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 & rmPS %~ ([sPS (0,50) 0 $ PutCrit pistolCrit ]++) ] diff --git a/src/Dodge/Item/Consumable.hs b/src/Dodge/Item/Consumable.hs index 99e437db6..6f653aab1 100644 --- a/src/Dodge/Item/Consumable.hs +++ b/src/Dodge/Item/Consumable.hs @@ -21,7 +21,7 @@ medkit i = defaultConsumable , _itAmount = 1 , _cnEffect = heal i , _itFloorPict = onLayer FlItLayer $ color blue $ circleSolid 3 - , _itEquipPict = drawWeapon $ color blue $ circleSolid 3 + , _itEquipPict = pictureItem $ color blue $ circleSolid 3 , _itID = Nothing } diff --git a/src/Dodge/Item/Draw.hs b/src/Dodge/Item/Draw.hs index 00fd04fcf..3a547a05e 100644 --- a/src/Dodge/Item/Draw.hs +++ b/src/Dodge/Item/Draw.hs @@ -2,17 +2,32 @@ module Dodge.Item.Draw where import Dodge.Data import Dodge.Picture.Layer +import Dodge.Creature.Stance.Data import Picture {- | Places an item picture onto a creature when the item is selected. -} -drawWeapon +pictureWeaponOnAim :: Picture -> Creature -> Int -- ^ Position of item in inventory -> Picture -drawWeapon p cr posInInv +pictureWeaponOnAim p cr posInInv + | _crInvSel cr == posInInv && _posture (_crStance cr) == Aiming + = onLayer PtLayer drawnWep + | _crInvSel cr == posInInv + = onLayer PtLayer holsteredWep + | otherwise = blank + where + drawnWep = uncurry translate (_crRad cr,0) p + holsteredWep = uncurry translate (_crRad cr,0) (scale 0.1 1 p) + +pictureItem + :: Picture + -> Creature + -> Int -- ^ Position of item in inventory + -> Picture +pictureItem p cr posInInv | _crInvSel cr == posInInv = onLayer PtLayer drawnWep | otherwise = blank where drawnWep = uncurry translate (_crRad cr,0) p - diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 74d95271e..08cfeaa1c 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -59,7 +59,6 @@ pistol ,teslaLauncher ,remoteLauncher ,bezierGun - ,poisonSprayer ,defaultThrowable -- ,shatterGun ,longGun,flamer,blinkGun,forceFieldGun :: Item @@ -88,7 +87,7 @@ pistol = Weapon , _itAimingSpeed = 1 , _itAimingRange = 0 , _itZoom = defaultItZoom - , _itEquipPict = drawWeapon $ color green $ polygon $ rectNESW 3 3 (-3) (-3) + , _itEquipPict = pictureWeaponOnAim $ color green $ polygon $ rectNESW 3 3 (-3) (-3) , _itScrollUp = const id , _itScrollDown = const id , _itAttachment = Nothing @@ -137,7 +136,7 @@ autoGun = defaultGun , _itAimingSpeed = 0.4 , _itAimingRange = 1 , _itZoom = defaultItZoom {_itAimZoomFac = 1.5} - , _itEquipPict = drawWeapon $ color red $ polygon $ rectNESW 4 4 (-4) (-4) + , _itEquipPict = pictureWeaponOnAim $ color red $ polygon $ rectNESW 4 4 (-4) (-4) , _itEffect = wpRecock , _itAttachment = Just $ ItCharMode $ Seq.fromList "MS" , _itScrollUp = incCharMode @@ -174,7 +173,7 @@ rezGun = defaultGun , _itMaxStack = 1 , _itAimingSpeed = 0.4 , _itAimingRange = 0 - , _itEquipPict = drawWeapon $ color chartreuse $ pictures + , _itEquipPict = pictureWeaponOnAim $ color chartreuse $ pictures [polygon $ rectNESW 7 3 1 (-3) ,polygon $ rectNESW (-1) 3 (-7) (-3) ] @@ -200,7 +199,7 @@ teslaGun = defaultAutoGun , _itAimingSpeed = 0.4 , _itZoom = defaultItZoom , _itAimingRange = 0 - , _itEquipPict = drawWeapon $ color blue $ pictures + , _itEquipPict = pictureWeaponOnAim $ color blue $ pictures [polygon $ rectNESW 7 3 1 (-3) ,polygon $ rectNESW (-1) 3 (-7) (-3) ] @@ -222,7 +221,7 @@ lasGun = defaultAutoGun , _itMaxStack = 1 , _itAimingSpeed = 0.4 , _itAimingRange = 1 - , _itEquipPict = drawWeapon $ color blue $ polygon $ rectNESW 3 3 (-3) (-3) + , _itEquipPict = pictureWeaponOnAim $ color blue $ polygon $ rectNESW 3 3 (-3) (-3) , _itAttachment = Just $ ItCharMode $ Seq.fromList "/VZ" , _itScrollUp = incCharMode , _itScrollDown = decCharMode @@ -282,7 +281,7 @@ tractorGun = defaultAutoGun , _itMaxStack = 1 , _itAimingSpeed = 0.4 , _itAimingRange = 0.5 - , _itEquipPict = drawWeapon $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ] + , _itEquipPict = pictureWeaponOnAim $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ] } launcher = defaultGun { _itName = "ROCKO" @@ -301,7 +300,7 @@ launcher = defaultGun , _itMaxStack = 1 , _itAimingSpeed = 0.2 , _itAimingRange = 0.5 - , _itEquipPict = drawWeapon $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5) + , _itEquipPict = pictureWeaponOnAim $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5) , _itHammer = NoHammer , _itEffect = NoItEffect } @@ -390,7 +389,7 @@ remoteLauncher = defaultGun , _itMaxStack = 1 , _itAimingSpeed = 0.2 , _itAimingRange = 0.5 - , _itEquipPict = drawWeapon $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5) + , _itEquipPict = pictureWeaponOnAim $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5) , _itAttachment = Just $ ItScope (0,0) 0 1 True } hvAutoGun = defaultAutoGun @@ -409,7 +408,7 @@ hvAutoGun = defaultAutoGun , _itMaxStack = 1 , _itAimingSpeed = 0.2 , _itAimingRange = 1 - , _itEquipPict = drawWeapon $ color orange $ polygon $ rectNESW 5 5 (-5) (-5) + , _itEquipPict = pictureWeaponOnAim $ color orange $ polygon $ rectNESW 5 5 (-5) (-5) } where mkHvBul = withSound (fromIntegral longGunSound) @@ -439,7 +438,7 @@ ltAutoGun = defaultAutoGun , _itAimingSpeed = 1 , _itAimingRange = 0 , _itZoom = defaultItZoom - , _itEquipPict = drawWeapon $ color green $ pictures [polygon $ rectNSWE 4 (-4) (-4) 0 + , _itEquipPict = pictureWeaponOnAim $ color green $ pictures [polygon $ rectNSWE 4 (-4) (-4) 0 ,circleSolid 4 ] } @@ -464,7 +463,7 @@ miniGun = defaultAutoGun , _itMaxStack = 1 , _itAimingSpeed = 0.4 , _itAimingRange = 1 - , _itEquipPict = drawWeapon $ color red $ polygon $ rectNESW 9 5 (-9) (-5) + , _itEquipPict = pictureWeaponOnAim $ color red $ polygon $ rectNESW 9 5 (-9) (-5) } spreadGun = defaultGun { _itName = "SPREAD" @@ -486,7 +485,7 @@ spreadGun = defaultGun , _itMaxStack = 1 , _itAimingSpeed = 1 , _itAimingRange = 0 - , _itEquipPict = drawWeapon $ color green $ pictures [ polygon [(-3,0),(3,6),(3,-6)] ] + , _itEquipPict = pictureWeaponOnAim $ color green $ pictures [ polygon [(-3,0),(3,6),(3,-6)] ] } multGun = defaultGun { _itName = "MULTGUN" @@ -509,7 +508,7 @@ multGun = defaultGun , _itAimingSpeed = 0.4 , _itAimingRange = 1 , _itZoom = defaultItZoom {_itAimZoomFac = 1.5} - , _itEquipPict = drawWeapon multGunPic + , _itEquipPict = pictureWeaponOnAim multGunPic } where multGunPic = color red $ pictures @@ -542,7 +541,7 @@ longGun = defaultGun , _itAimingSpeed = 0.2 , _itAimingRange = 1 , _itZoom = defaultItZoom {_itAimZoomMax = 0.5, _itAimZoomMin = 0.5} - , _itEquipPict = drawWeapon $ pictures [color orange $ polygon $ rectNESW 3 6 (-3) (-6) ] + , _itEquipPict = pictureWeaponOnAim $ pictures [color orange $ polygon $ rectNESW 3 6 (-3) (-6) ] , _itScrollUp = startZoomInLongGun , _itScrollDown = startZoomOutLongGun , _itAttachment = Just $ ItScope (0,0) 0 1 False @@ -556,6 +555,7 @@ startZoomOutLongGun :: Int -> World -> World startZoomOutLongGun _ w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) . itAttachment . _Just . scopeZoomChange %~ \x -> min (-5) (x-5) +poisonSprayer :: Item poisonSprayer = defaultAutoGun { _itName = "POISON" , _itIdentity = PoisonSprayer @@ -574,7 +574,7 @@ poisonSprayer = defaultAutoGun , _itAimingSpeed = 0.2 , _itAimingRange = 0 , _itZoom = defaultItZoom - , _itEquipPict = drawWeapon $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4) + , _itEquipPict = pictureWeaponOnAim $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4) } flamer = defaultAutoGun @@ -595,7 +595,7 @@ flamer = defaultAutoGun , _itAimingSpeed = 0.5 , _itAimingRange = 0 , _itZoom = defaultItZoom {_itAimZoomMax = 5, _itAimZoomMin = 1.5} - , _itEquipPict = drawWeapon $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4) + , _itEquipPict = pictureWeaponOnAim $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4) , _itAttachment = Nothing } blinkGun = defaultGun @@ -873,7 +873,7 @@ grenade = Throwable , _itAimingSpeed = 1 , _itAimingRange = 0 , _itZoom = defaultItZoom {_itAimZoomMax = f fuseTime, _itAimZoomMin = f fuseTime} - , _itEquipPict = drawWeapon $ grenadePic fuseTime + , _itEquipPict = pictureWeaponOnAim $ grenadePic fuseTime , _itID = Nothing , _itUseRate = 50 , _itUseTime = 0 @@ -918,7 +918,7 @@ remoteBomb = defaultThrowable , _twAccuracy = 30 , _twFire = hammerCheck throwRemoteBomb , _itAttachment = Just $ ItScope (0,0) 0 1 True - , _itEquipPict = drawWeapon remoteBombUnarmedPic + , _itEquipPict = pictureWeaponOnAim remoteBombUnarmedPic } @@ -1099,7 +1099,7 @@ explodeRemoteBomb itid pjid n w where resetName = set (creatures . ix n . crInv . ix j . itName) "REMOTEBOMB" resetPict = set (creatures . ix n . crInv . ix j . itEquipPict ) - (drawWeapon remoteBombUnarmedPic) + (pictureWeaponOnAim remoteBombUnarmedPic) -- resetScope = creatures . ix n . crInv . ix j . itScope . _Just . scopePos .~ (0,0) j = _crInvSel $ _creatures w IM.! n remoteBombPic @@ -1148,7 +1148,7 @@ radar = defaultGun , _itMaxStack = 1 , _itAimingRange = 1 , _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1} - , _itEquipPict = drawWeapon $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) + , _itEquipPict = pictureWeaponOnAim $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) } {- | Sends out pulses that display creatures. -} @@ -1170,7 +1170,7 @@ sonar = defaultGun , _itMaxStack = 1 , _itAimingRange = 1 , _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1} - , _itEquipPict = drawWeapon $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) + , _itEquipPict = pictureWeaponOnAim $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) } {- | Automatically sends out pulses that display creatures. -} @@ -1229,3 +1229,4 @@ spawnCrNextTo cr i w = w & creatures %~ IM.insert k newCr & crID .~ k & crPos .~ _crPos sCr +.+ unitVectorAtAngle (_crDir sCr) & crOldPos .~ _crPos sCr +.+ unitVectorAtAngle (_crDir sCr) + diff --git a/src/Dodge/Item/Weapon/Grenade.hs b/src/Dodge/Item/Weapon/Grenade.hs index e0efe9c13..d0fe070cc 100644 --- a/src/Dodge/Item/Weapon/Grenade.hs +++ b/src/Dodge/Item/Weapon/Grenade.hs @@ -60,7 +60,7 @@ throwGrenade -> Int -- ^ Creature id -> World -> World -throwGrenade explosion n w = setWp $ removePict $ over projectiles addG $ w +throwGrenade explosion n w = setWp $ removePict $ over projectiles addG w where addG = IM.insert i $ Shell { _pjPos = p @@ -95,7 +95,7 @@ throwArmReset x = ItInvEffect {_itInvEffect = f ,_itEffectCounter = x } counterDown it | _itEffectCounter (_itEffect it) == 0 = it & itHammer .~ HammerUp - & itEquipPict .~ drawWeapon (grenadePic 50) + & itEquipPict .~ pictureWeaponOnAim (grenadePic 50) | otherwise = it & itEffect . itEffectCounter -~ 1 --(grenadeAccL, grenadeAccA) = (0.1, 0.1) diff --git a/src/Dodge/Particle/Bullet/HitEffect.hs b/src/Dodge/Particle/Bullet/HitEffect.hs index 340b2760c..518f243e2 100644 --- a/src/Dodge/Particle/Bullet/HitEffect.hs +++ b/src/Dodge/Particle/Bullet/HitEffect.hs @@ -21,6 +21,7 @@ import Control.Lens import Control.Monad.State --import Data.Maybe --import qualified Data.IntMap.Strict as IM +-- -- | Basic bullet hit creature effect. bulHitCr :: Particle -> Point2 -> Creature -> World -> World bulHitCr bt p cr w @@ -39,7 +40,6 @@ bulHitCr bt p cr w cid = _crID cr (d1,_) = randomR (-0.7,0.7) $ _randGen w colID = _btColor' bt - --(colID,_) = randomR (0,11) $ _randGen w p1 = p +.+ 2 *.* safeNormalizeV (p -.- _crPos cr) {- | Bounce off armoured creatures, otherwise do damage. -} bulBounceArmCr' :: Particle -> Point2 -> Creature -> World -> World diff --git a/src/Dodge/Path.hs b/src/Dodge/Path.hs index 03d1dfd46..3993938b5 100644 --- a/src/Dodge/Path.hs +++ b/src/Dodge/Path.hs @@ -87,7 +87,7 @@ f = incidenceToFunction $ pairsToIncidence -- ] pathBetween :: Point2 -> Point2 -> World -> Maybe [Point2] -pathBetween a b w = (makePath' $ \p -> _pathInc w M.! p) <$> a' <*> b' +pathBetween a b w = makePath' (\p -> _pathInc w M.! p) <$> a' <*> b' where nsa :: [Point2] nsa = map snd $ concat $ lookLookups (zoneAroundPoint a) (_pathPoints w) diff --git a/src/Dodge/Render/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs index e707d154a..470d1dd12 100644 --- a/src/Dodge/Render/MenuScreen.hs +++ b/src/Dodge/Render/MenuScreen.hs @@ -56,7 +56,7 @@ menuScreen cfig hw hh mLays = case mLays of mavol = f $ _volume_master cfig snvol = f $ _volume_sound cfig muvol = f $ _volume_music cfig - f x = show $ (round $ 10 * x :: Int) + f x = show (round $ 10 * x :: Int) showShadRes i = "1/"++ show i optionsList diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index 59b5d45e9..5e1d16c3b 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -218,7 +218,7 @@ moveFlamelet w pt damifclose cr | isClose cr = cr & crState . crDamage %~ ( Flaming 3 sp ep ep : ) | otherwise = cr - +-- | At writing the radius is half the size of the effect area makeGasCloud :: Point2 -- ^ Position -> Point2 -- ^ Velocity @@ -234,7 +234,7 @@ makeGasCloud pos vel w = w , _clVel = vel , _clPict = \_ -> onLayer CrLayer $ color (withAlpha 0.1 col) $ circleSolid 20 - , _clRad = 20 + , _clRad = 10 , _clTimer = 400 , _clEffect = cloudPoisonDamage } @@ -247,7 +247,7 @@ cloudPoisonDamage :: Cloud -> World -> World cloudPoisonDamage c w = w & creatures %~ flip (foldr (IM.adjust doDam)) damagedCrs where damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint (_clPos c) w - f cr = dist (_crPos cr) (_clPos c) < _crRad cr + _clRad c + f cr = dist (_crPos cr) (_clPos c) < _crRad cr + _clRad c + 10 doDam cr = cr & crState . crDamage %~ (:) (PoisonDam 1) {- diff --git a/src/Geometry.hs b/src/Geometry.hs index 20f967c31..72fb022fb 100644 --- a/src/Geometry.hs +++ b/src/Geometry.hs @@ -194,7 +194,7 @@ difference x y | x > y = x - y | otherwise = y - x -- | Given vector line direction and a vector movement, --- reflects the movement accoring to the line. +-- reflects the movement according to the line. reflectIn :: Point2 -> Point2 -> Point2 reflectIn line vec = rotateV angle vec where diff --git a/src/Geometry/Intersect.hs b/src/Geometry/Intersect.hs index ba06c7cec..bbc1ba881 100644 --- a/src/Geometry/Intersect.hs +++ b/src/Geometry/Intersect.hs @@ -134,7 +134,7 @@ but is symmetric around 0: -} roundPoint2 :: Point2 -> Point2 -roundPoint2 (x,y) = (fromIntegral $ (round x :: Int),fromIntegral $ (round y :: Int)) +roundPoint2 (x,y) = (fromIntegral (round x :: Int),fromIntegral (round y :: Int)) -- | Given two points, finds the linear gradient if it is non-infinite. linGrad :: (Eq a,Fractional a) => (a,a) -> (a,a) -> Maybe a linGrad (x,y) (a,b) diff --git a/src/Geometry/Vector.hs b/src/Geometry/Vector.hs index fa6b5f664..75fd9ba6a 100644 --- a/src/Geometry/Vector.hs +++ b/src/Geometry/Vector.hs @@ -2,8 +2,7 @@ module Geometry.Vector where import Geometry.Data -{- | Moves from to three dimensions, adding zero in z direction. - -} +{- | Moves from to three dimensions, adding zero in z direction. -} zeroZ :: Point2 -> Point3 {-# INLINE zeroZ #-} zeroZ (x,y) = (x,y,0) @@ -11,8 +10,7 @@ zeroZ (x,y) = (x,y,0) infixl 6 +.+, -.- infixl 7 *.* -{- | 2D coordinate-wise addition. - -} +{- | 2D coordinate-wise addition. -} (+.+) :: Point2 -> Point2 -> Point2 {-# INLINE (+.+) #-} (x1, y1) +.+ (x2, y2) = @@ -20,8 +18,7 @@ infixl 7 *.* !x = x1 + x2 !y = y1 + y2 in (x, y) -{- | 2D coordinate-wise subtraction. - -} +{- | 2D coordinate-wise subtraction. -} (-.-) :: Point2 -> Point2 -> Point2 {-# INLINE (-.-) #-} (x1, y1) -.- (x2, y2) = @@ -29,8 +26,7 @@ infixl 7 *.* !x = x1 - x2 !y = y1 - y2 in (x, y) -{- | 2D scalar multiplication. - -} +{- | 2D scalar multiplication. -} (*.*) :: Float -> Point2 -> Point2 {-# INLINE (*.*) #-} a *.* (x2, y2) = @@ -42,9 +38,7 @@ a *.* (x2, y2) = infixl 6 +.+.+, -.-.- infixl 7 *.*.* - -{- | 3D coordinate-wise addition. - -} +{- | 3D coordinate-wise addition. -} (+.+.+) :: Point3 -> Point3 -> Point3 {-# INLINE (+.+.+) #-} (x1, y1, z1) +.+.+ (x2, y2, z2) = @@ -53,9 +47,7 @@ infixl 7 *.*.* !y = y1 + y2 !z = z1 + z2 in (x, y, z) - -{- | 3D coordinate-wise subtraction. - -} +{- | 3D coordinate-wise subtraction. -} (-.-.-) :: Point3 -> Point3 -> Point3 {-# INLINE (-.-.-) #-} (x1, y1, z1) -.-.- (x2, y2, z2) = @@ -64,9 +56,7 @@ infixl 7 *.*.* !y = y1 - y2 !z = z1 - z2 in (x, y, z) - -{- | 3D scalar multiplication. - -} +{- | 3D scalar multiplication. -} (*.*.*) :: Point3 -> Point3 -> Point3 {-# INLINE (*.*.*) #-} (x1, y1, z1) *.*.* (x2, y2, z2) = @@ -75,16 +65,11 @@ infixl 7 *.*.* !y = y1 * y2 !z = z1 * z2 in (x, y, z) - -{- | Normalize a vector to length 1. - -} +{- | Normalize a vector to length 1. -} normalizeV :: Point2 -> Point2 {-# INLINE normalizeV #-} normalizeV p = (1 / magV p) *.* p - -{- | Angle between two vectors. -Always positive. - -} +{- | Angle between two vectors. Always positive. -} angleVV :: Point2 -> Point2 -> Float {-# INLINE angleVV #-} angleVV a b = @@ -92,58 +77,44 @@ angleVV a b = mb = magV b d = a `dotV` b in acos $ d / (ma * mb) - {- | Safe version of 'angleVV' that returns 0 if either vector is null. -} safeAngleVV :: Point2 -> Point2 -> Float {-# INLINE safeAngleVV #-} safeAngleVV a b | a == (0,0) || b == (0,0) = 0 | otherwise = angleVV a b - -{- | Dot product. - -} +{- | Dot product. -} dotV :: Point2 -> Point2 -> Float {-# INLINE dotV #-} dotV (x,y) (z,w) = x*z + y*w - -{- | Given vector, returns the angle, anticlockwise from +ve x-axis, in radians. - -} +{- | Given vector, returns the angle, anticlockwise from +ve x-axis, in radians. -} argV :: Point2 -> Float {-# INLINE argV #-} argV (x,y) = normalizeAngle $ atan2 y x - -{- | Determinant of the matrix formed by two vectors. - -} +{- | Determinant of the matrix formed by two vectors. -} detV :: Point2 -> Point2 -> Float {-# INLINE detV #-} -detV (x1, y1) (x2, y2) - = x1 * y2 - y1 * x2 - -{- | Given an angle in radians, anticlockwise from +ve x-axis, returns the -corresponding unit vector. --} +detV (x1, y1) (x2, y2) = x1 * y2 - y1 * x2 +{- | Given an angle in radians, anticlockwise from +ve x-axis, + - returns the corresponding unit vector. -} unitVectorAtAngle :: Float -> Point2 {-# INLINE unitVectorAtAngle #-} -unitVectorAtAngle r - = (cos r, sin r) - +unitVectorAtAngle r = (cos r, sin r) -- | Rotate a vector by an angle (in radians). +ve angle is counter-clockwise. rotateV :: Float -> Point2 -> Point2 -rotateV r (x, y) - = ( x * cos r - y * sin r - , x * sin r + y * cos r) +rotateV r (x, y) = + ( x * cos r - y * sin r + , x * sin r + y * cos r + ) {-# INLINE rotateV #-} - -- | Convert degrees to radians degToRad :: Float -> Float degToRad d = d * pi / 180 {-# INLINE degToRad #-} - -- | Convert radians to degrees radToDeg :: Float -> Float radToDeg r = r * 180 / pi {-# INLINE radToDeg #-} - -- | Normalize an angle to be between 0 and 2*pi radians normalizeAngle :: Float -> Float {-# INLINE normalizeAngle #-} @@ -151,34 +122,29 @@ normalizeAngle f = f - 2 * pi * floor' (f / (2 * pi)) where floor' :: Float -> Float floor' x = fromIntegral (floor x :: Int) - -{- | Rotate vector by pi/2 clockwise. - -} +{- | Rotate vector by pi/2 clockwise. -} vNormal :: Point2 -> Point2 {-# INLINE vNormal #-} vNormal (x,y) = (y,-x) - -{- | Negate a vector. - -} +{- | Negate a vector. -} vInverse :: Point2 -> Point2 vInverse (x,y) = (-x,-y) - -{- | Normalize a vector safely: on (0,0) return (0,0). - -} +{- | Normalize a vector safely: on (0,0) return (0,0). -} safeNormalizeV :: Point2 -> Point2 {-# INLINE safeNormalizeV #-} safeNormalizeV (0,0) = (0,0) safeNormalizeV p = (1/magV p ) *.* p - -{- | Magnitude of a vector. - -} +{- | Magnitude of a vector. -} magV :: Point2 -> Float {-# INLINE magV #-} magV (x,y) = sqrt $ x^(2::Int) + y^(2::Int) - {- | Magnitude of the cross product of two vectors. -Identical to detV. --} +Identical to detV. -} crossV :: Point2 -> Point2 -> Float crossV (ax,ay) (bx,by) = ax*by - ay*bx - +{- | TO CHECK Orthographic projection of one vector onto another. -} +projV + :: Point2 + -> Point2 + -> Point2 +projV fromv onv = (fromv `dotV` onv) / (onv `dotV` onv) *.* onv