diff --git a/src/Dodge/AIs.hs.orig b/src/Dodge/AIs.hs.orig new file mode 100644 index 000000000..b46b5b03f --- /dev/null +++ b/src/Dodge/AIs.hs.orig @@ -0,0 +1,1954 @@ +module Dodge.AIs where +-- imports {{{ +import Dodge.Data +import Dodge.Base +import Dodge.Path +import Dodge.SoundLogic +import Dodge.CreatureAction +import Dodge.Event +import Dodge.RandomHelp +import Dodge.WorldEvent + +import Geometry +import Picture + +import Data.List +import Data.Char +import Data.Maybe +import Data.Function +import Data.Graph.Inductive.Graph +import Data.Graph.Inductive.PatriciaTree +import Data.Graph.Inductive.Query.SP +import qualified Data.ByteString as B +import Control.Lens +import Control.Applicative +import Control.Monad.State +import Control.Monad + +import System.Random +import qualified Data.Set as S +import qualified Data.IntMap.Strict as IM +import qualified Data.Map as M + +import Foreign.ForeignPtr +import Control.Concurrent + +factionIs :: Faction -> Creature -> Bool +factionIs f c = (_faction $ _crState $ c) == f + +lineOrth :: Point2 -> IM.IntMap Creature -> Point2 -> Point2 +lineOrth ypos crs cpos = p + where 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 + +lineUp :: Point2 -> IM.IntMap Creature -> Point2 -> Point2 +lineUp ypos crs cpos = p + where ps = map _crPos $ IM.elems crs + cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps + p = (0.05 *.* ypos) +.+ (0.95 *.* errorClosestPointOnLine 500 cen ypos cpos) + +holdForm :: Point2 -> IM.IntMap Creature -> Point2 -> Point2 +holdForm ypos crs cpos = p + where ps = map _crPos $ IM.elems crs + cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps + p | dist cen ypos < 20 = ypos + | otherwise = ypos +.+ cpos -.- cen + +-- not nice, a kind of encircle +spreadOut :: Point2 -> IM.IntMap Creature -> Point2 -> Point2 +spreadOut ypos crs cpos = p + where 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 > 200 = 1 + | otherwise = 5 +---- +---- -- generalised swarm ai, works out where you go from the position of your flock +---- swarmAI :: (Point -> IM.IntMap Creature -> Point -> Point) -> Int -> World -> World +---- swarmAI f cid w = +---- let cr = _creatures w IM.! cid +---- cpos = _crPos cr +---- damageYou = over (creatures . ix 0 . crHP) (\hp -> hp - 10) . soundOnce hitSound +---- ypos = _crPos $ you w +---- flockers = IM.filter (flip (canSeePoint cid) w . _crPos) +---- $ IM.filter (factionIs $ _faction $ _crState cr) +---- $ _creatures w +---- tp = f ypos flockers cpos +---- combinedRad = _crRad cr + _crRad (you w) +---- replaceGoal newGoals = over (creatures . ix cid . crState . goals) +---- (\gs -> newGoals ++ tail gs) +---- addGoal newGoals = over (creatures . ix cid . crState . goals) +---- (\gs -> newGoals ++ gs) +---- replaceAction newActions = over (creatures . ix cid . crState . goals) +---- (\((_:as):ass) -> (newActions ++ as):ass) +---- addAction newActions = over (creatures . ix cid . crState . goals) +---- (\(as:ass) -> (newActions++as):ass) +---- in if _crHP cr <= 0 then killCr cid w else +---- case head $ _goals $ _crState cr of +---- [] | canSee cid (_yourID w) w +---- -> replaceGoal [[MoveToFor tp 10]] w +---- | otherwise -> w +---- (MoveToFor p x:_) +---- | dist ypos cpos < combinedRad + 5 +---- && abs ((_crDir cr) - argV (ypos -.- cpos)) < pi/4 -- THIS WON'T WORK +---- -- think about when crdir is 0.1 and yposdir is (2pi - epsilon) +---- +---- && x == 0 +---- -> over (creatures . ix cid . crPos) +---- (+.+ (12 *.* errorNormalizeVAI (ypos -.- cpos))) +---- $ replaceAction [MeleeAttack 5] +---- $ damageYou +---- w +---- | canSee cid (_yourID w) w && dist cpos ypos < 50 +---- -> mvForward 2 cid $ turnTowardSpeed 0.5 ypos cid +---- $ replaceAction [MoveToFor ypos (max 0 (x-1))] w +---- | x == 0 && canSee cid (_yourID w) w +---- -> mvForward 2 cid $ turnTowardSpeed 0.5 p cid +---- $ replaceAction [MoveToFor tp 0] w +---- | x == 0 -> replaceAction [MoveToFor p 10] w +---- | canSee cid (_yourID w) w +---- -> mvForward 2 cid $ turnTowardSpeed 0.5 p cid +---- $ replaceAction [MoveToFor p (x-1)] w +---- | dist cpos p < 20 -> w +---- | otherwise -> mvForward 2 cid $ turnTowardSpeed 0.5 p cid w +---- (MeleeAttack x:_) +---- | x == 0 -> replaceAction [WaitFor 5] w +---- | otherwise -> replaceAction [MeleeAttack (x-1)] w +---- (WaitFor x:gls)| x == 0 -> replaceAction [] w +---- | canSee cid (_yourID w) w +---- -> turnTowardSpeed 0.05 ypos cid +---- $ replaceAction [WaitFor (x-1)] w +---- | otherwise -> replaceAction [WaitFor (x-1)] w +---- +---- encircleAI' :: Int -> World -> World +---- encircleAI' cid w = +---- let cr = _creatures w IM.! cid +---- cpos = _crPos cr +---- damageYou = over (creatures . ix 0 . crHP) (\hp -> hp - 10) . soundOnce hitSound +---- ypos = _crPos $ you w +---- flockers = IM.filter (flip (canSeePoint cid) w . _crPos) +---- $ IM.filter (factionIs $ EncircleFlock) +---- $ _creatures w +---- tp | length flockers <= 1 = ypos +---- | otherwise = ypos +.+ +---- f (max 0 (magV (ypos -.- cenp) - 30) ) +---- *.* safeNormalizeV (cpos -.- cenp) +---- where f x = 150 * sigmoid (x-10) +---- cenp = (1 / fromIntegral (length flockers)) *.* +---- foldr1 (+.+) +---- (map _crPos $ IM.elems flockers) +---- combinedRad = _crRad cr + _crRad (you w) +---- replaceGoal newGoals = over (creatures . ix cid . crState . goals) +---- (\gs -> newGoals ++ tail gs) +---- addGoal newGoals = over (creatures . ix cid . crState . goals) +---- (\gs -> newGoals ++ gs) +---- replaceAction newActions = over (creatures . ix cid . crState . goals) +---- (\((_:as):ass) -> (newActions ++ as):ass) +---- addAction newActions = over (creatures . ix cid . crState . goals) +---- (\(as:ass) -> (newActions++as):ass) +---- in if _crHP cr <= 0 then killCr cid w else +---- case head $ _goals $ _crState cr of +---- [] | canSee cid (_yourID w) w +---- -> replaceGoal [[MoveToFor tp 10]] w +---- | otherwise -> w +---- (MoveToFor p x:_) +---- | dist ypos cpos < combinedRad + 5 +---- && abs ((_crDir cr) - argV (ypos -.- cpos)) < pi/4 -- same error as above +---- && x == 0 +---- -> over (creatures . ix cid . crPos) +---- (+.+ (12 *.* errorNormalizeVAI (ypos -.- cpos))) +---- $ replaceAction [MeleeAttack 5] +---- $ damageYou +---- w +---- | canSee cid (_yourID w) w && dist cpos ypos < 50 +---- -> mvForward 2 cid $ turnTowardSpeed 0.5 ypos cid +---- $ replaceAction [MoveToFor ypos (max 0 (x-1))] w +---- | x == 0 && canSee cid (_yourID w) w +---- -> mvForward 2 cid $ turnTowardSpeed 0.5 p cid +---- $ replaceAction [MoveToFor tp 0] w +---- | x == 0 -> replaceAction [MoveToFor p 10] w +---- | canSee cid (_yourID w) w +---- -> mvForward 2 cid $ turnTowardSpeed 0.5 p cid +---- $ replaceAction [MoveToFor p (x-1)] w +---- | dist cpos p < 20 -> w +---- | otherwise -> mvForward 2 cid $ turnTowardSpeed 0.5 p cid w +---- (MeleeAttack x:_) +---- | x == 0 -> replaceAction [WaitFor 5] w +---- | otherwise -> replaceAction [MeleeAttack (x-1)] w +---- (WaitFor x:gls)| x == 0 -> replaceAction [] w +---- | canSee cid (_yourID w) w +---- -> turnTowardSpeed 0.02 ypos cid +---- $ replaceAction [WaitFor (x-1)] w +---- | otherwise -> replaceAction [WaitFor (x-1)] w + +spawnerAI :: Creature -> World -> (World -> World,StdGen) -> Creature + -> ((World -> World, StdGen), Maybe Creature) +spawnerAI spawn w (f,g) cr = + let dir = _crDir cr + cid = _crID cr + cpos = _crPos cr + ypos = _crPos $ you w + replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs) + addGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ gs) + replaceAction newActions + = Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass) + addAction newActions + = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) + + needChild = length (filter (\cr' -> (cr' ^? crState . faction) == Just (SpawnedBy cid)) + $ IM.elems $ _creatures w) + < 15 + spawnChild = placeCrFaction spawn (SpawnedBy cid) (cpos +.+ rotateV dir (1,0)) cpos (_crDir cr) + in --if _crHP cr <= 0 then killCr w f cr else + case head $ _goals $ _crState cr of + (WaitFor x:_) | x == 0 && needChild + -> ( (spawnChild . f , g) + ,replaceAction [WaitFor 200] $ over crDir (+ 1) cr + ) + | canSee cid (_yourID w) w + -> ( (f , g) + ,replaceAction [WaitFor (max 0 (x-1))] + $ set (crDir) (argV (ypos -.- cpos)) cr ) + | otherwise -> ( (f , g) + ,replaceAction [WaitFor (max 0 (x-1))] cr) + +placeCrFaction :: Creature -> Faction -> Point2 -> Point2 -> Float -> World -> World +placeCrFaction cr fact p op rot w = over creatures addCr w + where addCr crs = IM.insert (Dodge.Base.newKey crs) + ( set (crState . faction) fact + $ cr {_crPos = p,_crOldPos = op,_crDir = rot,_crID = Dodge.Base.newKey crs} + ) + crs + + +chaseAI :: + World -> (World -> World,StdGen) -> Creature -> ((World -> World , StdGen), Maybe Creature) +chaseAI w (f,g') cr = + let cid = _crID cr + cpos = _crPos cr + damageYou = over (creatures . ix 0 . crState . crDamage) addDam + . soundOnce (fromIntegral hitSound) + addDam dams = (( Blunt 100 cpos cpos cpos ) : dams ) + ypos = _crPos $ you w + combinedRad = _crRad cr + _crRad (you w) + (a,g) = randomR (-0.2,0.2) g' + (wtime,g1) = randomR (15,25) g' + randomTurn = over crDir (+a) + randomTurn2 = over crDir (+(signum a)) + isCrowded = (length $ IM.elems $ IM.filter isCloseFaction (_creatures w)) > 2 + isCloseFaction cr' = _faction (_crState cr') == _faction (_crState cr) + && dist cpos (_crPos cr') < 25 + replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs) + addGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ gs) + replaceAction newActions + = Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass) + addAction newActions + = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) + in --if _crHP cr <= 0 then killCr w f cr else + case head $ _goals $ _crState cr of + [] -> ((f, g') , replaceGoal [] cr) + (Wait:_) | dist cpos ypos < 900 && hasLOS cpos ypos w + -> ((f ,g') + ,addGoal [[WaitFor wtime,MoveTo ypos]] cr) + | dist cpos ypos < 900 && hasLOSIndirect cpos ypos w + -> ((f , g') + ,addGoal [[WaitFor wtime,PathTo ypos]] cr) + | otherwise -> ( (f , g') + ,Just cr) + (WaitFor x:gls)| x == 0 -> ( (f , g') + ,replaceAction [] cr +-- $ drawCircleAtForCol cpos 10 (withAlpha 0.5 cyan) + ) + | hasLOS cpos ypos w + -> ( (f, g') + ,replaceAction [WaitFor (x-1)] $ crTurnTowardSpeed 0.05 ypos cr + ) + | otherwise -> ( (f, g') + , replaceAction [WaitFor (x-1)] cr ) + (MoveTo p:gls) + | dist ypos cpos < combinedRad + 5 + && abs ((_crDir cr) - argV (ypos -.- cpos)) < pi/4 -- same error as above + -> ( (damageYou . f , g') + , replaceAction [MeleeAttack 5] $ + over crPos + (+.+ (12 *.* errorNormalizeVAI (ypos -.- cpos))) cr + ) + | hasLOS cpos ypos w -> ( (f , g) + , replaceAction [MoveTo ypos] + $ crMvForward 2.5 $ randomTurn + $ crTurnTowardSpeed 0.05 p cr + ) + | dist p cpos < 10 -> ( (f, g') + , replaceAction [] cr) + | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4 + -> ( (f ,g' ) + , Just $ crTurnTowardSpeed 0.05 p cr) + | otherwise -> ( (f, g' ) + , Just $ crMvForward 2.5 $ crTurnTowardSpeed 0.05 p cr) + (MoveToFor p x:gls) + | hasLOS cpos ypos w -> + ( (f , g ) + , replaceAction [MoveTo ypos] + $ crMvForward 2.5 $ randomTurn $ crTurnTowardSpeed 0.05 p cr + ) + | dist p cpos < 10 -> ( (f , g) + , replaceAction [] cr) + | x == 0 -> ( (f , g) + , replaceAction [] cr) + | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4 + -> ( (f , g) + , replaceAction [MoveToFor p (max 0 (x-1))] + $ crTurnTowardSpeed 0.05 p cr) + | otherwise -> ( (f , g) + , replaceAction [MoveToFor p (max 0 (x-1))] + $ crMvForward 2.5 $ crTurnTowardSpeed 0.05 p cr) + (PathTo p:_) + | dist p cpos < 10 -> ( (f , g) + , replaceAction [] cr +-- $ drawCircleAtForCol p 10 (withAlpha 0.5 blue) + ) + | hasLOS cpos p w -> ( (f , g) + , addAction [MoveToFor p 10] cr +-- $ drawCircleAtForCol p 10 (withAlpha 0.5 green) + ) + | otherwise -> + --((f, g) , replaceAction [] cr) +-- case makePathBetweenPs cpos p w of +-- Just (q:_) -> ( (f , g) +-- +-- , addAction [MoveToFor q 10] cr +-- ) +-- _ -> ((f , g) +-- +-- , replaceAction [] cr +-- ) + case pointTowardsGoal cpos p w of + Just q -> ( (f , g) + + , addAction [MoveToFor q 10] cr + ) + _ -> ((f , g) + + , replaceAction [] cr + ) + +-- case pointTowardsGoal' cpos p w of + -- Right q -> addAction [MoveToFor q 10] +----- let ns = map fst $ concatMap doublePair $ _pathGraph' w +----- a' = listToMaybe $ sortBy (compare `on` dist cpos) $ ns +----- b' = listToMaybe $ sortBy (compare `on` dist p) $ ns +----- g :: World -> World +----- g = fromMaybe id $ fmap (\p -> drawCircleAtForCol p 10 yellow) a' +----- h = fromMaybe id $ fmap (\p -> drawCircleAtForCol p 10 blue) b' +----- incf = incidenceToFunction $ pairsToIncidence +----- $ concatMap doublePair $ _pathGraph' w +----- as :: [Point] +----- as = concat $ maybeToList $ fmap incf a' +----- g' w = foldr (\p -> drawCircleAtForCol p 5 orange) w as +----- h' qs w = foldr (\p -> drawCircleAtForCol p 5 orange) w qs +----- in case makePath' <$> return incf <*> b' <*> a' of +----- Just (q:qs) -> ( f . h' qs +----- . drawCircleAtForCol q 10 magenta +----- , addAction [MoveToFor q 10] cr +----- -- $ drawLineForCol ((cpos : (concat $ maybeToList $ makePathBetweenPs +----- -- cpos p w)) ++ [p]) 50 red +----- ) +------- Left s -> error s +------- - -> (f,cr) +----- _ -> ( f +----- . g . h . g' +----- , replaceAction [] cr +----- ) + (MeleeAttack x:_) + | x == 0 -> ( (f , g) + , replaceAction [WaitFor wtime] cr ) + | otherwise -> ( (f , g) + , replaceAction [MeleeAttack (x-1)] cr ) + +---- meleeAI' :: Int -> World -> World +---- meleeAI' cid w = let cr = _creatures w IM.! cid +---- cpos = _crPos cr +---- damageYou = over (creatures . ix 0 . crHP) (\hp -> hp - 10) . soundOnce hitSound +---- ypos = _crPos $ you w +---- combinedRad = _crRad cr + _crRad (you w) +---- (a,g) = randomR (-0.2,0.2) $ _randGen w +---- (wtime,g1) = randomR (15,25) $ _randGen w +---- randomTurn = set randGen g . over (creatures . ix cid . crDir) (+a) +---- randomTurn2 = set randGen g . over (creatures . ix cid . crDir) (+(signum a)) +---- isCrowded = (length $ IM.elems $ IM.filter isCloseFaction (_creatures w)) > 2 +---- isCloseFaction cr' = _faction (_crState cr') == ChaseCritters +---- && dist cpos (_crPos cr') < 25 +---- replaceGoal newGoals = over (creatures . ix cid . crState . goals) +---- (\gs -> newGoals ++ tail gs) +---- addGoal newGoals = over (creatures . ix cid . crState . goals) +---- (\gs -> newGoals ++ gs) +---- replaceAction newActions = over (creatures . ix cid . crState . goals) +---- (\((_:as):ass) -> (newActions ++ as):ass) +---- addAction newActions = over (creatures . ix cid . crState . goals) +---- (\(as:ass) -> (newActions++as):ass) +---- in if _crHP cr <= 0 then killCr cid w else +---- case head $ _goals $ _crState cr of +---- [] | canSee cid (_yourID w) w +---- -> replaceGoal [[MoveToFor ypos 10]] w +---- | canSeeIndirect cid (_yourID w) w +---- -> addGoal [[PathTo ypos]] w +---- | otherwise -> replaceGoal [] w +---- (WaitFor x:gls)| x == 0 -> replaceAction [] w +---- | canSee cid (_yourID w) w +---- -> turnTowardSpeed 0.05 ypos cid +---- $ replaceAction [WaitFor (x-1)] w +---- | otherwise -> replaceAction [WaitFor (x-1)] w +---- (MoveToFor p x:gls) +---- | dist ypos cpos < combinedRad + 5 +---- && abs ((_crDir cr) - argV (ypos -.- cpos)) < pi/4 -- same error as above +---- -- && x == 0 +---- -> over (creatures . ix cid . crPos) +---- (+.+ (12 *.* errorNormalizeVAI (ypos -.- cpos))) +---- $ replaceAction [MeleeAttack 5] +---- $ damageYou +---- w +---- | x == 0 && isCrowded -> replaceAction [] $ randomTurn2 w +---- | canSee cid (_yourID w) w -> replaceGoal [[MoveToFor ypos (max 0 (x-1))]] +---- $ mvForward 2.5 cid $ randomTurn $ turnTowardSpeed 0.05 p cid w +---- | dist p cpos < 10 -> replaceAction [] w +---- | x == 0 -> replaceAction [] w +---- -- | not (canSeePoint cid p w) -> replaceAction [PathTo p] w +---- -- | not (canSeePoint cid p w) -> replaceAction [] w +---- | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4 +---- -> replaceAction [MoveToFor p (max 0 (x-1))] $ turnTowardSpeed 0.05 p cid w +---- | otherwise -> replaceAction [MoveToFor p (max 0 (x-1))] +---- $ mvForward 2.5 cid $ turnTowardSpeed 0.05 p cid w +---- (PathTo p:_) +---- | dist p cpos < 10 -> replaceAction [] w +---- | canSeePoint cid p w -> addAction [MoveToFor p 10] w +---- | otherwise -> +---- case pointTowardsGoal' cpos p w of +---- Right q -> addAction [MoveToFor q 10] +---- -- $ drawCircleAtForCol q 10 magenta +---- -- $ drawLineForCol ((cpos : (concat $ maybeToList $ makePathBetweenPs +---- -- cpos p w)) ++ [p]) 50 red +---- w +---- --Left s -> error s +---- _ -> replaceAction [] w +---- (MeleeAttack x:_) +---- | x == 0 -> replaceAction [WaitFor wtime] w +---- | otherwise -> replaceAction [MeleeAttack (x-1)] w +---- (TrackYou:_) -> addGoal [[WaitFor wtime,PathTo ypos]] $ set randGen g1 w +---- (InitTrackYou:_)| canSeeIndirect cid (_yourID w) w -> replaceGoal [[TrackYou]] w +---- | otherwise -> w +---- (Guard p p':_) | canSeeIndirect cid (_yourID w) w +---- -> addGoal [[WaitFor wtime,PathTo ypos]] $ set randGen g1 w +---- | dist cpos p > 10 +---- -> addGoal [[PathTo p]] w +---- | errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8 +---- -> turnTowardSpeed 0.05 p' cid w +---- | otherwise -> w +---- (InitGuard :_) -> replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] w + +-- be aware that the crit can be removed -- don't just refer to its id in the +-- world->world part +miniAI :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) +miniAI w (f,g) cr = + let cpos = _crPos cr + cid = _crID cr + ypos = _crPos $ you w + wp = _crInv cr IM.! _crInvSel cr + (aimtime,g1) = randomR (80,120) g + noAmmo = 0 == _wpLoadedAmmo wp + turnCloseSlow p | errorAngleVV 22 (p -.- cpos) + (unitVectorAtAngle (_crDir cr)) < 0.4 + = crTurnTowardSpeed 0.01 p + | otherwise = crTurnTowardSpeed 0.05 p + replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs) + addGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ gs) + replaceAction newActions + = Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass) + addAction newActions + = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) +-- autoFireTweak p | _wpIsAuto wp = Just +-- | otherwise = replaceGoal [[AimAt p (_wpFireRate wp * 2)]] + in --if _crHP cr <= 0 then killCr w f cr else + case head $ _goals $ _crState cr of + [] | canSeeFire cpos ypos w -> ( ( f , g1 ) + , replaceGoal [[AimAt ypos aimtime]] cr + ) + | otherwise -> ( ( f , g ) + , replaceGoal [] cr + ) + (WaitFor x:gls)| canSeeFire cpos ypos w -> ( ( f , g1 ) + , replaceGoal [[AimAt ypos aimtime]] cr + ) + | x == 0 -> ( (f ,g ), replaceAction [] cr ) + | otherwise -> ( (f ,g ), replaceAction [WaitFor (x-1)] cr ) + (MoveToFor p x:gls) + | canSeeFire cpos ypos w -> ( (f , g1) + , replaceGoal [[AimAt ypos aimtime]] cr + ) + | x == 0 -> ( (f , g) + , replaceAction [] cr + ) + | dist p cpos < 10 -> ( (f , g) , replaceAction [] cr) + | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4 + -> ( (f , g) + , replaceAction [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr ) + | otherwise -> ( (f , g) + , replaceAction [MoveToFor p (x-1)] $ crMvForward 2 + $ crTurnTowardSpeed 0.05 p cr ) + (PathTo p:_) | dist p cpos < 10 -> ( (f , g) , replaceAction [] cr ) + | hasLOS cpos p w -> ( (f , g) , addAction [MoveToFor p 100] cr ) + | otherwise -> case pointTowardsGoal cpos p w of + Just q -> ( (f , g) , addAction [MoveToFor q 100] cr ) + _ -> ( (f , g) , replaceAction [] cr ) + (FireAt p:gls) | noAmmo -> ( (tryUseItem cid . f , g ) + , replaceGoal [[Reload + ,PathTo p + ,WaitFor 50 + --,Search 1 ,WaitFor 100 + ]] + cr + ) + | canSeeFireVisionAll cid (_yourID w) w + -> ( (tryUseItem cid . f , g) + , replaceGoal [[FireAt ypos]] $ turnCloseSlow p cr + ) + | pathToPointFireable cid p w + -> ( (tryUseItem cid . f , g) + , Just $ turnCloseSlow p cr + ) + | otherwise -> ( (f , g) + , replaceGoal [[PathTo p,WaitFor 50 ]] cr + ) + (Reload:gls) | _wpReloadState wp == 0 -> ( (f , g) , replaceAction [] cr ) + | canSeeFireVisionAny cid (_yourID w) w + -> ( (f , g) + , Just $ turnCloseSlow ypos cr + ) -- no longer chase if see you when reloading + -- $ replaceAction [] w + | otherwise -> ( (f , g) , Just cr) + (Search i:gls) | i == 0 -> ( (f , g) , replaceAction [] cr) + | otherwise + -> ( ( f , g1) + , replaceAction [ PathTo (randomPointXStepsFrom 3 cpos w) + , Search (i-1) + ] cr + ) + (Guard p p':_) | dist ypos cpos < 900 && canSeeFireVisionAny cid (_yourID w) w + -> ( ( f , g1) + , addGoal [[AimAt ypos (0)]] cr + ) + | dist cpos p > 10 + -> ( (f,g) , addGoal [[PathTo p]] cr) + | errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8 + -> ( (f,g) + ,Just $ crTurnTowardSpeed 0.05 p' cr) + | otherwise -> ( (f,g) ,Just cr) + (InitGuard :_) -> ( (f,g) + ,replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] cr + ) + (AimAt p i:_) | i == 0 -> ( (f,g) , replaceAction [FireAt p] cr ) + | canSeeFireVisionAll cid (_yourID w) w + -> ( (f,g) , replaceAction [AimAt ypos (i-1)] $ turnCloseSlow p cr) + | otherwise + -> ( (f,g) , replaceAction [AimAt p (i-1)] $ turnCloseSlow p cr) + +strafeOrChargeAI :: Float -> Float -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) +strafeOrChargeAI inRange outRange w (f,g) cr = + let cpos = _crPos cr + cid = _crID cr + ypos = _crPos $ you w + wp = _crInv cr IM.! _crInvSel cr + (aimtime,g1) = randomR (80,120) g + noAmmo = 0 == _wpLoadedAmmo wp + inR p aRange = dist p cpos < aRange + inA p = errorAngleVV 22 (p -.- cpos) (unitVectorAtAngle (_crDir cr)) < 0.2 + inA' p = errorAngleVV 22 (p -.- cpos) (unitVectorAtAngle (_crDir cr)) < pi/2 + strafeClockwise p | dist cpos p > 200 = crTurnTowardSpeed 0.05 p . crMvForward 3 + | dist cpos p < 80 = crTurnTowardSpeed 0.05 p . crMvForward (-3) + | errorAngleVV 22 (p' -.- cpos) (unitVectorAtAngle (_crDir cr)) < 0.4 + = crTurnTowardSpeed 0.01 p' . crStrafeLeft 3 + | otherwise + = crTurnTowardSpeed 0.05 p' . crStrafeLeft 3 + where v = vNormal $ p -.- cpos + p' = p +.+ 0.5 *.* (v -.- 20 *.* (normalizeV v)) + strafeCloseSlow p | dist cpos p > 200 = crTurnTowardSpeed 0.05 p . crMvForward 3 + | dist cpos p < 80 = crTurnTowardSpeed 0.05 p . crMvForward (-3) + | errorAngleVV 22 (p' -.- cpos) (unitVectorAtAngle (_crDir cr)) < 0.4 + = crTurnTowardSpeed 0.01 p' . crStrafeLeft 3 + | otherwise + = crTurnTowardSpeed 0.05 p' . crStrafeLeft 3 + where v = vNormal $ p -.- cpos + p' = p +.+ 0.5 *.* (v -.- 20 *.* (normalizeV v)) + replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs) + addGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ gs) + replaceAction newActions + = Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass) + addAction newActions + = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) +-- autoFireTweak p | _wpIsAuto wp = Just +-- | otherwise = replaceGoal [[AimAt p (_wpFireRate wp * 2)]] + in --if _crHP cr <= 0 then killCr w f cr else + case head $ _goals $ _crState cr of + [] | canSeeFire cpos ypos w -> ( ( f , g1 ) + , replaceGoal [[AimAt ypos aimtime]] cr + ) + | otherwise -> ( ( f , g ) + , replaceGoal [] cr + ) + (WaitFor x:gls)| canSeeFire cpos ypos w -> ( ( f , g1 ) + , replaceGoal [[AimAt ypos aimtime]] + cr + ) + | x == 0 -> ( (f ,g ), replaceAction [] cr ) + | otherwise -> ( (f ,g ), replaceAction [WaitFor (x-1)] cr ) + (MoveToFor p x:gls) + | canSeeFire cpos ypos w -> ( (f , g1) + , replaceGoal [[AimAt ypos aimtime]] cr + ) + | x == 0 -> ( (f , g) + , replaceAction [] cr + ) + | dist p cpos < 10 -> ( (f , g) , replaceAction [] cr) + | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4 + -> ( (f , g) + , replaceAction [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr ) + | otherwise -> ( (f , g) + , replaceAction [MoveToFor p (x-1)] $ crMvForward 2 + $ crTurnTowardSpeed 0.05 p cr ) + (PathTo p:_) | dist p cpos < 10 -> ( (f , g) , replaceAction [] cr ) + | hasLOS cpos p w -> ( (f , g) , addAction [MoveToFor p 100] cr ) + | otherwise -> case pointTowardsGoal cpos p w of + Just q -> ( (f , g) , addAction [MoveToFor q 100] cr ) + _ -> ( (f , g) , replaceAction [] cr ) + (FireAt p:gls) | noAmmo -> ( (tryUseItem cid . f , g ) + , replaceGoal [[Reload + ,PathTo p + ,WaitFor 50 + --,Search 1 ,WaitFor 100 + ]] + cr + ) + | canSeeFireVisionAll cid (_yourID w) w + -> ( (tryUseItem cid . f , g) + , replaceGoal [[FireAt ypos]] $ strafeCloseSlow p cr + ) + | pathToPointFireable cid p w + -> ( (tryUseItem cid . f , g) + , Just $ strafeCloseSlow p cr + ) + | otherwise -> ( (f , g) + , replaceGoal [[PathTo p,WaitFor 50 ]] cr + ) + (Reload:gls) | _wpReloadState wp == 0 -> ( (f , g) , replaceAction [] cr ) + | canSeeFireVisionAny cid (_yourID w) w + -> ( (f , g) + , Just $ strafeCloseSlow ypos cr + ) -- no longer chase if see you when reloading + -- $ replaceAction [] w + | otherwise -> ( (f , g) , Just cr) + (Search i:gls) | i == 0 -> ( (f , g) , replaceAction [] cr) + | otherwise + -> ( ( f , g1) + , replaceAction [ PathTo (randomPointXStepsFrom 3 cpos w) + , Search (i-1) + ] cr + ) + (Guard p p':_) | dist ypos cpos < 900 && canSeeFireVisionAny cid (_yourID w) w + -> ( ( f , g1) + , addGoal [[AimAt ypos (2*aimtime)]] cr + ) + | dist cpos p > 10 + -> ( (f,g) , addGoal [[PathTo p]] cr) + | errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8 + -> ( (f,g) + ,Just $ crTurnTowardSpeed 0.05 p' cr) + | otherwise -> ( (f,g) ,Just cr) + (InitGuard :_) -> ( (f,g) + ,replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] cr + ) + (AimAt p i:_) | i == 0 -> ( (f,g) , replaceAction [FireAt p] cr ) + | canSeeFireVisionAll cid (_yourID w) w + -> ( (f,g) , replaceAction [AimAt ypos (i-1)] $ strafeCloseSlow p + cr + ) + | otherwise + -> ( (f,g) , replaceAction [AimAt p (i-1)] $ strafeCloseSlow p cr) + +chargeAI :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) +chargeAI w (f,g) cr = + let cpos = _crPos cr + cid = _crID cr + ypos = _crPos $ you w + (aimtime,g') = randomR (80,120::Float) g + wp = _crInv cr IM.! _crInvSel cr + fTurn p | errorAngleVV 22 (p -.- cpos) (unitVectorAtAngle (_crDir cr)) < 0.4 + = crTurnTowardSpeed 0.005 p + | errorAngleVV 22 (p -.- cpos) (unitVectorAtAngle (_crDir cr)) < 1 + = crTurnTowardSpeed 0.05 p + | otherwise + = crTurnTowardSpeed 0.2 p + noAmmo = 0 == _wpLoadedAmmo wp + updateSearch = over (crState . goals) f + where f (g:_:h:gs) = (g:[PathTo ypos]:h:gs) + f (g:gs) = (g:[PathTo ypos]:gs) + replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs) + addGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ gs) + replaceAction newActions + = Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass) + addAction newActions + = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) + in --if _crHP cr <= 0 then killCr w f cr else + case head $ _goals $ _crState cr of + (MoveTo p:_) + | dist cpos ypos < 40 -> ((f,g) , replaceAction [Fire] cr) + | canSeeFire cpos ypos w -> ((f,g), Just . crMvBy (3,0) . fTurn ypos $ cr) + | otherwise -> ((f,g), Just . crMvBy (3,0) . fTurn p $ cr) + (Fire:_) + | dist cpos ypos < 60 && canSeeFire cpos ypos w + -> ((tryUseItem cid . f,g), Just $ fTurn ypos cr) + | otherwise -> ((f,g), replaceAction [] cr) + [] | canSeeFireVisionAny cid (_yourID w) w + -> ( ( f , g' ) , addAction [MoveTo ypos] cr) + | otherwise -> ( ( f , g' ) , Just cr) + (WaitFor x:gls)| x == 0 -> ( (f ,g' ), replaceAction [] cr ) + | otherwise -> ( (f ,g' ), replaceAction [WaitFor (x-1)] cr ) + (MoveToFor p x:gls) + | canSeeFire cpos ypos w -> ( (f , g') + , replaceAction [MoveTo ypos] cr + ) + | x == 0 -> ( (f , g') + , replaceAction [] cr + ) + | dist p cpos < 10 -> ( (f , g') , replaceAction [] cr) + | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4 + -> ( (f , g') + , replaceAction [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr ) + | otherwise -> ( (f , g') + , replaceAction [MoveToFor p (x-1)] $ crMvForward 2 + $ crTurnTowardSpeed 0.05 p cr ) + (PathTo p:_) | dist p cpos < 10 -> ( (f , g') , replaceAction [] cr ) + | hasLOS cpos p w -> ( (f , g') , addAction [MoveToFor p 100] cr ) + | otherwise -> case pointTowardsGoal cpos p w of + Just q -> ( (f , g') , addAction [MoveToFor q 100] cr ) + _ -> ( (f , g') , replaceAction [] cr ) + (Init:_) -> ((f,g), replaceAction [] cr) + +launcherAI :: Float -> Float -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) +launcherAI inRange outRange w (f,g) cr = + let cpos = _crPos cr + cid = _crID cr + ypos = _crPos $ you w + yposl x = ypos -.- x *.* (vNormal $ normalizeV $ ypos -.- cpos) + yposr x = ypos +.+ x *.* (vNormal $ normalizeV $ ypos -.- cpos) + (aimtime,g') = randomR (80,120) g + (recupTime,_) = randomR (0,50) g + wp = _crInv cr IM.! _crInvSel cr + noAmmo = 0 == _wpLoadedAmmo wp || _wpReloadState wp /= 0 + updateSearch = over (crState . goals) f + where f (g:_:h:gs) = (g:[PathTo ypos]:h:gs) + f (g:gs) = (g:[PathTo ypos]:gs) + replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs) + addGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ gs) + replaceAction newActions + = Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass) + addAction newActions + = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) + ts = take 3 $ randomRs (20,25) g + retreatActions = SetPosture Aiming + : Fire + : TurnByFor 0.16 20 + : SetPosture AtEase + : MoveByFor (3,0) 18 + : SetPosture Aiming + : Fire + : TurnByFor (-0.16) 20 + : SetPosture AtEase + : MoveByFor (3,0) 10 + : TurnToward ypos + -- : WaitFor 12 + -- : Fire + -- : WaitFor 20 + : SetPosture Aiming + : Fire + : WaitFor 60 + : [SetPosture AtEase] + strafeLeftActions = TurnToward (yposr 30) + : SetPosture Aiming + : (concatMap (\t -> [Fire,MoveByFor (0,3) t]) ts) + ++ [SetPosture AtEase] + strafeRightActions = TurnToward (yposl 30) + : SetPosture Aiming + : (concatMap (\t -> [Fire,MoveByFor (0,-3) t]) ts) + ++ [SetPosture AtEase] + rota a = cpos +.+ rotateV a (ypos -.- cpos) + (a2:a3:a4:a5:_) = evalState (takeOne [[0.1,0.15,0.5,1.5] + --,[0.1,0.15,0.5,1.5] + -- ,[0.2,0.3,0.6,1] + -- ,[0.2,0.3,0.5,0.8] + -- ,[0.2,0.3,0.5,1] + -- ,[0.1,0.2,0.5,0.9] + -- ,[0.1,0.2,0.4,0.7] + -- ,[0.1,0.2,0.3,0.4] + ] + ) g + curveLeft = TurnToward (rota $ negate a2) + : SetPosture Aiming + : Fire + : TurnToward (rota $ negate a3) + : WaitFor 20 + : Fire + : TurnToward (rota $ negate a4) + : WaitFor 20 + : Fire + : TurnToward (rota $ negate a5) + : SetPosture AtEase + : [MoveByFor (-3,0) 40] + curveRight = TurnToward (rota a2) + : SetPosture Aiming + : Fire + : TurnToward (rota a3) + : WaitFor 20 + : Fire + : TurnToward (rota a4) + : WaitFor 20 + : Fire + : TurnToward (rota a5) + : SetPosture AtEase + : [MoveByFor (-3,0) 40] + strafeProb :: Float + strafeProb | dist cpos ypos > 350 = 40 + | otherwise = 10 + retreatProb | dist cpos ypos < 100 = 80 + | dist cpos ypos < 200 = 40 + | otherwise = 0 + curveLeftProb = 20 + curveRightProb = 20 + -- | dist cpos ypos < 200 = 1 + -- | otherwise = 0 + fireActions = -- TurnToward ypos : + (evalState (takeOneWeighted + [curveLeftProb,curveRightProb + ,strafeProb,strafeProb,retreatProb] + [curveLeft + ,curveRight + ,strafeLeftActions + ,strafeRightActions + ,retreatActions + ] + ) $ g + ) + in --if _crHP cr <= 0 then killCr w f cr else + case head $ _goals $ _crState cr of + (TurnTo p:_) -> ( (f,g') , replaceAction [] . crTurnTo p $ cr) + (TurnByFor a 0:_) -> ( (f,g') , replaceAction [] . over crDir (+a) $ cr) + (TurnByFor a i:_) -> ( (f,g') , replaceAction [TurnByFor a (i-1)] . over crDir (+a) $ cr) + (SetPosture pture:_) -> ((f,g), replaceAction [] $ set (crState . stance . posture) pture cr) + (MoveByFor p 0:_) -> ((f,g'), replaceAction [] . crMvBy p $ cr) + (MoveByFor p i:_) -> ((f,g'), replaceAction [MoveByFor p (i-1)] . crMvBy p $ cr) + (Fire:_) | collidePointWallsSimple cpos (cpos +.+ 40 *.* unitVectorAtAngle (_crDir cr)) + (wallsAlongLine cpos (cpos +.+ 40 *.* unitVectorAtAngle (_crDir cr)) w) + -> ((f,g),replaceAction [] cr) + | otherwise -> ((tryUseItem cid . f,g'), replaceAction [] cr) + (GoalID i (MoveByFor p 0):_) -> ((f,g'), replaceAction [] . crMvBy p $ cr) + (GoalID i (MoveByFor p x):_) + | canSeeFire cpos (aCrPos i w) w + -> ( (f,g') + , replaceAction [GoalID i (MoveByFor p (x-1))] + . crMvBy p + . crTurnTowardSpeed 0.01 (aCrPos i w) + $ cr + ) + | otherwise + -> ( (f,g') + , replaceAction [GoalID i (MoveForwardFor (x-1))] + . crMvBy p + $ cr + ) + (TurnToward p:_) + | errorAngleVV 99 (p -.- cpos) (unitVectorAtAngle $ _crDir cr) > 2 + -> ( (f,g') + , Just . crTurnTowardSpeed 0.5 p + $ cr + ) + | errorAngleVV 99 (p -.- cpos) (unitVectorAtAngle $ _crDir cr) > 0.2 + -> ( (f,g') + , Just . crTurnTowardSpeed 0.1 p + $ cr + ) + | otherwise + -> ( (f,g') + , replaceAction [] + . crTurnTo p + $ cr + ) + [] | noAmmo -> ( (tryUseItem cid . f, g') + , addAction [Reload] cr + ) + | canSeeFireVisionAny cid (_yourID w) w + -> ( ( f , g' ) + -- , addAction (WaitFor 9:fireActions) + , addAction (WaitFor 9:fireActions) + $ updateSearch cr + ) + | otherwise -> ( ( f , g' ) + , replaceGoal [] cr + ) + (WaitFor x:gls)| x == 0 -> ( (f ,g' ), replaceAction [] cr ) + | otherwise -> ( (f ,g' ), replaceAction [WaitFor (x-1)] cr ) + (MoveToFor p x:gls) + | canSeeFire cpos ypos w -> ( (f , g') + , replaceGoal [[],[PathTo ypos]] cr + ) + | x == 0 -> ( (f , g') + , replaceAction [] cr + ) + | dist p cpos < 10 -> ( (f , g') , replaceAction [] cr) + | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4 + -> ( (f , g') + , replaceAction [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr ) + | otherwise -> ( (f , g') + , replaceAction [MoveToFor p (x-1)] $ crMvForward 2 + $ crTurnTowardSpeed 0.05 p cr ) + (PathTo p:_) | dist p cpos < 10 -> ( (f , g') , replaceAction [] cr ) + | hasLOS cpos p w -> ( (f , g') , addAction [MoveToFor p 100] cr ) + | otherwise -> case pointTowardsGoal cpos p w of + Just q -> ( (f , g') , addAction [MoveToFor q 100] cr ) + _ -> ( (f , g') , replaceAction [] cr ) + (Reload:_) | _wpReloadState wp == 0 -> ( (f , g') , replaceAction [WaitFor recupTime] cr ) + | canSeeFireVisionAny cid (_yourID w) w + -> ( (f , g') + , Just $ cr + ) -- no longer chase if see you when reloading + -- $ replaceAction [] w + | otherwise -> ( (f , g') , Just cr) + (Guard p p':_) | dist ypos cpos < 900 && canSeeFireVisionAny cid (_yourID w) w + -> ( ( f , g') + , addGoal [[WaitFor aimtime],[PathTo ypos]] cr + ) + | dist cpos p > 10 + -> ( (f,g') , addGoal [[PathTo p]] cr) + | errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8 + -> ( (f,g') + ,Just $ crTurnTowardSpeed 0.05 p' cr) + | otherwise -> ( (f,g') ,Just cr) + (Init :_) -> ( (f,g') + ,replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] cr + ) +dodgeAI :: Float -> Float -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) +dodgeAI inRange outRange w (f,g) cr = + let cpos = _crPos cr + cid = _crID cr + ypos = _crPos $ you w + yposl x = ypos -.- x *.* (vNormal $ normalizeV $ ypos -.- cpos) + yposr x = ypos +.+ x *.* (vNormal $ normalizeV $ ypos -.- cpos) + (aimtime,g') = randomR (0,120) g + (recupTime,_) = randomR (0,50) g + wp = _crInv cr IM.! _crInvSel cr + noAmmo = 0 == _wpLoadedAmmo wp + updateSearch = over (crState . goals) f + where f (g:_:h:gs) = (g:[PathTo ypos]:h:gs) + f (g:gs) = (g:[PathTo ypos]:gs) + replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs) + addGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ gs) + replaceAction newActions + = Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass) + addAction newActions + = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) + retreatOffset = let a | dist cpos ypos < 50 = 0 + | isLeftOfA (_crDir cr) (argV $ ypos -.- cpos) + = -0.7 + | otherwise = 0.7 + in fromMaybe ypos + $ intersectLineLine' cpos + (cpos +.+ rotateV a (ypos -.- cpos)) + ypos + (ypos +.+ vNormal (cpos -.- ypos)) + ts = take 5 $ randomRs (7,10) g + chargeActions = TurnToward ypos + : (GoalID 0 (MoveByFor (3,0) 15)) + : (concatMap (\t -> [GoalID 0 (MoveByFor (3,0) t),Fire]) ts) + retreatActions = TurnToward retreatOffset + :(GoalID 0 (MoveByFor (-3,0) 9)) + : (concatMap (\t -> [GoalID 0 (MoveByFor (-3,0) t),Fire]) ts) + strafeLeftActions = TurnToward (yposr 150) : MoveByFor (0,3) 4 + : (concatMap (\t -> [MoveByFor (0,3) t,Fire]) ts) + strafeRightActions = TurnToward (yposl 150) : MoveByFor (0,-3) 4 + : (concatMap (\t -> [MoveByFor (0,-3) t,Fire]) ts) + chargeProb :: Float + chargeProb | dist cpos ypos > 300 = 5 + | dist cpos ypos > 150 = 1 + | otherwise = 0 + strafeProb | dist cpos ypos > 150 = 1 + | otherwise = 0 + retreatProb | dist cpos ypos < 200 = 1 + | otherwise = 0 + fireActions = -- TurnToward ypos : + (evalState (takeOneWeighted + [chargeProb,retreatProb,strafeProb,strafeProb] + [chargeActions + ,retreatActions + ,strafeLeftActions + ,strafeRightActions + ] + ) $ g + ) + in --if _crHP cr <= 0 then killCr w f cr else + case head $ _goals $ _crState cr of + (MoveByFor p 0:_) -> ((f,g'), replaceAction [] . crMvBy p $ cr) + (MoveByFor p i:_) -> ((f,g'), replaceAction [MoveByFor p (i-1)] . crMvBy p $ cr) + (Fire:_) -> ((tryUseItem cid . f,g'), replaceAction [] cr) + (GoalID i (MoveByFor p 0):_) -> ((f,g'), replaceAction [] . crMvBy p $ cr) + (GoalID i (MoveByFor p x):_) + | canSeeFire cpos (aCrPos i w) w + -> ( (f,g') + , replaceAction [GoalID i (MoveByFor p (x-1))] + . crMvBy p + . crTurnTowardSpeed 0.01 (aCrPos i w) + $ cr + ) + | otherwise + -> ( (f,g') + , replaceAction [GoalID i (MoveByFor p (x-1))] + . crMvBy p $ cr + ) + (TurnToward p:_) + | errorAngleVV 99 (p -.- cpos) (unitVectorAtAngle $ _crDir cr) > 2 + -> ( (f,g') + , Just . crTurnTowardSpeed 0.2 p + $ cr + ) + | errorAngleVV 99 (p -.- cpos) (unitVectorAtAngle $ _crDir cr) > 0.2 + -> ( (f,g') + , Just . crTurnTowardSpeed 0.1 p + $ cr + ) + | otherwise + -> ( (f,g') + , replaceAction [] + $ cr + ) + [] | noAmmo -> ( (tryUseItem cid . f, g') , addAction [Reload] cr) + | canSeeFireVisionAny cid (_yourID w) w + -> ( ( f , g' ) , addAction (WaitFor 9:fireActions) $ updateSearch cr) + | otherwise -> ( ( f , g' ) , replaceGoal [] cr) + (WaitFor x:gls)| x == 0 -> ( (f ,g' ), replaceAction [] cr ) + | otherwise -> ( (f ,g' ), replaceAction [WaitFor (x-1)] + $ crTurnTowardSpeed 0.05 ypos cr ) + (MoveToFor p x:gls) + | canSeeFire cpos ypos w -> ( (f , g') + , replaceGoal [[],[PathTo ypos]] cr + ) + | x == 0 -> ( (f , g') + , replaceAction [] cr + ) + | dist p cpos < 10 -> ( (f , g') , replaceAction [] cr) + | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4 + -> ( (f , g') + , replaceAction [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr ) + | otherwise -> ( (f , g') + , replaceAction [MoveToFor p (x-1)] $ crMvForward 2 + $ crTurnTowardSpeed 0.05 p cr ) + (PathTo p:_) | dist p cpos < 10 -> ( (f , g') , replaceAction [] cr ) + | hasLOS cpos p w -> ( (f , g') , addAction [MoveToFor p 100] cr ) + | otherwise -> case pointTowardsGoal cpos p w of + Just q -> ( (f , g') , addAction [MoveToFor q 100] cr ) + _ -> ( (f , g') , replaceAction [] cr ) + (Reload:_) | _wpReloadState wp == 0 -> ( (f , g') , replaceAction [WaitFor recupTime] cr ) + | otherwise -> ( (f , g') , Just cr) + (Guard p p':_) | dist ypos cpos < 900 && canSeeFireVisionAny cid (_yourID w) w + -> ( ( f , g') + , addGoal [[WaitFor aimtime],[PathTo ypos]] cr + ) + | dist cpos p > 10 + -> ( (f,g') , addGoal [[PathTo p]] cr) + | errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8 + -> ( (f,g') + ,Just $ crTurnTowardSpeed 0.05 p' cr) + | otherwise -> ( (f,g') ,Just cr) + (InitGuard :_) -> ( ( f,g') +-- (InitGuard :_) -> ( (over lightSources (IM.insert cid (crLight cid)) . f,g') + ,replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] cr + ) + (x:_) -> error $ "missing the following pattern in case expression:" ++ show x + +logistic :: Float -> Float -> Float -> (Float -> Float) +logistic x0 l k x = l / (1 + exp (k*(x0 - x))) + + +circleClockwiseAI :: Float -> Float -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) +circleClockwiseAI inRange outRange w (f,g) cr = + let cpos = _crPos cr + cid = _crID cr + ypos = _crPos $ you w + wp = _crInv cr IM.! _crInvSel cr + (aimtime,g1) = randomR (80,120) g + noAmmo = 0 == _wpLoadedAmmo wp + inR p aRange = dist p cpos < aRange + inA p = errorAngleVV 22 (p -.- cpos) (unitVectorAtAngle (_crDir cr)) < 0.2 + inA' p = errorAngleVV 22 (p -.- cpos) (unitVectorAtAngle (_crDir cr)) < pi/2 + strafeCloseSlow p | dist cpos p > 200 = crTurnTowardSpeed 0.05 p . crMvForward 3 + | dist cpos p < 80 = crTurnTowardSpeed 0.05 p . crMvForward (-3) + | errorAngleVV 22 (p' -.- cpos) (unitVectorAtAngle (_crDir cr)) < 0.4 + = crTurnTowardSpeed 0.01 p' . crStrafeLeft 3 + | otherwise + = crTurnTowardSpeed 0.05 p' . crStrafeLeft 3 + where v = vNormal $ p -.- cpos + p' = p +.+ 0.5 *.* (v -.- 20 *.* (normalizeV v)) + replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs) + addGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ gs) + replaceAction newActions + = Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass) + addAction newActions + = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) +-- autoFireTweak p | _wpIsAuto wp = Just +-- | otherwise = replaceGoal [[AimAt p (_wpFireRate wp * 2)]] + in --if _crHP cr <= 0 then killCr w f cr else + case head $ _goals $ _crState cr of + [] | canSeeFire cpos ypos w -> ( ( f , g1 ) + , replaceGoal [[AimAt ypos aimtime]] cr + ) + | otherwise -> ( ( f , g ) + , replaceGoal [] cr + ) + (WaitFor x:gls)| canSeeFire cpos ypos w -> ( ( f , g1 ) + , replaceGoal [[AimAt ypos aimtime]] + cr + ) + | x == 0 -> ( (f ,g ), replaceAction [] cr ) + | otherwise -> ( (f ,g ), replaceAction [WaitFor (x-1)] cr ) + (MoveToFor p x:gls) + | canSeeFire cpos ypos w -> ( (f , g1) + , replaceGoal [[AimAt ypos aimtime]] cr + ) + | x == 0 -> ( (f , g) + , replaceAction [] cr + ) + | dist p cpos < 10 -> ( (f , g) , replaceAction [] cr) + | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4 + -> ( (f , g) + , replaceAction [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr ) + | otherwise -> ( (f , g) + , replaceAction [MoveToFor p (x-1)] $ crMvForward 2 + $ crTurnTowardSpeed 0.05 p cr ) + (PathTo p:_) | dist p cpos < 10 -> ( (f , g) , replaceAction [] cr ) + | hasLOS cpos p w -> ( (f , g) , addAction [MoveToFor p 100] cr ) + | otherwise -> case pointTowardsGoal cpos p w of + Just q -> ( (f , g) , addAction [MoveToFor q 100] cr ) + _ -> ( (f , g) , replaceAction [] cr ) + (FireAt p:gls) | noAmmo -> ( (tryUseItem cid . f , g ) + , replaceGoal [[Reload + ,PathTo p + ,WaitFor 50 + --,Search 1 ,WaitFor 100 + ]] + cr + ) + | canSeeFireVisionAll cid (_yourID w) w + -> ( (tryUseItem cid . f , g) + , replaceGoal [[FireAt ypos]] $ strafeCloseSlow p cr + ) + | pathToPointFireable cid p w + -> ( (tryUseItem cid . f , g) + , Just $ strafeCloseSlow p cr + ) + | otherwise -> ( (f , g) + , replaceGoal [[PathTo p,WaitFor 50 ]] cr + ) + (Reload:gls) | _wpReloadState wp == 0 -> ( (f , g) , replaceAction [] cr ) + | canSeeFireVisionAny cid (_yourID w) w + -> ( (f , g) + , Just $ strafeCloseSlow ypos cr + ) -- no longer chase if see you when reloading + -- $ replaceAction [] w + | otherwise -> ( (f , g) , Just cr) + (Search i:gls) | i == 0 -> ( (f , g) , replaceAction [] cr) + | otherwise + -> ( ( f , g1) + , replaceAction [ PathTo (randomPointXStepsFrom 3 cpos w) + , Search (i-1) + ] cr + ) + (Guard p p':_) | dist ypos cpos < 900 && canSeeFireVisionAny cid (_yourID w) w + -> ( ( f , g1) + , addGoal [[AimAt ypos (2*aimtime)]] cr + ) + | dist cpos p > 10 + -> ( (f,g) , addGoal [[PathTo p]] cr) + | errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8 + -> ( (f,g) + ,Just $ crTurnTowardSpeed 0.05 p' cr) + | otherwise -> ( (f,g) ,Just cr) + (InitGuard :_) -> ( (f,g) + ,replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] cr + ) + (AimAt p i:_) | i == 0 -> ( (f,g) , replaceAction [FireAt p] cr ) + | canSeeFireVisionAll cid (_yourID w) w + -> ( (f,g) , replaceAction [AimAt ypos (i-1)] $ strafeCloseSlow p + cr + ) + | otherwise + -> ( (f,g) , replaceAction [AimAt p (i-1)] $ strafeCloseSlow p cr) + +twitchMissAI :: Float -> Float -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) +twitchMissAI inRange outRange w (f,g) cr = + let cpos = _crPos cr + yposl = ypos +.+ 25 *.* normalizeV (vNormal (cpos -.- ypos)) + yposr = ypos -.- 25 *.* normalizeV (vNormal (cpos -.- ypos)) + yposoff = evalState (takeOne [yposl,yposr]) $ _randGen w + cid = _crID cr + ypos = _crPos $ you w + wp = _crInv cr IM.! _crInvSel cr + fireRate = fromMaybe 0 $ wp ^? wpFireRate + noAmmo = 0 == _wpLoadedAmmo wp + strafeCloseSlow p | errorAngleVV 22 (p -.- cpos) + (unitVectorAtAngle (_crDir cr)) < 0.1 + = crTurnTowardSpeed 0.01 p . crMvForward closeDist + | otherwise + = crTurnAndStrafeIn inOrOut 0.05 p + where inOrOut | dist p cpos < inRange = -1 + | dist p cpos < outRange = 0 + | otherwise = 1 + closeDist | dist p cpos < inRange = -1 + | dist p cpos < outRange = 0 + | otherwise = 1 + replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs) + addGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ gs) + replaceAction newActions + = Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass) + addAction newActions + = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) + (t,g') = randomR (fireRate+10,fireRate+15) g + retreatPs = sortBy (compare `on` dist cpos) $ map f $ nRaysRad 8 400 + where f p = fromMaybe (ypos +.+ p) $ fmap fst + $ collidePointWalls ypos (ypos +.+ p) (wallsAlongLine ypos (ypos +.+ p) w) + retreatP' = cpos +.+ 300 *.* (cpos -.- ypos) + retreatP'' = fromMaybe retreatP' $ fmap fst + $ collidePointWalls ypos retreatP' + $ wallsAlongLine ypos retreatP' w + retreatP = head $ sortBy (compare `on` (\p -> dist p ypos < 300)) $ retreatP'' : retreatPs + fireActions = [TurnToward yposoff, Fire, TurnTo ypos, WaitFor t + ,Fire,Fire,Reload,GoalID 0 (WaitFor 20),MakeJudgement] + fleeActions = [MoveToFor retreatP 50,MakeJudgement] + in --if _crHP cr <= 0 then killCr w f cr else + case head $ _goals $ _crState cr of + [] -> ((f,g), replaceGoal [] cr) + (MakeJudgement:_) + | not (canSeeFire cpos ypos w) -> ((f,g),replaceAction [] cr) + | dist cpos ypos > 400 -> ((f,g), replaceAction [MoveToFor ypos 20] cr) + | dist cpos ypos < 150 -> ((f,g'),replaceAction fleeActions $ crMvBy (3,0) cr) + | otherwise -> ((f,g'),replaceAction fireActions cr) + (GoalID i (WaitFor x):gls) + | x == 0 -> ( (f ,g' ), replaceAction [] cr ) + | otherwise -> ( (f ,g' ), replaceAction [GoalID i (WaitFor (x-1))] + $ strafeCloseSlow ypos cr ) + (WaitFor x:gls)| x == 0 -> ( (f ,g' ), replaceAction [] cr ) + | otherwise -> ( (f ,g' ), replaceAction [WaitFor (x-1)] cr ) + (MoveToFor p x:gls) + | x == 0 -> ( (f, g') , replaceAction [] cr) + | dist p cpos < 10 -> ( (f , g') , replaceAction [] cr) + | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4 + -> ( (f , g') + , replaceAction [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.5 p cr ) + | otherwise -> ( (f , g') + , replaceAction [MoveToFor p (x-1)] $ crMvForward 3 + $ crTurnTowardSpeed 0.05 p cr ) + (PathTo p:_) + | canSeeFire cpos ypos w -> ((f,g),replaceGoal [[MakeJudgement]] cr) + | dist p cpos < 10 -> ( (f , g') , replaceAction [] cr ) + | hasLOS cpos p w -> ( (f , g') , addAction [MoveToFor p 50] cr ) + | otherwise -> case pointTowardsGoal cpos p w of + Just q -> ( (f , g') , addAction [MoveToFor q 50] cr ) + _ -> ( (f , g') , replaceAction [] cr ) + (Fire:gls) -> ( (tryUseItem cid . f , g' ) + , replaceAction [] cr + ) + (Reload:gls) | _wpReloadState wp == 0 -> ( (f , g') , replaceAction [] cr ) + | canSeeFireVisionAny cid (_yourID w) w + -> ( (f , g') + , Just $ strafeCloseSlow ypos cr + ) -- no longer chase if see you when reloading + -- $ replaceAction [] w + | otherwise -> ( (f , g) , Just cr) + (Guard p p':_) | dist ypos cpos < 900 && canSeeFireVisionAny cid (_yourID w) w + -> ( ( f , g') + , addGoal [[MakeJudgement]] cr + ) + | dist cpos p > 10 + -> ( (f,g) , addGoal [[PathTo p]] cr) + | errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8 + -> ( (f,g) + ,Just $ crTurnTowardSpeed 0.05 p' cr) + | otherwise -> ( (f,g) ,Just cr) + (InitGuard :_) -> ( (f,g) + ,replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] cr + ) + (TurnToward p:_) + | errorAngleVV 99 (p -.- cpos) (unitVectorAtAngle $ _crDir cr) > 2 + -> ( (f,g') , Just . crTurnTowardSpeed 0.2 p $ cr) + | errorAngleVV 99 (p -.- cpos) (unitVectorAtAngle $ _crDir cr) > 0.2 + -> ( (f,g') , Just . crTurnTowardSpeed 0.1 p $ cr) + | otherwise + -> ( (f,g') , replaceAction [] . crTurnTo p $ cr) + (TurnTo p:_) -> ( (f,g') , replaceAction [] . crTurnTo p $ cr) + +closeToRangeAI :: Float -> Float -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) +closeToRangeAI inRange outRange w (f,g) cr = + let cpos = _crPos cr + cid = _crID cr + ypos = _crPos $ you w + wp = _crInv cr IM.! _crInvSel cr + fireRate = fromMaybe 0 $ wp ^? wpFireRate + (aimtime,g1) = randomR (80,120) g + noAmmo = 0 == _wpLoadedAmmo wp + strafeCloseSlow p | errorAngleVV 22 (p -.- cpos) + (unitVectorAtAngle (_crDir cr)) < 0.1 + = crTurnTowardSpeed 0.01 p . crMvForward closeDist + | otherwise + = crTurnAndStrafeIn inOrOut 0.05 p + where inOrOut | dist p cpos < inRange = -1.5 + | dist p cpos < outRange = 0 + | otherwise = 1.5 + closeDist | dist p cpos < inRange = -1.5 + | dist p cpos < outRange = 0 + | otherwise = 1.5 + replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs) + addGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ gs) + replaceAction newActions + = Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass) + addAction newActions + = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) + in --if _crHP cr <= 0 then killCr w f cr else + case head $ _goals $ _crState cr of + [] | canSeeFire cpos ypos w -> ( ( f , g1 ) + , replaceGoal [[AimAt ypos aimtime]] cr + ) + | otherwise -> ( ( f , g ) + , replaceGoal [] cr + ) + (WaitFor x:gls)| canSeeFire cpos ypos w -> ( ( f , g1 ) + , replaceGoal [[AimAt ypos aimtime]] + cr + ) + | x == 0 -> ( (f ,g ), replaceAction [] cr ) + | otherwise -> ( (f ,g ), replaceAction [WaitFor (x-1)] cr ) + (MoveToFor p x:gls) + | canSeeFire cpos ypos w -> ( (f , g1) + , replaceGoal [[AimAt ypos aimtime]] cr + ) + | x == 0 -> ( (f , g) + , replaceAction [] cr + ) + | dist p cpos < 10 -> ( (f , g) , replaceAction [] cr) + | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4 + -> ( (f , g) + , replaceAction [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr ) + | otherwise -> ( (f , g) + , replaceAction [MoveToFor p (x-1)] $ crMvForward 3 + $ crTurnTowardSpeed 0.05 p cr ) + (PathTo p:_) | dist p cpos < 10 -> ( (f , g) , replaceAction [] cr ) + | hasLOS cpos p w -> ( (f , g) , addAction [MoveToFor p 100] cr ) + | otherwise -> case pointTowardsGoal cpos p w of + Just q -> ( (f , g) , addAction [MoveToFor q 100] cr ) + _ -> ( (f , g) , replaceAction [] cr ) + (FireAt p:gls) | noAmmo -> ( (tryUseItem cid . f , g ) + , replaceGoal [[Reload + ,PathTo p + ,WaitFor 50 + --,Search 1 ,WaitFor 100 + ]] + cr + ) + | canSeeFireVisionAll cid (_yourID w) w + -> ( (tryUseItem cid . f , g) + , replaceGoal [[AimAt ypos (fireRate+ aimtime - 80)]] + $ strafeCloseSlow p cr + ) + | pathToPointFireable cid p w + -> ( (tryUseItem cid . f , g) + , Just $ strafeCloseSlow p cr + ) + | otherwise -> ( (f , g) + , replaceGoal [[PathTo p,WaitFor 50 ]] cr + ) + (Reload:gls) | _wpReloadState wp == 0 -> ( (f , g) , replaceAction [] cr ) + | canSeeFireVisionAny cid (_yourID w) w + -> ( (f , g) + , Just $ strafeCloseSlow ypos cr + ) -- no longer chase if see you when reloading + -- $ replaceAction [] w + | otherwise -> ( (f , g) , Just cr) + (Search i:gls) | i == 0 -> ( (f , g) , replaceAction [] cr) + | otherwise + -> ( ( f , g1) + , replaceAction [ PathTo (randomPointXStepsFrom 3 cpos w) + , Search (i-1) + ] cr + ) + (Guard p p':_) | dist ypos cpos < 900 && canSeeFireVisionAny cid (_yourID w) w + -> ( ( f , g1) + , addGoal [[AimAt ypos (2*aimtime)]] cr + ) + | dist cpos p > 10 + -> ( (f,g) , addGoal [[PathTo p]] cr) + | errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8 + -> ( (f,g) + ,Just $ crTurnTowardSpeed 0.05 p' cr) + | otherwise -> ( (f,g) ,Just cr) + (InitGuard :_) -> ( (f,g) + ,replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] cr + ) + (AimAt p i:_) | i == 0 -> ( (f,g) , replaceAction [FireAt p] cr ) + | canSeeFireVisionAll cid (_yourID w) w + -> ( (f,g) , replaceAction [AimAt ypos (i-1)] $ strafeCloseSlow p + cr + ) + | otherwise + -> ( (f,g) , replaceAction [AimAt p (i-1)] $ strafeCloseSlow p cr) + +suppressShooterAI :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) +suppressShooterAI w (f,g) cr = + let cpos = _crPos cr + cid = _crID cr + ypos = _crPos $ you w + wp = _crInv cr IM.! _crInvSel cr + (aimtime,g1) = randomR (80,120) g + noAmmo = 0 == _wpLoadedAmmo wp + turnCloseSlow p | errorAngleVV 22 (p -.- cpos) + (unitVectorAtAngle (_crDir cr)) < 0.4 + = crTurnTowardSpeed 0.01 p + | otherwise = crTurnTowardSpeed 0.05 p + replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs) + addGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ gs) + replaceAction newActions + = Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass) + addAction newActions + = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) +-- autoFireTweak p | _wpIsAuto wp = Just +-- | otherwise = replaceGoal [[AimAt p (_wpFireRate wp * 2)]] + in --if _crHP cr <= 0 then killCr w f cr else + case head $ _goals $ _crState cr of + [] | canSeeFire cpos ypos w -> ( ( f , g1 ) + , replaceGoal [[AimAt ypos aimtime]] cr + ) + | otherwise -> ( ( f , g ) + , replaceGoal [] cr + ) + (WaitFor x:gls)| canSeeFire cpos ypos w -> ( ( f , g1 ) + , replaceGoal [[AimAt ypos aimtime]] cr + ) + | x == 0 -> ( (f ,g ), replaceAction [] cr ) + | otherwise -> ( (f ,g ), replaceAction [WaitFor (x-1)] cr ) + (MoveToFor p x:gls) + | canSeeFire cpos ypos w -> ( (f , g1) + , replaceGoal [[AimAt ypos aimtime]] cr + ) + | x == 0 -> ( (f , g) + , replaceAction [] cr + ) + | dist p cpos < 10 -> ( (f , g) , replaceAction [] cr) + | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4 + -> ( (f , g) + , replaceAction [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr ) + | otherwise -> ( (f , g) + , replaceAction [MoveToFor p (x-1)] $ crMvForward 2 + $ crTurnTowardSpeed 0.05 p cr ) + (PathTo p:_) | dist p cpos < 10 -> ( (f , g) , replaceAction [] cr ) + | hasLOS cpos p w -> ( (f , g) , addAction [MoveToFor p 100] cr ) + | otherwise -> case pointTowardsGoal cpos p w of + Just q -> ( (f , g) , addAction [MoveToFor q 100] cr ) + _ -> ( (f , g) , replaceAction [] cr ) + (FireAt p:gls) | noAmmo -> ( (tryUseItem cid . f , g ) + , replaceGoal [[Reload + ,PathTo p + ,WaitFor 50 + --,Search 1 ,WaitFor 100 + ]] + cr + ) + | canSeeFireVisionAll cid (_yourID w) w + -> ( (tryUseItem cid . f , g) + , replaceGoal [[FireAt ypos]] $ turnCloseSlow p cr + ) + | pathToPointFireable cid p w + -> ( (tryUseItem cid . f , g) + , Just $ turnCloseSlow p cr + ) + | otherwise -> ( (f , g) + , replaceGoal [[PathTo p,WaitFor 50 ]] cr + ) + (Reload:gls) | _wpReloadState wp == 0 -> ( (f , g) , replaceAction [] cr ) + | canSeeFireVisionAny cid (_yourID w) w + -> ( (f , g) + , Just $ turnCloseSlow ypos cr + ) -- no longer chase if see you when reloading + -- $ replaceAction [] w + | otherwise -> ( (f , g) , Just cr) + (Search i:gls) | i == 0 -> ( (f , g) , replaceAction [] cr) + | otherwise + -> ( ( f , g1) + , replaceAction [ PathTo (randomPointXStepsFrom 3 cpos w) + , Search (i-1) + ] cr + ) + (Guard p p':_) | dist ypos cpos < 900 && canSeeFireVisionAny cid (_yourID w) w + -> ( ( f , g1) + , addGoal [[AimAt ypos (2*aimtime)]] cr + ) + | dist cpos p > 10 + -> ( (f,g) , addGoal [[PathTo p]] cr) + | errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8 + -> ( (f,g) + ,Just $ crTurnTowardSpeed 0.05 p' cr) + | otherwise -> ( (f,g) ,Just cr) + (InitGuard :_) -> ( (f,g) + ,replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] cr + ) + (AimAt p i:_) | i == 0 -> ( (f,g) , replaceAction [FireAt p] cr ) + | canSeeFireVisionAll cid (_yourID w) w + -> ( (f,g) , replaceAction [AimAt ypos (i-1)] $ turnCloseSlow p cr) + | otherwise + -> ( (f,g) , replaceAction [AimAt p (i-1)] $ turnCloseSlow p cr) + +basicShooterAI :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) +basicShooterAI w (f,g) cr = + let cpos = _crPos cr + cid = _crID cr + ypos = _crPos $ you w + wp = _crInv cr IM.! _crInvSel cr + (aimtime,g1) = randomR (80,120) g + noAmmo = 0 == _wpLoadedAmmo wp + turnCloseSlow p | errorAngleVV 22 (p -.- cpos) + (unitVectorAtAngle (_crDir cr)) < 0.4 + = crTurnTowardSpeed 0.01 p + | otherwise = crTurnTowardSpeed 0.05 p + replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs) + addGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ gs) + replaceAction newActions + = Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass) + addAction newActions + = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) +-- autoFireTweak p | _wpIsAuto wp = Just +-- | otherwise = replaceGoal [[AimAt p (_wpFireRate wp * 2)]] + in --if _crHP cr <= 0 then killCr w f cr else + case head $ _goals $ _crState cr of + [] | canSeeFire cpos ypos w -> ( ( f , g1 ) + , replaceGoal [[AimAt ypos aimtime]] cr + ) + | otherwise -> ( ( f , g ) + , replaceGoal [] cr + ) + (WaitFor x:gls)| canSeeFire cpos ypos w -> ( ( f , g1 ) + , replaceGoal [[AimAt ypos aimtime]] cr + ) + | x == 0 -> ( (f ,g ), replaceAction [] cr ) + | otherwise -> ( (f ,g ), replaceAction [WaitFor (x-1)] cr ) + (MoveToFor p x:gls) + | canSeeFire cpos ypos w -> ( (f , g1) + , replaceGoal [[AimAt ypos aimtime]] cr + ) + | x == 0 -> ( (f , g) + , replaceAction [] cr + ) + | dist p cpos < 10 -> ( (f , g) , replaceAction [] cr) + | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4 + -> ( (f , g) + , replaceAction [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr ) + | otherwise -> ( (f , g) + , replaceAction [MoveToFor p (x-1)] $ crMvForward 2 + $ crTurnTowardSpeed 0.05 p cr ) + (PathTo p:_) | dist p cpos < 10 -> ( (f , g) , replaceAction [] cr ) + | hasLOS cpos p w -> ( (f , g) , addAction [MoveToFor p 100] cr ) + | otherwise -> case pointTowardsGoal cpos p w of + Just q -> ( (f , g) , addAction [MoveToFor q 100] cr ) + _ -> ( (f , g) , replaceAction [] cr ) + (FireAt p:gls) | noAmmo -> ( (tryUseItem cid . f , g ) + , replaceGoal [[Reload + ,PathTo p + ,WaitFor 50 + --,Search 1 ,WaitFor 100 + ]] + cr + ) + | canSeeFireVisionAll cid (_yourID w) w + -> ( (tryUseItem cid . f , g) + , replaceGoal [[FireAt ypos]] $ turnCloseSlow p cr + ) + | pathToPointFireable cid p w + -> ( (tryUseItem cid . f , g) + , Just $ turnCloseSlow p cr + ) + | otherwise -> ( (f , g) + , replaceGoal [[PathTo p,WaitFor 50 ]] cr + ) + (Reload:gls) | _wpReloadState wp == 0 -> ( (f , g) , replaceAction [] cr ) + | canSeeFireVisionAny cid (_yourID w) w + -> ( (f , g) + , Just $ turnCloseSlow ypos cr + ) -- no longer chase if see you when reloading + -- $ replaceAction [] w + | otherwise -> ( (f , g) , Just cr) + (Search i:gls) | i == 0 -> ( (f , g) , replaceAction [] cr) + | otherwise + -> ( ( f , g1) + , replaceAction [ PathTo (randomPointXStepsFrom 3 cpos w) + , Search (i-1) + ] cr + ) + (Guard p p':_) | dist ypos cpos < 900 && canSeeFireVisionAny cid (_yourID w) w + -> ( ( f , g1) + , addGoal [[AimAt ypos (2*aimtime)]] cr + ) + | dist cpos p > 10 + -> ( (f,g) , addGoal [[PathTo p]] cr) + | errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8 + -> ( (f,g) + ,Just $ crTurnTowardSpeed 0.05 p' cr) + | otherwise -> ( (f,g) ,Just cr) + (InitGuard :_) -> ( (f,g) + ,replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] cr + ) + (AimAt p i:_) | i == 0 -> ( (f,g) , replaceAction [FireAt p] cr ) + | canSeeFireVisionAll cid (_yourID w) w + -> ( (f,g) , replaceAction [AimAt ypos (i-1)] $ turnCloseSlow p cr) + | otherwise + -> ( (f,g) , replaceAction [AimAt p (i-1)] $ turnCloseSlow p cr) +sniperAI :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) +sniperAI w (f,g) cr = + let cpos = _crPos cr + cid = _crID cr + ypos = _crPos $ you w + wp = _crInv cr IM.! _crInvSel cr + (aimtime,g1) = randomR (80,120) g + noAmmo = 0 == _wpLoadedAmmo wp + turnCloseSlow p | errorAngleVV 22 (p -.- cpos) + (unitVectorAtAngle (_crDir cr)) < 0.4 + = crTurnTowardSpeed 0.01 p + | otherwise = crTurnTowardSpeed 0.05 p + replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs) + addGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ gs) + replaceAction newActions + = Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass) + addAction newActions + = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) +-- autoFireTweak p | _wpIsAuto wp = Just +-- | otherwise = replaceGoal [[AimAt p (_wpFireRate wp * 2)]] + in --if _crHP cr <= 0 then killCr w f cr else + case head $ _goals $ _crState cr of + [] | canSeeFire cpos ypos w -> ( ( f , g1 ) + , replaceGoal [[AimAt ypos aimtime]] cr + ) + | otherwise -> ( ( f , g ) + , replaceGoal [] cr + ) + (WaitFor x:gls)| canSeeFire cpos ypos w -> ( ( f , g1 ) + , replaceGoal [[AimAt ypos aimtime]] cr + ) + | x == 0 -> ( (f ,g ), replaceAction [] cr ) + | otherwise -> ( (f ,g ), replaceAction [WaitFor (x-1)] cr ) + (MoveToFor p x:gls) + | canSeeFire cpos ypos w -> ( (f , g1) + , replaceGoal [[AimAt ypos aimtime]] cr + ) + | x == 0 -> ( (f , g) + , replaceAction [] cr + ) + | dist p cpos < 1 -> ( (f , g) , replaceAction [] cr) + | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4 + -> ( (f , g) + , replaceAction [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr ) + | otherwise -> ( (f , g) + , replaceAction [MoveToFor p (x-1)] $ crMvForward 2 + $ crTurnTowardSpeed 0.05 p cr ) + (PathTo p:_) | dist p cpos < 1 -> ( (f , g) , replaceAction [] cr ) + | hasLOS cpos p w -> ( (f , g) , addAction [MoveToFor p 100] cr ) + | otherwise -> case pointTowardsGoal cpos p w of + Just q -> ( (f , g) , addAction [MoveToFor q 100] cr ) + _ -> ( (f , g) , replaceAction [] cr ) + (FireAt p:gls) | noAmmo -> ( (tryUseItem cid . f , g ) + , replaceGoal [[Reload + ,WaitFor 50 + --,Search 1 ,WaitFor 100 + ]] + cr + ) + | canSeeFireVisionAll cid (_yourID w) w + -> ( (tryUseItem cid . f , g) + , replaceGoal [[FireAt ypos]] $ turnCloseSlow p cr + ) + | pathToPointFireable cid p w + -> ( (tryUseItem cid . f , g) + , Just $ turnCloseSlow p cr + ) + | otherwise -> ( (f , g) + , replaceGoal [[WaitFor 50 ]] cr + ) + (Reload:gls) | _wpReloadState wp == 0 -> ( (f , g) , replaceAction [] cr ) + | canSeeFireVisionAny cid (_yourID w) w + -> ( (f , g) + , Just $ turnCloseSlow ypos cr + ) -- no longer chase if see you when reloading + -- $ replaceAction [] w + | otherwise -> ( (f , g) , Just cr) + (Search i:gls) | i == 0 -> ( (f , g) , replaceAction [] cr) + | otherwise + -> ( ( f , g1) + , replaceAction [ PathTo (randomPointXStepsFrom 3 cpos w) + , Search (i-1) + ] cr + ) + (Guard p p':_) | canSeeFireVision cid (_yourID w) w + -> ( ( f , g1) + , addGoal [[AimAt ypos (2*aimtime)]] cr + ) + | dist cpos p > 1 + -> ( (f,g) , addGoal [[PathTo p]] cr) + | errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8 + -> ( (f,g) + ,Just $ crTurnTowardSpeed 0.05 p' cr) + | otherwise -> ( (f,g) ,Just cr) + (InitGuard :_) -> ( (f,g) + ,replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] cr + ) + (AimAt p i:_) | i == 0 -> ( (f,g) , replaceAction [FireAt p] cr ) + | canSeeFireVision cid (_yourID w) w + -> ( (f,g) , replaceAction [AimAt ypos (i-1)] $ crTurnTowardSpeed 0.2 p cr) + | otherwise + -> ( (f,g) , replaceAction [AimAt p (i-1)] $ turnCloseSlow p cr) +--closeShooterAI :: Int -> World -> World +--closeShooterAI cid w = let cr = _creatures w IM.! cid +-- cpos = _crPos cr +-- ypos = _crPos $ you w +-- wp = _crInv cr IM.! _crInvSel cr +-- noAmmo = 0 == _wpLoadedAmmo wp +-- turnCloseSlow p | errorAngleVV 22 (p -.- cpos) +-- (unitVectorAtAngle (_crDir cr)) < 0.4 +-- = turnTowardSpeed 0.01 p cid +-- | otherwise = turnTowardSpeed 0.05 p cid +-- replaceGoal newGoals = over (creatures . ix cid . crState . goals) +-- (\gs -> newGoals ++ tail gs) +-- addGoal newGoals = over (creatures . ix cid . crState . goals) +-- (\gs -> newGoals ++ gs) +-- replaceAction newActions = over (creatures . ix cid . crState . goals) +-- (\((_:as):ass) -> (newActions ++ as):ass) +-- addAction newActions = over (creatures . ix cid . crState . goals) +-- (\(as:ass) -> (newActions++as):ass) +-- autoFireTweak p | _wpIsAuto wp = id +-- | otherwise = replaceGoal [[AimAt p (_wpFireRate wp * 2)]] +-- in if _crHP cr <= 0 then killCr cid w else +-- case head $ _goals $ _crState cr of +-- [] | canSeeAny cid (_yourID w) w +-- -> replaceGoal [[AimAt ypos 50]] w +-- | otherwise -> replaceGoal [] w +-- (WaitFor x:gls)| canSeeAny cid (_yourID w) w +-- -> replaceGoal [[AimAt ypos 50]] w +-- | x == 0 -> replaceAction [] w +-- | otherwise -> replaceAction [WaitFor (x-1)] w +-- (MoveToFor p x:gls) +-- | canSeeAny cid (_yourID w) w -> replaceGoal [[AimAt ypos 50]] w +-- | x == 0 || not (canSeePoint cid p w) -> replaceAction [] w +-- | dist p cpos < 10 -> replaceAction [] w +-- | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4 +-- -> replaceAction [MoveToFor p (x-1)] $ turnTowardSpeed 0.05 p cid w +-- | otherwise -> replaceAction [MoveToFor p (x-1)] +-- $ mvForward speed cid $ turnTowardSpeed 0.05 p cid w +-- (PathTo p:_) | dist p cpos < 10 -> replaceAction [] w +-- | canSeePoint cid p w -> addAction [MoveToFor p 100] w +-- | otherwise -> case pointTowardsGoal cpos p w of +-- Just q -> addAction [MoveToFor q 100] w +-- _ -> replaceAction [] w +-- (MoveFire mp tp:gls) +-- | noAmmo -> replaceGoal [[Reload +-- ,MoveFire mp tp +-- ]] +-- $ tryUseItem cid w +-- | not $ canSeeAll cid (_yourID w) w -> replaceAction [PathTo tp,Search 1] w +-- | dist cpos mp < 10 -> replaceAction [MoveFire ypos ypos] $ turnCloseSlow tp +-- $ tryUseItem cid w +-- | otherwise -> replaceAction [MoveFire mp ypos] +-- $ turnCloseSlow tp $ strafeTo speed mp cid +-- $ tryUseItem cid w +-- (Reload:gls) | _wpReloadState wp == 0 -> replaceAction [] w +-- | canSeeAny cid (_yourID w) w -> turnCloseSlow ypos +-- $ replaceAction [Reload,MoveFire ypos ypos,Search 1] +-- $ replaceAction [] w +-- | otherwise -> w +-- (Guard p p':_)| canSeeAny cid (_yourID w) w +-- -> addGoal [[AimAt ypos 50]] w +-- | dist cpos p > 10 +-- -> addGoal [[PathTo p]] w +-- | errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8 +-- -> turnTowardSpeed 0.05 p' cid w +-- | otherwise -> w +-- (InitGuard :_) -> replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] w +-- (AimAt p i:_) | i == 0 -> replaceAction [MoveFire p p] w +-- | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4 +-- -> replaceAction [AimAt p (i-1)] $ turnTowardSpeed 0.05 p cid w +-- | canSeeAll cid (_yourID w) w +-- -> replaceAction [AimAt ypos (i-1)] $ turnCloseSlow p +-- $ strafeTo speed p cid w +-- | otherwise +-- -> replaceGoal [[AimAt p (i-1),Search 1]] $ turnCloseSlow p +-- $ strafeTo speed p cid w +-- (Search i:gls) | i == 0 -> replaceAction [] w +-- | otherwise -> replaceAction [PathTo (randomPointXStepsFrom 3 cpos w) +-- ] $ over randGen (snd . next) w +-- where speed = 2 + +strafeTo :: Float -> Point2 -> Int -> World -> World +strafeTo speed targPos cid w = over (creatures . ix cid . crPos) (+.+ q) w + where q = (*.*) (speed * equipFactor * wpFactor) + $ safeNormalizeV $ (targPos -.- _crPos cr) + equipFactor = product $ map equipSpeed $ IM.elems $ _crInv $ _creatures w IM.! cid + cr = _creatures w IM.! cid + wpFactor = _itAimingSpeed (_crInv cr IM.! _crInvSel cr) + +randomGraphStep :: RandomGen g => Int -> Gr a b -> State g (Maybe Int) +randomGraphStep n g = + do let ns = neighbors g n + i <- state $ randomR (0,length ns - 1) + case ns of [] -> return Nothing + _ -> return $ Just $ ns !! i +randomGraphStepRestricted :: RandomGen g => Int -> [Int] -> Gr a b -> State g (Maybe Int) +randomGraphStepRestricted n notns g = + do let ns = neighbors g n \\ notns + i <- state $ randomR (0,length ns - 1) + case ns of [] -> return Nothing + _ -> return $ Just $ ns !! i + +---- continues a walk from a list of points, without repetitions +---- supposes that the list is non-empty +randomGraphWalk :: RandomGen g => [Int] -> Gr a b -> State g [Int] +randomGraphWalk (n:ns) g = + do next <- randomGraphStepRestricted n ns g + case next of Nothing -> return (n:ns) + Just n' -> randomGraphWalk (n':n:ns) g + +randomPointXStepsFrom :: Int -> Point2 -> World -> Point2 +randomPointXStepsFrom i p w = + let g = _pathGraph w + ns = labNodes g + mp = listToMaybe $ sortBy (compare `on` dist p . snd) $ filter (flip (isWalkable p) w . snd) ns + in case mp of Nothing -> p + Just (n,_) -> fromJust $ lab g + (last $ take i + $ evalState (randomGraphWalk [n] g) + $ _randGen w) + +randomPointsXStepsFrom :: Int -> Point2 -> World -> [Point2] +randomPointsXStepsFrom i p w = + let g = _pathGraph w + ns = labNodes g + mp = listToMaybe $ sortBy (compare `on` dist p . snd) $ filter (flip (isWalkable p) w . snd) ns + in case mp of Nothing -> [p] + Just (n,_) -> mapMaybe (lab g ) + (take i + $ evalState (randomGraphWalk [n] g) + $ _randGen w) + + +errorNormalizeVAI :: Point2 -> Point2 +errorNormalizeVAI (0,0) = error $ "problem with function: errorNormalizeVAI in DodgeAIs" +errorNormalizeVAI p = normalizeV p + +splitCritPict' :: Int -> Picture +splitCritPict' i = pictures $ (++) [color (greyN 0.1) $ circleSolid r,color green $ circLine r] $ concatMap (\p -> map (uncurry translate p) pic) $ take (2^(i-1)) rps + where pic = [color green $ circLine 6] + rps = fst $ runState ((sequence . repeat . randInCirc) (r-6)) $ mkStdGen 0 + r = sqrt ((fromIntegral i) * spCrRadFac) + +splitCritPict :: Float -> Picture +splitCritPict x = pictures [color (greyN 0.8) $ circleSolid x, color green $ circLine x] +splitCritCorpse :: Float -> Picture +splitCritCorpse x = color (greyN 0.2) $ circleSolid x +spCrRadFac = 8^2 + +<<<<<<< HEAD +======= +yourControl :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) +yourControl w (f,g) cr = ( (updateUsingInput . f, g) + , Just . crAutoReload . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed strafeSpeed 0 cr + ) + where strafeSpeed = _varMovementStrafeSpeedModifier w * equipFactor * (fromMaybe 1 $ yourItem w ^? itAimingSpeed) + speed = _varMovementSpeedModifier w * equipFactor + equipFactor = product $ map equipSpeed $ IM.elems $ _crInv $ _creatures w IM.! 0 + +wasdWithAiming :: World -> Float -> Float -> Int -> Creature -> Creature +wasdWithAiming w speed aimSpeed i cr + | (any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr) && isMoving && isAiming + && diffAngles mouseDir (argV mov) < pi/3 + = over crPos (+.+ (0.2 *.* mov)) +-- $ set ( creatures . ix i . crDir) (argV mov) + $ set crDir mouseDir + $ set (crState . stance . carriage) (Boosting mov) + cr + | (any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr) && isMoving && isAiming + = set crDir mouseDir + $ set (crState . stance . carriage) Floating + cr + | (any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr) && isMoving + = over crPos (+.+ (0.2 *.* mov)) +-- $ set ( creatures . ix i . crDir) (argV mov) + -- $ set ( creatures . ix i . crDir) mouseDir + $ over crDir (flip fromMaybe dir) + $ set (crState . stance . carriage) (Boosting mov) + cr + | (any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr) && isAiming + = set (crState . stance . carriage) Floating + $ set crDir mouseDir + cr + | any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr + = set (crState . stance . carriage) Floating + cr + | isAiming + = -- stopSoundFrom (CrSound i) $ + stepForward' aimSpeed + $ over crPos (+.+ (aimSpeed *.* mov)) + $ set crDir mouseDir + cr + | isMoving + = -- continueOrLoopFrom (CrSound i) twoStepSound $ + stepForward' speed + $ over ( crPos) (+.+ (speed *.* mov)) + $ over ( crDir) (flip fromMaybe dir) + cr + | otherwise + = -- stopSoundFrom (CrSound i) $ + over ( crDir) (flip fromMaybe dir) + cr + where (mov',dir') = wasdComp (view keys w) w + (mov,dir) = (rotateV (_cameraRot w) mov',fmap (_cameraRot w +) dir') + isMoving = mov' /= (0,0) + isAiming = (_posture $ _stance $ _crState cr) == Aiming + mouseDir = case w ^? creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) + . itAttachment of + Just (Just (ItScope {_scopePos = p})) -> normalizeAngle $ argV + $ p +.+ 2 / _cameraZoom w + *.* 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) + | scancode == moveDownKey (_keyConfig w) = (0,-1) + | scancode == moveRightKey (_keyConfig w) = (1,0) + | scancode == moveLeftKey (_keyConfig w) = (-1,0) +wasdM _ _ = (0,0) +--wasdM SDL.ScancodeW = (0,1) +--wasdM SDL.ScancodeS = (0,-1) +--wasdM SDL.ScancodeD = (1,0) +--wasdM SDL.ScancodeA = (-1,0) +--wasdM _ = (0,0) + +wasdComp :: S.Set SDL.Scancode -> World -> (Point2,Maybe Float) +wasdComp ks w = f $ foldr ( (+.+) . wasdM w ) (0,0) ks + where f (0,0) = ((0,0), Nothing) + f p = (errorNormalizeV 46 p, Just $ argV p) +>>>>>>> testing + +---------------- +circLine x = line [(0,0),(x,0)] + +sigmoid x = x/sqrt(1+x^2) diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index eaf038665..516414884 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -253,7 +253,7 @@ startCr = defaultCreature , _crMaxHP = 1500 , _crInv = IM.fromList (zip [0..20] ( - [pistol,autoGun,launcher,lasGun,grenade + [pistol,flameGrenade, teslaGrenade, autoGun,launcher,flameLauncher, poisonLauncher, teslaLauncher, lasGun,grenade ,ltAutoGun,flamer,multGun,spreadGun,remoteLauncher ,longGun ,hvAutoGun @@ -264,10 +264,36 @@ startCr = defaultCreature ,bezierGun ,poisonSprayer ,blinkGun - ,frontArmour - ] + ] +-- [pistol,autoGun,launcher,lasGun,grenade +-- ,ltAutoGun,flamer,multGun,spreadGun,remoteLauncher +-- ,longGun +-- ,hvAutoGun +-- ,teslaGun +-- ,latchkey 0 +-- ,miniGun +-- ,medkit 50 +-- ,bezierGun +-- ,poisonSprayer +-- ,blinkGun +-- ,frontArmour +-- ] ++ repeat NoItem)) -- startInv +-- ([pistol,flameGrenade, teslaGrenade, autoGun,launcher,flameLauncher, poisonLauncher, teslaLauncher, lasGun,grenade +-- ,ltAutoGun,flamer,multGun,spreadGun,remoteLauncher +-- ,longGun +-- ,hvAutoGun +-- ,teslaGun +-- ,latchkey 0 +-- ,miniGun +-- ,medkit 50 +-- ,bezierGun +-- ,poisonSprayer +-- ,blinkGun +-- ] +-- ++ repeat NoItem)) +-- -- startInv , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ pictures [color (greyN 0.8) $ circleSolid 10, circLine 10] } diff --git a/src/Dodge/Creature.hs.orig b/src/Dodge/Creature.hs.orig new file mode 100644 index 000000000..38941056c --- /dev/null +++ b/src/Dodge/Creature.hs.orig @@ -0,0 +1,314 @@ +module Dodge.Creature + ( module Dodge.Creature + , module Dodge.Creature.Inanimate + ) + where +-- imports {{{ +import Dodge.Data +import Dodge.AIs +import Dodge.CreatureState +import Dodge.Default +import Dodge.Base +import Dodge.Item.Weapon +import Dodge.Item.Consumable +import Dodge.WorldEvent.Cloud +import Dodge.Creature.YourControl +import Dodge.Creature.Inanimate + +import Picture +import Geometry + +import Data.List +import Data.Char +import Data.Maybe +import Data.Function +import Data.Graph.Inductive.Graph +import Data.Graph.Inductive.PatriciaTree +import Codec.BMP +import qualified Data.ByteString as B +import Control.Lens +import Control.Applicative +import Control.Monad.State +import Control.Monad +import System.Random +import qualified Data.Set as S +import qualified Data.IntMap.Strict as IM +import qualified Data.Map as M +import Foreign.ForeignPtr +import Control.Concurrent + +colouredEnemy col = pictures [color col $ circleSolid 10, circLine 10] + +spawnerCrit :: Creature +spawnerCrit = defaultCreature + { _crUpdate = stateUpdate $ spawnerAI chaseCrit + , _crHP = 300 + , _crPict = enemyPict blue + , _crState = defaultState {_goals = [[WaitFor 0]] + } + , _crInv = IM.empty -- IM.fromList [(0,frontArmour)] + } +smallChaseCrit :: Creature +smallChaseCrit = defaultCreature + { _crUpdate = stateUpdate chaseAI + , _crHP = 1 + , _crRad = 4 + , _crPict = enemyPict green + , _crState = defaultState {_goals = [[Wait]] + ,_faction = ChaseCritters} + , _crInv = IM.empty -- IM.fromList [(0,frontArmour)] + , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 4 + } +chaseCrit :: Creature +chaseCrit = defaultCreature + { _crUpdate = stateUpdate chaseAI + , _crHP = 300 + , _crPict = enemyPict green + , _crState = defaultState {_goals = [[Wait]] + ,_faction = ChaseCritters} + , _crInv = IM.empty + } +armourChaseCrit :: Creature +armourChaseCrit = defaultCreature + { _crUpdate = stateUpdate chaseAI + , _crHP = 300 + , _crPict = enemyPict green + , _crState = defaultState {_goals = [[Wait]]} + , _crInv = IM.fromList [(0,frontArmour)] + } +miniGunCrit :: Creature +miniGunCrit = defaultCreature + { _crPict = enemyPict red + , _crUpdate = stateUpdate miniAI + , _crInv = IM.fromList [(0,miniGun)] + , _crInvSel = 0 + , _crRad = 10 + , _crState = defaultState {_goals = [[InitGuard]]} + , _crHP = 500 + } +longCrit :: Creature +longCrit = defaultCreature + { _crPict = enemyPict red + , _crUpdate = stateUpdate sniperAI + , _crInv = IM.fromList [(0,longGun),(1,medkit 100)] + , _crInvSel = 0 + , _crRad = 10 + , _crState = defaultState {_goals = [[InitGuard]]} + , _crHP = 300 + } +multGunCrit :: Creature +multGunCrit = defaultCreature + { _crPict = enemyPict red + , _crUpdate = stateUpdate (twitchMissAI 300 350) + , _crInv = IM.fromList [(0,multGun),(1,medkit 100)] + , _crInvSel = 0 + , _crRad = 10 + , _crState = defaultState {_goals = [[InitGuard]]} + , _crHP = 300 + } +launcherCrit :: Creature +launcherCrit = defaultCreature + { _crPict = enemyPict red + , _crUpdate = stateUpdate (launcherAI 150 200) + , _crInv = IM.fromList [(0,launcher),(1,medkit 100)] + , _crInvSel = 0 + , _crRad = 10 + , _crState = defaultState {_goals = [[Init]]} + , _crHP = 300 + } +spreadGunCrit :: Creature +spreadGunCrit = defaultCreature + { _crPict = enemyPict red + , _crUpdate = stateUpdate chargeAI + , _crInv = IM.fromList [(0,spreadGun),(1,medkit 100)] + , _crInvSel = 0 + , _crRad = 10 + , _crState = defaultState {_goals = [[Init]]} + , _crHP = 300 + } +pistolCrit :: Creature +pistolCrit = defaultCreature + { _crPict = enemyPict red + , _crUpdate = stateUpdate (dodgeAI 150 200) + , _crInv = IM.fromList [(0,pistol),(1,medkit 100)] + , _crInvSel = 0 + , _crRad = 10 + , _crState = defaultState {_goals = [[InitGuard]]} + , _crHP = 500 + } +autoCrit :: Creature +autoCrit = defaultCreature + { _crPict = enemyPict red + --, _crUpdate = checkDeadStopSound n . shooterFootsteps n . makeStateAI autoShooterAI n + , _crUpdate = stateUpdate basicShooterAI + --, _crUpdate = shooterFootsteps n . makeStateAI autoShooterAI n + , _crInv = IM.fromList [(0,autoGun),(1,medkit 100)] + , _crInvSel = 0 + , _crRad = 10 + --, _crState = ShooterWait + , _crState = defaultState {_goals = [[InitGuard]]} + , _crHP = 300 + } +addArmour :: Creature -> Creature +addArmour = over crInv insarmour + where insarmour xs = IM.insert i frontArmour xs + where i = newKey xs + +equipOnTop :: (Creature -> Picture) -> Creature -> Picture +--equipOnTop f cr = onLayer CrLayer $ pictures $ fst (drawEquipment cr) ++ [f cr] ++ snd (drawEquipment cr) +equipOnTop f cr = pictures [onLayer CrLayer (f cr) , drawEquipment cr] + +drawEquipment :: Creature -> Picture +drawEquipment cr = pictures $ map f $ IM.toList (_crInv cr) + where f (i,it) = case it ^? itEquipPict of + Just g -> g cr i + _ -> blank + +--drawEquipment :: Creature -> ([Picture],[Picture]) +--drawEquipment cr = (map fst p1, map fst p2) +-- where f (k,it) = join $ (it ^? itEquipPict) <*> (pure cr) <*> (pure k) +-- picts = sortBy (compare `on` snd) $ mapMaybe f $ IM.toList (_crInv cr) +-- (p1,p2) = partition (\ x -> snd x < 0) picts + +frontArmouredPict = const $ pictures [ color (greyN 0.8) $ circleSolid 20 + , color red $ circLine 20 + ] + +--packCrits :: (Int -> World -> World) -> [Int] -> [Creature] +--packCrits ai is = [(defaultCreature i) +-- { _crPos = (150,10+20*fromIntegral i) +-- , _crPict = swarmPict +-- , _crUpdate = ai i +-- --, _crUpdate = swarmAI is i +-- , _crRad = 3 +-- , _crHP = 1 +-- , _crMass = 2 +-- } +-- | i <- is] + +--queenBeeCrit :: Int -> Creature +--queenBeeCrit cID = (defaultCreature cID) +-- { _crRad = 20 +-- , _crCorpse = color (greyN 0.5) $ circleSolid 20 +-- , _crPict = const $ pictures [color black $ circSolid 20 +-- ,color yellow $ circLine 20 +-- ] +-- , _crUpdate = checkDead cID . makeStateAI queenBeeAI cID +-- , _crState = QueenBee 0 20 +-- , _crMass = 20 +-- } + +--antCrit :: Int -> Creature +--antCrit cID = (defaultCreature cID) +-- { _crPos = (0,100 + 3 * fromIntegral cID) +-- , _crUpdate = checkDead cID . makeStateAI (antAI 2) cID +-- , _crState = AntMove 50 +-- , _crPict = antPic +-- , _crRad = 3 +-- , _crHP = 1 +-- , _crMass = 2 +-- , _crCorpse = color (greyN 0.5) $ circSolid 3 +-- } +-- where i = evalState (state (randomR (1::Int,100))) (mkStdGen cID) +--antPic = const $ pictures [ translate (-1) 0 $ circleSolid 2 +-- , translate (2) 0 $ circleSolid 1 +-- , translate (1) 0 $ circleSolid 1 +-- , line [(3,3),(-3,-3)] +-- , line [(-3,3),(3,-3)] +-- , line [(0,-3),(0,3)] +-- ] + +flamerPict = const $ pictures [color (light $ light $ light $ dim blue) $ circleSolid 10, circLine 10] + + + +goalPict cr = let r = _crRad cr in case _crState cr of + CrSt {_goals = gls ,_crDamage = crDam } +-- | crDam > _crHP cr -> color white $ circleSolid r + | otherwise -> case head gls of + [] -> sizeColEnemy r white + (MoveToFor p i:_) -> dGoals $ sizeColEnemy r green + (WaitFor x:_) -> dGoals $ sizeColEnemy r yellow + (FireAt p:_) -> dGoals $ sizeColEnemy r red + (Reload:_) -> dGoals $ sizeColEnemy r orange + (PathTo p:_) -> dGoals $ sizeColEnemy r cyan + (SubPathTo p i _:_) -> dGoals $ sizeColEnemy r blue + (Search i:_) -> dGoals $ sizeColEnemy r black + _ -> dGoals $ sizeColEnemy r magenta + where dGoals p = pictures [p, rotate (0 - _crDir cr) $ scale 0.1 0.1 $ color white $ text $ show gls] + _ -> sizeColEnemy r (light $ dim green) + +startCr :: Creature +startCr = defaultCreature + { _crPos = (0,0) + , _crOldPos = (0,0) + , _crDir = 0 + , _crID = 0 + , _crPict = basicCrPict $ greyN 0.8 + + , _crUpdate = stateUpdate yourControl + , _crRad = 10 + , _crMass = 10 + , _crHP = 10000 + , _crMaxHP = 1500 + , _crInv = IM.fromList (zip [0..20] +<<<<<<< HEAD:src/Dodge/Creature.hs + ( + [pistol,autoGun,launcher,lasGun,grenade + ,ltAutoGun,flamer,multGun,spreadGun,remoteLauncher + ,longGun + ,hvAutoGun + ,teslaGun + ,latchkey 0 + ,miniGun + ,medkit 50 + ,bezierGun + ,poisonSprayer + ,blinkGun + ,frontArmour + ] + ++ repeat NoItem)) + -- startInv +======= + ([pistol,flameGrenade, teslaGrenade, autoGun,launcher,flameLauncher, poisonLauncher, teslaLauncher, lasGun,grenade + ,ltAutoGun,flamer,multGun,spreadGun,remoteLauncher + ,longGun + ,hvAutoGun + ,teslaGun + ,latchkey 0 + ,miniGun + ,medkit 50 + ,bezierGun + ,poisonSprayer + ,blinkGun + ] + ++ repeat NoItem)) + -- startInv +>>>>>>> testing:src/Dodge/Critters.hs + , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ pictures [color (greyN 0.8) $ circleSolid 10, circLine 10] + } + +smokeGenGun = effectGun "smoke" $ \_ -> spawnSmokeAtCursor + +enemyPict :: Color -> Creature -> Picture +enemyPict col = equipOnTop $ sizeEnemy (light $ light $ light $ light col) + +sizeEnemy col cr + | pdam > 200 = color red $ circleSolid $ _crRad cr + | pdam > 100 = color white $ circleSolid $ _crRad cr + | mod pdam 2 == 1 = color white $ circleSolid $ _crRad cr + | otherwise = pictures [color col $ circleSolid $ _crRad cr + , circLine $ _crRad cr ] + where pdam = _crPastDamage $ _crState cr + +sizeColEnemy r col = pictures [color col $ circleSolid r, circLine r] + +basicCrPict :: Color -> Creature -> Picture +basicCrPict col cr = pictures [ onLayer CrLayer naked , drawEquipment cr] + where naked | pdam > 200 = color red $ circleSolid $ _crRad cr + | pdam > 100 = color white $ circleSolid $ _crRad cr + | mod pdam 2 == 1 = color white $ circleSolid $ _crRad cr + -- | crDam > _crHP cr && odd (crDam - _crHP cr) + -- = [color white $ circleSolid $ _crRad cr] + | otherwise = pictures [color col $ circleSolid $ _crRad cr, circLine $ _crRad cr] + pdam = _crPastDamage $ _crState cr diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index c4fff2f58..ba1d34616 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -24,17 +24,16 @@ yourControl :: World -> (World -> World,StdGen) -> Creature -> ((World -> World, yourControl w (f,g) cr = ( (updateUsingInput . f, g) , Just . crAutoReload . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed strafeSpeed 0 cr ) - where strafeSpeed = 8 * equipFactor * (fromMaybe 1 $ yourItem w ^? itAimingSpeed) - speed = 3 * equipFactor + where strafeSpeed = _varMovementSpeedModifier w * equipFactor * (fromMaybe 1 $ yourItem w ^? itAimingSpeed) + speed = _varMovementSpeedModifier w * equipFactor equipFactor = product $ map equipSpeed $ IM.elems $ _crInv $ _creatures w IM.! 0 wasdWithAiming :: World -> Float -> Float -> Int -> Creature -> Creature wasdWithAiming w speed aimSpeed i cr | (any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr) && isMoving && isAiming - && diffAngles mouseDir (argV mov) < pi/3 + && diffAngles mouseDir (argV mov) < pi/3 = over crPos (+.+ (0.2 *.* mov)) --- $ set ( creatures . ix i . crDir) (argV mov) - $ set crDir mouseDir + . set crDir mouseDir $ set (crState . stance . carriage) (Boosting mov) cr | (any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr) && isMoving && isAiming @@ -43,9 +42,7 @@ wasdWithAiming w speed aimSpeed i cr cr | (any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr) && isMoving = over crPos (+.+ (0.2 *.* mov)) --- $ set ( creatures . ix i . crDir) (argV mov) - -- $ set ( creatures . ix i . crDir) mouseDir - $ over crDir (flip fromMaybe dir) + . over crDir (flip fromMaybe dir) $ set (crState . stance . carriage) (Boosting mov) cr | (any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr) && isAiming @@ -56,20 +53,17 @@ wasdWithAiming w speed aimSpeed i cr = set (crState . stance . carriage) Floating cr | isAiming - = -- stopSoundFrom (CrSound i) $ - stepForward' aimSpeed - $ over crPos (+.+ (aimSpeed *.* mov)) - $ set crDir mouseDir - cr + = stepForward' aimSpeed + $ over crPos (+.+ (aimSpeed *.* mov)) + $ set crDir mouseDir + cr | isMoving - = -- continueOrLoopFrom (CrSound i) twoStepSound $ - stepForward' speed - $ over ( crPos) (+.+ (speed *.* mov)) - $ over ( crDir) (flip fromMaybe dir) - cr + = stepForward' speed + $ over ( crPos) (+.+ (speed *.* mov)) + $ over ( crDir) (flip fromMaybe dir) + cr | otherwise - = -- stopSoundFrom (CrSound i) $ - over ( crDir) (flip fromMaybe dir) + = over ( crDir) (flip fromMaybe dir) cr where (mov',dir') = wasdComp (view keys w) w (mov,dir) = (rotateV (_cameraRot w) mov',fmap (_cameraRot w +) dir') @@ -90,13 +84,9 @@ wasdM w scancode | scancode == moveRightKey (_keyConfig w) = (1,0) | scancode == moveLeftKey (_keyConfig w) = (-1,0) wasdM _ _ = (0,0) ---wasdM SDL.ScancodeW = (0,1) ---wasdM SDL.ScancodeS = (0,-1) ---wasdM SDL.ScancodeD = (1,0) ---wasdM SDL.ScancodeA = (-1,0) ---wasdM _ = (0,0) wasdComp :: S.Set SDL.Scancode -> World -> (Point2,Maybe Float) wasdComp ks w = f $ foldr ( (+.+) . wasdM w ) (0,0) ks where f (0,0) = ((0,0), Nothing) f p = (errorNormalizeV 46 p, Just $ argV p) + diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 337587a60..ed93e5393 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -74,6 +74,8 @@ data World = World , _seenLocations :: IM.IntMap (World -> Point2,String) , _selLocation :: Int , _keyConfig :: KeyConfigSDL + , _varMovementSpeedModifier :: Float + , _varMovementStrafeSpeedModifier :: Float } data Corpse = Corpse @@ -109,11 +111,11 @@ data Cloud = Cloud } data LightSource = LS - { _lsID :: !Int - , _lsPos :: !Point2 - , _lsDir :: !Float - , _lsRad :: !Float - , _lsIntensity :: !Float + { _lsID :: !Int + , _lsPos :: !Point2 + , _lsDir :: !Float + , _lsRad :: !Float + , _lsIntensity :: !Float } data TempLightSource = TLS @@ -475,14 +477,24 @@ type HitEffect = Particle' -> [(Point2, (Either3 Creature Wall ForceField))] -> -> (World,Maybe Particle') -data Projectile = Projectile - { _ptPos :: Point2 - , _ptStartPos :: Point2 - , _ptVel :: Point2 - , _ptPict :: Picture - , _ptID :: Int - , _ptUpdate :: World -> World - } +data Projectile + = Projectile + { _ptPos :: Point2 + , _ptStartPos :: Point2 + , _ptVel :: Point2 + , _ptPict :: Picture + , _ptID :: Int + , _ptUpdate :: World -> World + } + | Shell + { _ptPos :: Point2 + , _ptStartPos :: Point2 + , _ptVel :: Point2 + , _ptPict :: Picture + , _ptID :: Int + , _ptUpdate :: World -> World + , _ptExplosion :: Point2-> World -> World + } data DamageType = Piercing {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 } diff --git a/src/Dodge/Data.hs.orig b/src/Dodge/Data.hs.orig new file mode 100644 index 000000000..c403972bc --- /dev/null +++ b/src/Dodge/Data.hs.orig @@ -0,0 +1,691 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE StrictData #-} +module Dodge.Data + ( module Dodge.Data + , Point2 (..) + , Sound (..) + , soundTime + ) + where +import Picture.Data +import Geometry.Data +import Sound.Preload +import Control.Lens +import Control.Monad.State +import System.Random +import Data.Graph.Inductive +import qualified Data.Set as S +import qualified Data.IntMap.Strict as IM +import qualified Data.Map as M +import qualified SDL.Mixer as Mix +import SDL (Scancode, MouseButton) +import Graphics.Rendering.OpenGL (PrimitiveMode (..),GLfloat,Program,VertexArrayObject,BufferObject) +import Codec.Picture (Image,PixelRGBA8) +import qualified Data.DList as DL +import Dodge.LoadConfig + +data World = World + { _keys :: !(S.Set Scancode) + , _mouseButtons :: !(S.Set MouseButton) + , _cameraCenter :: !Point2 + , _cameraRot :: !Float + , _cameraZoom :: !Float + , _cameraViewFrom :: !Point2 + , _creatures :: IM.IntMap Creature + , _creaturesZone :: IM.IntMap (IM.IntMap (IM.IntMap Creature)) + , _itemPositions :: IM.IntMap ItemPos + , _clouds :: IM.IntMap Cloud + , _cloudsZone :: IM.IntMap (IM.IntMap (IM.IntMap Cloud)) + , _projectiles :: IM.IntMap Projectile + , _particles' :: ![Particle'] + , _walls :: !(IM.IntMap Wall) + , _wallsZone :: (IM.IntMap (IM.IntMap (IM.IntMap Wall))) + , _forceFields :: IM.IntMap ForceField + , _floorItems :: IM.IntMap FloorItem + , _randGen :: StdGen + , _mousePos :: !(Float,Float) + , _testString :: String + , _yourID :: !Int + , _worldEvents :: !(World -> World) + , _pressPlates :: IM.IntMap PressPlate + , _buttons :: IM.IntMap Button + , _soundQueue :: [Int] + , _sounds :: M.Map SoundOrigin Sound + , _decorations :: IM.IntMap Picture + , _corpses :: IM.IntMap (IM.IntMap [Corpse]) + , _clickMousePos :: (Float,Float) + , _pathGraph :: ~(Gr Point2 Float) + , _pathGraph' :: ~[(Point2,Point2)] + , _pathPoints :: ~(IM.IntMap (IM.IntMap [(Int,Point2)])) + , _pathInc :: ~(M.Map Point2 [Point2]) + , _storedLevel :: Maybe World + , _menuState :: MenuState + , _worldState :: M.Map WorldState Bool + , _windowX :: !Float + , _windowY :: !Float + , _carteDisplay :: !Bool + , _carteCenter :: !Point2 + , _carteZoom :: !Float + , _carteRot :: !Float + , _lightSources :: !(IM.IntMap LightSource) + , _tempLightSources :: ![TempLightSource] + , _closeActiveObjects :: [Either FloorItem Button] + , _seenLocations :: IM.IntMap (World -> Point2,String) + , _selLocation :: Int + , _keyConfig :: KeyConfigSDL + , _varMovementSpeedModifier :: Float + , _varMovementStrafeSpeedModifier :: Float + } + +data Corpse = Corpse + { _cpPos :: Point2 + , _cpPict :: Picture + , _cpRes :: Creature + } + +data Layer + = PtLayer + | CrLayer + | WlLayer + | BgLayer + | ShadowLayer + | FlItLayer + | LabelLayer + | InvLayer + | MenuLayer + | PressPlateLayer + | CorpseLayer + | UPtLayer + | HPtLayer + | GloomLayer + +data Cloud = Cloud + { _clID :: Int + , _clPos :: Point2 + , _clVel :: Point2 + , _clPict :: Cloud -> Picture + , _clRad :: Float + , _clTimer :: Int + , _clEffect :: Cloud -> World -> World + } + +data LightSource = LS + { _lsID :: !Int + , _lsPos :: !Point2 + , _lsDir :: !Float + , _lsRad :: !Float + , _lsIntensity :: !Float + } + +data TempLightSource = TLS + { _tlsPos :: !Point2 + , _tlsRad :: !Float + , _tlsIntensity :: !Float + , _tlsUpdate :: World -> TempLightSource -> (World, Maybe TempLightSource) + } + +data Creature = Creature + { _crPos :: Point2 + , _crOldPos :: Point2 + , _crDir :: Float + , _crID :: Int + , _crPict :: Creature -> Picture + , _crUpdate :: World -> (World -> World,StdGen) -> Creature + -> ((World -> World,StdGen), Maybe Creature) + , _crRad :: Float + , _crMass :: Float + , _crHP :: Int + , _crMaxHP :: Int + , _crInv :: IM.IntMap Item + , _crInvSel :: Int + , _crState :: CreatureState + , _crCorpse :: Picture + } + +data CreatureState = CrSt + { _goals :: [[Goal]] + , _stance :: Stance + , _faction :: Faction + , _crDamage :: [DamageType] + , _crPastDamage :: Int + , _crSpState :: CrSpState + , _crApplyDamage :: [DamageType] -> Creature -> (World -> World,Creature) + } + +data CrSpState + = Barrel { _piercedPoints :: [Point2]} + | GenCr + deriving (Eq,Show,Ord) +data Goal + = MoveTo Point2 + | MoveToFor Point2 Int + | MoveFire Point2 Point2 + | PathTo Point2 + | PathAlong [Point2] + | SubPathTo Point2 Int Point2 + | Wait + | WaitFor Int + | WaitForID Int Int + | FireAt Point2 + | FireAtID Int Point2 + | Fire + | Reload + | IncreaseAlert Int + | Guard Point2 Point2 + | Search Int + | SearchNear Point2 + | AimAt Point2 Int + | InitGuard + | Init + | MeleeAttack Int + | InitTrackYou + | TrackYou + | Track Int + | TrackFor Int Int + | TurnByFor Float Int + | TurnTo Point2 + | TurnToward Point2 + | TurnTowardAngle Float + | StrafeLeftAround Int Point2 + | StrafeRightAround Int Point2 + | StrafeLeftFor Int + | StrafeRightFor Int + | StrafeLeftForSpeed Int Float + | StrafeRightForSpeed Int Float + | StrafeLeftFire + | StrafeRightFire + | MoveForwardFor Int + | MoveForwardFire + | MoveBackwardFor Int + | MoveByFor Point2 Int + | MoveBackwardFire + | GoalID Int Goal + | AtRange Float + | AtRanges Float Float + | RepeatAction Int Goal + | MakeJudgement + | SetPosture Posture + deriving (Eq,Show) +data Stance = Stance + {_carriage :: Carriage + ,_posture :: Posture + } + deriving (Eq,Show) +data Carriage + = Walking { _stepCycle :: Int, _stepToAdd :: Int } + | Floating + | Boosting Point2 + deriving (Eq,Show) +data Posture = Aiming | AtEase + deriving (Eq,Show) +data Mind = ZombieMind | HumanMind + deriving (Eq,Show) +data Faction + = GenericFaction Int + | ZombieFaction + | EncircleFlock + | ChaseCritters + | SpawnedBy Int + | NoFaction + deriving (Eq,Show) + +-- NOTE: walls must be drawn counterclockwise +data WorldState = DoorNumOpen Int | CrNumAlive Int + deriving (Eq,Ord) + +data MenuState + = LevelMenu Int + | PauseMenu + | GameOverMenu + | InGame + deriving (Eq,Ord) + +data Button = Button + { _btPict :: Picture + , _btPos :: Point2 + , _btRot :: Float + , _btEvent :: Button -> World -> World + , _btID :: Int + , _btText :: String + , _btState :: ButtonState + } + +data ButtonState = BtOn | BtOff | BtNoLabel + deriving (Eq, Show) + +data PressPlate = PressPlate + { _ppPict :: Picture + , _ppPos :: Point2 + , _ppRot :: Float + , _ppEvent :: PressPlate -> World -> World + , _ppID :: Int + , _ppText :: String + } + +data FloorItem = FlIt { _flIt :: Item , _flItPos :: Point2 , _flItRot :: Float, _flItID :: Int} + +data ItemPos + = InInv { _itCrId :: Int , _itInvId :: Int } + | OnFloor { _itFlID :: Int } + +data Item + = Weapon + { _itName :: String + , _wpMaxAmmo :: Int + , _wpLoadedAmmo :: Int + , _wpReloadTime :: Int + , _wpReloadState :: Int + , _wpFireRate :: Int + , _wpFireState :: Int + , _wpFire :: Int -> World -> World + , _wpSpread :: Float + , _wpRange :: Float + , _itHammer :: HammerPosition + , _itFloorPict :: Picture + , _itMaxStack :: Int + , _itAmount :: Int + , _itAimingSpeed :: Float + , _itAimingRange :: Float + , _itZoom :: ItZoom + , _itEquipPict :: Creature -> Int -> Picture + , _itScrollUp :: Int -> World -> World + , _itScrollDown :: Int -> World -> World + , _itIdentity :: ItemIdentity + , _itAttachment :: Maybe ItAttachment + , _itID :: Maybe Int + , _itEffect :: ItEffect + , _itInvDisplay :: Item -> String + , _itInvColor :: Color + } + | Consumable + { _itName :: String + , _itMaxStack :: Int + , _itAmount :: Int + , _cnEffect :: Int -> World -> Maybe World + , _itFloorPict :: Picture + , _itEquipPict :: Creature -> Int -> Picture + , _itIdentity :: ItemIdentity + , _itID :: Maybe Int + , _itInvDisplay :: Item -> String + , _itInvColor :: Color + , _itEffect :: ItEffect + , _itHammer :: HammerPosition + } + | Craftable + { _itName :: String + , _itMaxStack :: Int + , _itAmount :: Int + , _itFloorPict :: Picture + , _itEquipPict :: Creature -> Int -> Picture + , _itIdentity :: ItemIdentity + , _itID :: Maybe Int + , _itInvDisplay :: Item -> String + , _itInvColor :: Color + } + | Equipment + { _itName :: String + , _itMaxStack :: Int + , _itAmount :: Int + , _itFloorPict :: Picture + , _itEquipPict :: Creature -> Int -> Picture + , _itIdentity :: ItemIdentity + , _itEffect :: ItEffect + , _itID :: Maybe Int + , _itAimingSpeed :: Float + , _itAimingRange :: Float + , _itZoom :: ItZoom + , _itInvDisplay :: Item -> String + , _itInvColor :: Color + , _itHammer :: HammerPosition + } + | Throwable + { _itName :: String + , _itMaxStack :: Int + , _itAmount :: Int + , _itFloorPict :: Picture + , _twMaxRange :: Float + , _twAccuracy :: Float + , _twFire :: Int -> World -> World + , _itAimingSpeed :: Float + , _itAimingRange :: Float + , _itZoom :: ItZoom + , _itEquipPict :: Creature -> Int -> Picture + , _itIdentity :: ItemIdentity + , _itID :: Maybe Int + , _itAttachment :: Maybe ItAttachment + , _itInvDisplay :: Item -> String + , _itInvColor :: Color + , _itEffect :: ItEffect + , _itHammer :: HammerPosition + , _itScrollUp :: Int -> World -> World + , _itScrollDown :: Int -> World -> World + } + | NoItem + +data ItAttachment + = ItScope + {_scopePos :: Point2 + ,_scopeZoomChange :: Int + ,_scopeZoom :: Float + ,_scopeIsCamera :: Bool + } + | ItFuse {_itFuseTime :: Int} + | ItPhaseV {_itPhaseV :: Float} + | ItMode {_itMode :: Int} + | ItTargetPos { _itTargetPos :: Point2 } + +data ItEffect = NoItEffect + | ItInvEffect + {_itInvEffect :: Creature -> Int -> World -> World + ,_itEffectCounter :: Int + } + | ItEffect + {_itInvEffect :: Creature -> Int -> World -> World + ,_itFloorEffect :: Int -> World -> World + ,_itEffectCounter :: Int + } +data ItZoom = ItZoom + {_itAimZoomMax :: Float + ,_itAimZoomMin :: Float + ,_itAimZoomFac :: Float + ,_itZoomMax :: Float + ,_itZoomMin :: Float + ,_itZoomFac :: Float + } + +data IntID a = IntID Int a + +data HammerPosition + = HammerDown + | HammerReleased + | HammerUp + | NoHammer + +data ItemIdentity + = Pistol + | SpreadGun + | MultGun + | HvAutoGun + | AutoGun + | LtAutoGun + | MiniGun + | Medkit25 + | MagShield + | FrontArmour + | JetPack + | FlameShield + | Generic + | SparkGun + | ShatterGun + | LongGun + | Flamethrower + | Blinker + | Grenade + | RemoteBomb + | TeslaGun + | LasGun + | ForceFieldGun + | GrapGun + | TractorGun + | Launcher + | RemoteLauncher + | LightningGun + | PoisonSprayer + deriving (Eq,Show,Ord,Enum) + +data Particle' + = Particle' + { _ptDraw :: Particle' -> Picture + , _ptUpdate' :: World -> Particle' -> (World, Maybe Particle') + } + | Bul' + { _ptDraw :: Particle' -> Picture + , _ptUpdate' :: World -> Particle' -> (World, Maybe Particle') + , _btVel' :: Point2 + , _btColor' :: Color + , _btTrail' :: [Point2] + , _btPassThrough' :: Maybe Int + , _btWidth' :: Float + , _btTimer' :: Int + , _btHitEffect' :: HitEffect + } + | Pt' + { _ptDraw :: Particle' -> Picture + , _ptUpdate' :: World -> Particle' -> (World, Maybe Particle') + , _btVel' :: Point2 + , _btColor' :: Color + , _btPos' :: Point2 + , _btPassThrough' :: Maybe Int + , _btWidth' :: Float + , _btTimer' :: Int + , _btHitEffect' :: HitEffect + } + | Shockwave' + { _ptDraw :: Particle' -> Picture + , _ptUpdate' :: World -> Particle' -> (World, Maybe Particle') + , _btColor' :: Color + , _btPos' :: Point2 + , _btRad' :: Float + , _btDam' :: Int + , _btPush' :: Float + , _btMaxTime' :: Int + , _btTimer' :: Int + } + +type HitEffect = Particle' -> [(Point2, (Either3 Creature Wall ForceField))] -> World + -> (World,Maybe Particle') + + +<<<<<<< HEAD +data Projectile = Projectile + { _ptPos :: Point2 + , _ptStartPos :: Point2 + , _ptVel :: Point2 + , _ptPict :: Picture + , _ptID :: Int + , _ptUpdate :: World -> World + } + +data DamageType + = Piercing {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 } + | Blunt {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 } + | SparkDam {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 } + | Flaming {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 } + | Lasering {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 } + | Concussive + { _dmAmount :: Int + , _dmFrom :: Point2 + , _dmPush :: Float + , _dmPushExp :: Float + , _dmPushRadius :: Float + } + | TorqueDam {_dmAmount :: Int , _dmTorque :: Float } + | PushDam {_dmAmount :: Int , _dmPushBack :: Point2 } + | PoisonDam {_dmAmount :: Int} + deriving (Eq,Ord,Show) +======= +data Projectile = Projectile { _ptPos :: Point2 + , _ptStartPos :: Point2 + , _ptVel :: Point2 + , _ptPict :: Picture + , _ptID :: Int + , _ptUpdate :: World -> World + } + | Shell { _ptPos :: Point2 + , _ptStartPos :: Point2 + , _ptVel :: Point2 + , _ptPict :: Picture + , _ptID :: Int + , _ptUpdate :: World -> World + , _ptExplosion :: Point2-> World -> World + } + +data DamageType = Piercing {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 } + | Blunt {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 } + | SparkDam {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 } + | Flaming {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 } + | Lasering {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 } + | Concussive {_dmAmount :: Int , _dmFrom :: Point2 , _dmPush :: Float + , _dmPushExp :: Float + , _dmPushRadius :: Float} + | TorqueDam {_dmAmount :: Int , _dmTorque :: Float } + | PushDam {_dmAmount :: Int , _dmPushBack :: Point2 } + | PoisonDam {_dmAmount :: Int} + deriving (Eq,Ord,Show) +>>>>>>> testing + +data Either3 a b c = E3x1 a | E3x2 b | E3x3 c + +data WLID = WLID { _wlIDx :: Int, _wlIDy :: Int, _wlIDid :: Int} + +data Wall + = Wall + { _wlLine :: [Point2] , _wlID :: Int + , _wlColor :: Color + , _wlDraw :: Maybe (Wall -> Picture) + , _wlSeen :: Bool + , _wlIsSeeThrough :: Bool + } + | BlockAutoDoor + { _wlLine :: [Point2] + , _wlID :: Int + , _doorMech :: World -> World + , _wlColor :: Color + , _wlDraw :: Maybe (Wall -> Picture) + , _wlSeen :: Bool + , _blIDs :: [Int] + , _blHP :: Int + , _wlIsSeeThrough :: Bool + } + | Door + { _wlLine :: [Point2] , _wlID :: Int + , _doorMech :: World -> World + , _wlColor :: Color + , _wlDraw :: Maybe (Wall -> Picture) + , _wlSeen :: Bool + , _wlIsSeeThrough :: Bool + , _doorPathable :: Bool + } + | Block + { _wlLine :: [Point2] + , _wlID :: Int + , _wlColor :: Color + , _wlDraw :: Maybe (Wall -> Picture) + , _wlSeen :: Bool + , _blIDs :: [Int] + , _blHP :: Int + , _wlIsSeeThrough :: Bool + , _blVisible :: Bool + , _blDegrades :: [Int] + , _blShadows :: [Int] + } + +data ForceField = FF + { _ffLine :: [Point2] , _ffID :: Int + , _ffColor :: Color + , _ffDeflect :: Maybe (StdGen -> Point2 -> ForceField -> (Point2,StdGen)) + , _ffState :: FFState + } +data FFState = FFDestroyable { _ffsHP :: Int } + +data SoundOrigin = InventorySound + | BackgroundSound + | OnceSound + | CrSound Int + | CrWeaponSound Int + | WallSound Int + | CrReloadSound Int + | Flamer + | ShellSound Int + | Flame + | LasSound + | FootstepSound Int + | BlockDegradeSound Int + | CrHitSound Int + | BarrelHiss Int + | GlassBreakSound Int + deriving (Eq,Ord,Show) + +type Poly = [Point2] +data PSType = PutCrit Creature + | PutLS LightSource Picture + | PutButton Button + | PutFlIt FloorItem + | PutPressPlate PressPlate + | PutAutoDoor Point2 Point2 + | PutBlock [Int] Color [Point2] + | PutLineBlock Wall Float Float Point2 Point2 + | PutTriggerDoor Color (World -> Bool) Point2 Point2 + | PutBtDoor Color Point2 Float Point2 Point2 + | PutSwitchDoor Color Point2 Float Point2 Point2 + | RandPS (State StdGen PSType) + | PutNothing + | CollectivePS + { _collectiveID :: Int + , _collectiveNum :: Int + , _collectiveFunction :: [Int] -> State StdGen [PSType] + } + | LabelPS { _psLabel :: Int, _ps :: PSType} + | PutWindow { _pwPoly :: [Point2] , _pwColor :: Color + } +data PlacementSpot = PS + { _psPos :: Point2 + , _psRot :: Float + , _psType :: PSType + } +data Room = Room + { _rmPolys :: [Poly] + , _rmLinks :: [(Point2,Float)] + , _rmPath :: [(Point2, Point2)] + , _rmPS :: [PlacementSpot] + , _rmBound :: Poly + } + +data SubNode a = SN a | InLink | OutLink + +data RoomLink = RL {_rlPos :: Point2, _rlRot :: Float} + +makeLenses ''RoomLink +makeLenses ''World +makeLenses ''Cloud +makeLenses ''Creature +makeLenses ''CreatureState +makeLenses ''CrSpState +makeLenses ''Goal +makeLenses ''LightSource +makeLenses ''TempLightSource +makeLenses ''Stance +makeLenses ''Carriage +makeLenses ''Posture +makeLenses ''Item +makeLenses ''ItemPos +makeLenses ''ItEffect +makeLenses ''ItAttachment +makeLenses ''ItZoom +makeLenses ''FloorItem +makeLenses ''Projectile +makeLenses ''Particle' +makeLenses ''Wall +makeLenses ''ForceField +makeLenses ''FFState +makeLenses ''PressPlate +makeLenses ''Button +makeLenses ''PSType +makeLenses ''PlacementSpot +makeLenses ''Room + +numColor :: Int -> Color +numColor 0 = (1,0,0,1) +numColor 1 = (0,1,0,1) +numColor 2 = (0,0,1,1) +numColor 3 = (1,1,0,1) +numColor 4 = (0,1,1,1) +numColor 5 = (1,0,1,1) +numColor 6 = (1,0,0.5,1) +numColor 7 = (0.5,0,1,1) +numColor 8 = (0,0.5,1,1) +numColor 9 = (0,1,0.5,1) +numColor 10 = (0.5,1,0,1) +numColor 11 = (1,0.5,0,1) +numColor 12 = (1,1,1,1) diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 8bac01a8f..027e44db6 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -230,6 +230,8 @@ defaultWorld = World ] , _selLocation = 0 , _keyConfig = defaultKeyConfigSDL + , _varMovementSpeedModifier = 3 + , _varMovementStrafeSpeedModifier = 3 } youLight = -- LS {_lsEff = \w _ p -> (logistic 1 1 1 (d p w * 0.01) ) diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 62772eee2..2fe3f6133 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -35,6 +35,8 @@ handlePressedKey _ scancode w -- Rotation seems to be duplicated here and in Camera.hs ? why | scancode == rotateCameraPlusKey (_keyConfig w) = Just $ w {_cameraRot = _cameraRot w + 0.01} | scancode == rotateCameraMinusKey (_keyConfig w) = Just $ w {_cameraRot = _cameraRot w - 0.01} + | scancode == ScancodeF7 = Just $ w {_varMovementSpeedModifier = _varMovementSpeedModifier w - 1} + | scancode == ScancodeF8 = Just $ w {_varMovementSpeedModifier = _varMovementSpeedModifier w + 1} handlePressedKey _ _ w = Just w diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 519b8b6f0..47d87e27c 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -331,6 +331,21 @@ launcher = defaultGun , _itHammer = NoHammer , _itEffect = NoItEffect } +flameLauncher = launcher + { _itName = "FLROCKO" + , _wpFire = shoot $ aRocket' makeFlameShellAt + } + +poisonLauncher = launcher + { _itName = "POISROCK" + , _wpFire = shoot $ aRocket' makePoisonShellAt + } + +teslaLauncher = launcher + { _itName = "TESLROCK" + , _wpFire = shoot $ aRocket' makeTeslaShellAt + } + bezierGun = defaultAutoGun { _itName = "B-GUN" , _wpFire = maybeSetTarget $ \p -> shootWithSound 0 @@ -696,36 +711,80 @@ aTractorBeam col cid w dir = _crDir cr itRef = _crInvSel cr -aRocket :: Int -> World -> World -aRocket cid w +-- |The aRocket' function allows us to define the shell to be used +aRocket' :: (Int -> Int -> Point2 -> Float -> Projectile) -> Int -> World -> World +aRocket' shell cid w = soundOnce (fromIntegral launcherSound) - $ over projectiles (IM.insert i (makeShellAt i cid pos dir)) w + $ over projectiles (IM.insert i (shell i cid pos dir)) w where i = newProjectileKey w cr = (_creatures w IM.! cid) pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) dir = _crDir cr +aRocket :: Int -> World -> World +aRocket = aRocket' makeShellAt +-- = soundOnce (fromIntegral launcherSound) +-- $ over projectiles (IM.insert i (makeShellAt i cid pos dir)) w +-- where i = newProjectileKey w +-- cr = (_creatures w IM.! cid) +-- pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) +-- dir = _crDir cr + makeShellAt :: Int -> Int -> Point2 -> Float -> Projectile -makeShellAt i cid pos dir = Projectile +makeShellAt i cid pos dir = Shell { _ptPos = pos , _ptStartPos = pos , _ptVel = rotateV dir (1,0) , _ptPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic , _ptID = i , _ptUpdate = moveShell 50 i cid 0 (rotateV dir (2,0)) + , _ptExplosion = shellExplosionAt + } + +makeFlameShellAt :: Int -> Int -> Point2 -> Float -> Projectile +makeFlameShellAt i cid pos dir = Shell + { _ptPos = pos + , _ptStartPos = pos + , _ptVel = rotateV dir (1,0) + , _ptPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic + , _ptID = i + , _ptUpdate = moveShell 50 i cid 0 (rotateV dir (2,0)) + , _ptExplosion = makeFlameExplosionAt + } + +makePoisonShellAt :: Int -> Int -> Point2 -> Float -> Projectile +makePoisonShellAt i cid pos dir = Shell + { _ptPos = pos + , _ptStartPos = pos + , _ptVel = rotateV dir (1,0) + , _ptPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic + , _ptID = i + , _ptUpdate = moveShell 50 i cid 0 (rotateV dir (2,0)) + , _ptExplosion = makePoisonExplosionAt + } + +makeTeslaShellAt :: Int -> Int -> Point2 -> Float -> Projectile +makeTeslaShellAt i cid pos dir = Shell + { _ptPos = pos + , _ptStartPos = pos + , _ptVel = rotateV dir (1,0) + , _ptPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic + , _ptID = i + , _ptUpdate = moveShell 50 i cid 0 (rotateV dir (2,0)) + , _ptExplosion = makeTeslaExplosionAt } moveShell :: Int -> Int -> Int -> Float -> Point2 -> World -> World moveShell time i cid rot accel w | time > 40 = if circOnSomeWall oldPos 4 w - then shellExplosionAt oldPos $ over projectiles (IM.delete i) w + then projectileExplosion oldPos $ over projectiles (IM.delete i) w else over (projectiles . ix i . ptPos) (+.+ vel) $ set (projectiles . ix i . ptPict) piclow $ set (projectiles . ix i . ptUpdate) (moveShell (time-1) i cid rot (rotateV rot accel)) w | time == 35 = case thingHit of - Just p -> shellExplosionAt oldPos + Just p -> projectileExplosion oldPos $ over projectiles (IM.delete i) w Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) $ set (projectiles . ix i . ptPict) pic @@ -733,7 +792,7 @@ moveShell time i cid rot accel w (moveShell (time-1) i cid spin accel) w | time >= 20 = case thingHit of - Just p -> shellExplosionAt oldPos + Just p -> projectileExplosion oldPos $ over projectiles (IM.delete i) w Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) $ set (projectiles . ix i . ptPict) pic @@ -742,7 +801,7 @@ moveShell time i cid rot accel w w | time > -99 = case thingHit of - Just p -> shellExplosionAt oldPos + Just p -> projectileExplosion oldPos $ stopSoundFrom (ShellSound i) $ over projectiles (IM.delete i) w Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) @@ -757,7 +816,7 @@ moveShell time i cid rot accel w $ smokeGen w | time > -200 = case thingHit of - Just p -> shellExplosionAt oldPos + Just p -> projectileExplosion oldPos $ stopSoundFrom (ShellSound i) $ over projectiles (IM.delete i) w Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) @@ -765,12 +824,13 @@ moveShell time i cid rot accel w $ set (projectiles . ix i . ptUpdate) (moveShell (time-1) i cid rot (rotateV rot accel)) w - | otherwise = shellExplosionAt oldPos + | otherwise = projectileExplosion oldPos $ stopSoundFrom (ShellSound i) $ over projectiles (IM.delete i) w where pt = _projectiles w IM.! i oldPos = _ptPos pt vel = _ptVel pt + projectileExplosion = _ptExplosion pt newPos = oldPos +.+ vel (frict,g) = randomR (0.6,0.9) $ _randGen w (sparkD,_) = randomR (-0.5,0.5) $ _randGen w @@ -869,6 +929,74 @@ aFlame a cid w resetAngle = set (creatures . ix cid . crInv . ix (_crInvSel cr) . wpFire) (shoot $ aFlame angle) +-- The following should be improved.... +makePoisonExplosionAt :: Point2 -> World -> World +makePoisonExplosionAt p w = soundOnce grenadeBang + $ makeGasCloud p (velocities!!1) + $ makeGasCloud p (velocities!!2) + $ makeGasCloud p (velocities!!3) + w + where + xs = randomRs (-2,2) $ _randGen w -- one infinite list of randoms + velocities = zip (take 10 xs) (drop 10 xs) + +makeTeslaExplosionAt :: Point2 -> World -> World +makeTeslaExplosionAt pos w = soundOnce grenadeBang + -- This is obviously the best way.... + $ over projectiles (IM.insert (pks!!1) (makeTeslaArcAt (pks!!1) pos (xs!!1))) + $ over projectiles (IM.insert (pks!!2) (makeTeslaArcAt (pks!!2) pos (xs!!2))) + $ over projectiles (IM.insert (pks!!3) (makeTeslaArcAt (pks!!3) pos (xs!!3))) + $ over projectiles (IM.insert (pks!!4) (makeTeslaArcAt (pks!!4) pos (xs!!4))) + $ over projectiles (IM.insert (pks!!5) (makeTeslaArcAt (pks!!5) pos (xs!!5))) + $ over projectiles (IM.insert (pks!!6) (makeTeslaArcAt (pks!!6) pos (xs!!6))) + $ over projectiles (IM.insert (pks!!7) (makeTeslaArcAt (pks!!7) pos (xs!!7))) + $ over projectiles (IM.insert (pks!!8) (makeTeslaArcAt (pks!!8) pos (xs!!8))) + $ over projectiles (IM.insert (pks!!9) (makeTeslaArcAt (pks!!9) pos (xs!!9))) + $ over projectiles (IM.insert (pks!!10) (makeTeslaArcAt (pks!!10) pos (xs!!10))) + $ over projectiles (IM.insert (pks!!11) (makeTeslaArcAt (pks!!11) pos (xs!!11))) + $ over projectiles (IM.insert (pks!!12) (makeTeslaArcAt (pks!!12) pos (xs!!12))) + $ over projectiles (IM.insert (pks!!13) (makeTeslaArcAt (pks!!13) pos (xs!!13))) + $ over projectiles (IM.insert (pks!!14) (makeTeslaArcAt (pks!!14) pos (xs!!14))) + $ over projectiles (IM.insert (pks!!15) (makeTeslaArcAt (pks!!15) pos (xs!!15))) + $ over projectiles (IM.insert (pks!!16) (makeTeslaArcAt (pks!!16) pos (xs!!16))) + $ over projectiles (IM.insert (pks!!17) (makeTeslaArcAt (pks!!17) pos (xs!!17))) + $ over projectiles (IM.insert (pks!!18) (makeTeslaArcAt (pks!!18) pos (xs!!18))) + $ over projectiles (IM.insert (pks!!19) (makeTeslaArcAt (pks!!19) pos (xs!!19))) + $ over projectiles (IM.insert (pks!!20) (makeTeslaArcAt (pks!!20) pos (xs!!20))) + $ over projectiles (IM.insert (pks!!21) (makeTeslaArcAt (pks!!21) pos (xs!!21))) + $ over projectiles (IM.insert (pks!!22) (makeTeslaArcAt (pks!!22) pos (xs!!22))) + $ over projectiles (IM.insert (pks!!23) (makeTeslaArcAt (pks!!23) pos (xs!!23))) + $ over projectiles (IM.insert (pks!!24) (makeTeslaArcAt (pks!!24) pos (xs!!24))) + $ over projectiles (IM.insert (pks!!25) (makeTeslaArcAt (pks!!25) pos (xs!!25))) + $ over projectiles (IM.insert (pks!!26) (makeTeslaArcAt (pks!!26) pos (xs!!26))) + $ over projectiles (IM.insert (pks!!27) (makeTeslaArcAt (pks!!27) pos (xs!!27))) + $ over projectiles (IM.insert (pks!!28) (makeTeslaArcAt (pks!!28) pos (xs!!28))) + $ over projectiles (IM.insert (pks!!29) (makeTeslaArcAt (pks!!29) pos (xs!!29))) + w + where + -- rad or 360? + xs = randomRs (0,7) $ _randGen w + p = newProjectileKey w + pks = [p..] + +makeFlameExplosionAt :: Point2 -> World -> World +makeFlameExplosionAt p w = soundOnce grenadeBang + $ makeFlame p (velocities!!1) (Just 0) + $ makeFlame p (velocities!!2) (Just 90) + $ makeFlame p (velocities!!3) (Just 180) + $ makeFlame p (velocities!!4) (Just 0) + $ makeFlame p (velocities!!5) (Just 0) + $ makeFlame p (velocities!!6) (Just 0) + $ makeFlame p (velocities!!7) (Just 0) + $ makeFlame p (velocities!!8) (Just 0) + $ makeFlame p (velocities!!9) (Just 0) + $ makeFlame p (velocities!!0) (Just 0) + $ w + where + xs = randomRs (-2,2) $ _randGen w -- one infinite list of randoms + velocities = zip (take 10 xs) (drop 10 xs) + + makeFlame :: Point2 -> Point2 -> Maybe Int -> World -> World makeFlame pos vel maycid = over particles' ((:) theFlame) where theFlame = @@ -960,10 +1088,13 @@ reflect a b = a + 2*(a-b) moveGrenade :: Int -> Float -> Int -> World -> World moveGrenade 0 dir pID w = over projectiles (IM.delete pID) - $ makeExplosionAt (_ptPos (_projectiles w IM.! pID)) + $ explosion (_ptPos (_projectiles w IM.! pID)) -- $ set (pointToItem (_itemPositions w IM.! wpID) . itEquipPict) -- (drawWeapon $ grenadePic 50) w + where + pt = _projectiles w IM.! pID + explosion = _ptExplosion pt moveGrenade time dir pID w = case hitWl of Just _ -> soundOnce (fromIntegral tapQuiet) updatedWorld @@ -1242,6 +1373,25 @@ grenade = Throwable } where fuseTime = 50 f x = 50 / fromIntegral x + + +flameGrenade :: Item +flameGrenade = grenade { + _itName = "FLMGREN " ++ show fuseTime + , _twFire = throwGrenade' makeFlameExplosionAt fuseTime + } + where fuseTime = 50 + f x = 50 / fromIntegral x + +teslaGrenade :: Item +teslaGrenade = grenade { + _itName = "TLSGREN " ++ show fuseTime + , _twFire = throwGrenade' makeTeslaExplosionAt fuseTime + } + where fuseTime = 50 + f x = 50 / fromIntegral x + + increaseFuse :: Int -> Int -> World -> World increaseFuse fuse i w = w & creatures . ix 0 . crInv . ix itRef . itScrollUp .~ decreaseFuse newTime & creatures . ix 0 . crInv . ix itRef . itScrollDown .~ increaseFuse newTime @@ -1281,15 +1431,16 @@ remoteBomb = defaultThrowable } -throwGrenade :: Int -> Int -> World -> World -throwGrenade fuseTime n w = setWp $ removePict $ over projectiles addG $ set randGen g w +throwGrenade' :: (Point2 -> World -> World) -> Int -> Int -> World -> World +throwGrenade' explosion fuseTime n w = setWp $ removePict $ over projectiles addG $ set randGen g w where addG = IM.insert i - $ Projectile { _ptPos = p + $ Shell { _ptPos = p , _ptStartPos = p , _ptVel = v , _ptPict = onLayer PtLayer $ uncurry translate p $ grenadePic 0 , _ptID = i , _ptUpdate = moveGrenade fuseTime dir i + , _ptExplosion = explosion } j = _crInvSel $ _creatures w IM.! n removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank @@ -1308,6 +1459,35 @@ throwGrenade fuseTime n w = setWp $ removePict $ over projectiles addG $ set ran setWp :: World -> World setWp w' = w' & creatures . ix n . crInv . ix j . itEffect .~ throwArmReset 20 +throwGrenade :: Int -> Int -> World -> World +throwGrenade = throwGrenade' makeExplosionAt +-- setWp $ removePict $ over projectiles addG $ set randGen g w +-- where addG = IM.insert i +-- $ Shell { _ptPos = p +-- , _ptStartPos = p +-- , _ptVel = v +-- , _ptPict = onLayer PtLayer $ uncurry translate p $ grenadePic 0 +-- , _ptID = i +-- , _ptUpdate = moveGrenade fuseTime dir i +-- , _ptExplosion = makeExplosionAt +-- } +-- j = _crInvSel $ _creatures w IM.! n +-- removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank +-- i = newProjectileKey w +-- (a, g) = randomR (-grenadeAccA,grenadeAccA::Float) (_randGen w) +-- (l, _) = randomR (1 - 2*grenadeAccL,1+grenadeAccL::Float) g +-- -- v = 0.02 * l / _cameraZoom w *.* rotateV (a+_cameraRot w) (limitRange $ _mousePos w) +-- v' = 1 / (fromIntegral fuseTime * _cameraZoom w) *.* rotateV (_cameraRot w) ( _mousePos w) +-- v | magV v' > 6 = 6 *.* normalizeV v' +-- | otherwise = v' +-- cr = _creatures w IM.! n +-- p' = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr,0) +-- p | circOnSomeWall p' 4 w = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr-4,0) +-- | otherwise = p' +-- dir = argV v +-- setWp :: World -> World +-- setWp w' = w' & creatures . ix n . crInv . ix j . itEffect .~ throwArmReset 20 + throwArmReset :: Int -> ItEffect throwArmReset x = ItInvEffect {_itInvEffect = f @@ -2058,3 +2238,7 @@ makeLaserScope p ep d relFrac = Particle' ] ,_ptUpdate' = \w pt -> (w, Just $ pt & ptUpdate' .~ \w' _ -> (w',Nothing)) } + + + +