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

AI refactor

Browse Source
This commit is contained in:
justin
2021-05-07 16:50:59 +02:00
parent 436043b169
commit 1aa59cc205
16 changed files with 295 additions and 340 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/AIs.hs
+2 -152
View File
@@ -1,6 +1,5 @@
module Dodge.AIs module Dodge.AIs
( chaseAI ( basicShooterAI
, basicShooterAI
, twitchMissAI , twitchMissAI
, launcherAI , launcherAI
, chargeAI , chargeAI
@@ -62,70 +61,6 @@ replaceImpulse newActions = over (crState . goals) (\((_:as):ass) -> (newActions
addImpulse :: [Impulse] -> Creature -> Creature addImpulse :: [Impulse] -> Creature -> Creature
addImpulse newActions = over (crState . goals) (\(as:ass) -> (newActions++as):ass) addImpulse newActions = over (crState . goals) (\(as:ass) -> (newActions++as):ass)
chaseAI = expandToAI chaseAI'
chaseAI' :: World -> StdGen -> Creature -> (World -> World, StdGen, Creature)
chaseAI' w g' cr =
let cid = _crID cr
cpos = _crPos cr
hitCr i = over (creatures . ix i . crState . crDamage) addDam
. soundOnce (fromIntegral hitSound)
addDam dams = (( Blunt 100 cpos ypos ypos ) : 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)
isCrowded = (length $ IM.elems $ IM.filter isCloseFaction (_creatures w)) > 2
isCloseFaction cr' = _faction (_crState cr') == _faction (_crState cr)
&& dist cpos (_crPos cr') < 25
in case head $ _goals $ _crState cr of
[] -> (id, g', replaceGoal [] cr)
(Wait:_)
| dist cpos ypos < 900 && hasLOS cpos ypos w
-> (id, g', addGoal [[WaitFor wtime,MoveTo ypos]] cr)
| dist cpos ypos < 900 && hasLOSIndirect cpos ypos w
-> (id, g', addGoal [[WaitFor wtime,PathTo ypos]] cr)
| otherwise -> (id, g', cr)
(WaitFor x:gls)
| x == 0 -> (id, g', replaceImpulse [] cr)
| hasLOS cpos ypos w
-> (id, g', replaceImpulse [WaitFor (x-1)] $ crTurnTowardSpeed 0.05 ypos cr)
| otherwise -> (id, g', replaceImpulse [WaitFor (x-1)] cr )
(MoveTo p:gls)
| dist ypos cpos < combinedRad + 5 && abs ((_crDir cr) - argV (ypos -.- cpos)) < pi/4
-> ( hitCr 0 , g'
, replaceImpulse [MeleeAttack 5]
$ over crPos (+.+ (12 *.* errorNormalizeVAI (ypos -.- cpos))) cr
)
| hasLOS cpos ypos w ->
( id , g , replaceImpulse [MoveTo ypos]
$ crMvForward 2.5 $ randomTurn $ crTurnTowardSpeed 0.05 p cr)
| dist p cpos < 10 -> ( id, g' , replaceImpulse [] cr)
| angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
-> ( id ,g' , crTurnTowardSpeed 0.05 p cr)
| otherwise -> ( id, g' , crMvForward 2.5 $ crTurnTowardSpeed 0.05 p cr)
(MoveToFor p x:gls)
| hasLOS cpos ypos w ->
( id , g , replaceImpulse [MoveTo ypos]
$ crMvForward 2.5 $ randomTurn $ crTurnTowardSpeed 0.05 p cr
)
| dist p cpos < 10 -> ( id , g , replaceImpulse [] cr)
| x == 0 -> ( id , g , replaceImpulse [] cr)
| angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4 ->
( id , g , replaceImpulse [MoveToFor p (max 0 (x-1))] $ crTurnTowardSpeed 0.05 p cr)
| otherwise ->
( id , g , replaceImpulse [MoveToFor p (max 0 (x-1))]
$ crMvForward 2.5 $ crTurnTowardSpeed 0.05 p cr)
(PathTo p:_)
| dist p cpos < 10 -> ( id , g , replaceImpulse [] cr)
| hasLOS cpos p w -> ( id , g , addImpulse [MoveToFor p 10] cr)
| otherwise -> case pointTowardsImpulse cpos p w of
Just q -> ( id , g , addImpulse [MoveToFor q 10] cr)
_ -> ( id , g , replaceImpulse [] cr)
(MeleeAttack x:_)
| x == 0 -> ( id , g , replaceImpulse [WaitFor wtime] cr )
| otherwise -> ( id , g , replaceImpulse [MeleeAttack (x-1)] cr )
factionIs :: Faction -> Creature -> Bool factionIs :: Faction -> Creature -> Bool
@@ -318,88 +253,6 @@ placeCrFaction cr fact p op rot w = over creatures addCr w
) )
crs crs
---- 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 newImpulses = over (creatures . ix cid . crState . goals)
---- (\gs -> newImpulses ++ tail gs)
---- addGoal newImpulses = over (creatures . ix cid . crState . goals)
---- (\gs -> newImpulses ++ gs)
---- replaceImpulse newActions = over (creatures . ix cid . crState . goals)
---- (\((_:as):ass) -> (newActions ++ as):ass)
---- addImpulse 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 -> replaceImpulse [] w
---- | canSee cid (_yourID w) w
---- -> turnTowardSpeed 0.05 ypos cid
---- $ replaceImpulse [WaitFor (x-1)] w
---- | otherwise -> replaceImpulse [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)))
---- $ replaceImpulse [MeleeAttack 5]
---- $ damageYou
---- w
---- | x == 0 && isCrowded -> replaceImpulse [] $ 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 -> replaceImpulse [] w
---- | x == 0 -> replaceImpulse [] w
---- -- | not (canSeePoint cid p w) -> replaceImpulse [PathTo p] w
---- -- | not (canSeePoint cid p w) -> replaceImpulse [] w
---- | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
---- -> replaceImpulse [MoveToFor p (max 0 (x-1))] $ turnTowardSpeed 0.05 p cid w
---- | otherwise -> replaceImpulse [MoveToFor p (max 0 (x-1))]
---- $ mvForward 2.5 cid $ turnTowardSpeed 0.05 p cid w
---- (PathTo p:_)
---- | dist p cpos < 10 -> replaceImpulse [] w
---- | canSeePoint cid p w -> addImpulse [MoveToFor p 10] w
---- | otherwise ->
---- case pointTowardsImpulse' cpos p w of
---- Right q -> addImpulse [MoveToFor q 10]
---- -- $ drawCircleAtForCol q 10 magenta
---- -- $ drawLineForCol ((cpos : (concat $ maybeToList $ makePathBetweenPs
---- -- cpos p w)) ++ [p]) 50 red
---- w
---- --Left s -> error s
---- _ -> replaceImpulse [] w
---- (MeleeAttack x:_)
---- | x == 0 -> replaceImpulse [WaitFor wtime] w
---- | otherwise -> replaceImpulse [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 -- be aware that the crit can be removed -- don't just refer to its id in the
-- world->world part -- world->world part
miniAI :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) miniAI :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
@@ -1481,10 +1334,7 @@ basicShooterAI w (f,g) cr =
= Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass) = Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass)
addImpulse newActions addImpulse newActions
= Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass) = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass)
-- autoFireTweak p | _wpIsAuto wp = Just in case head $ _goals $ _crState cr of
-- | otherwise = replaceGoal [[AimAt p (_itUseRate 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 ) [] | canSeeFire cpos ypos w -> ( ( f , g1 )
, replaceGoal [[AimAt ypos aimtime]] cr , replaceGoal [[AimAt ypos aimtime]] cr
) )
src/Dodge/Creature.hs
+22 -14
View File
@@ -6,6 +6,9 @@ module Dodge.Creature
import Dodge.Creature.Stance.Data import Dodge.Creature.Stance.Data
import Dodge.Creature.State.Data import Dodge.Creature.State.Data
import Dodge.Creature.Impulse.Data import Dodge.Creature.Impulse.Data
import Dodge.Creature.ImpulseRat
import Dodge.Creature.ActionRat
import Dodge.Creature.Rationality.Data
import Dodge.Data import Dodge.Data
import Dodge.AIs import Dodge.AIs
import Dodge.Default import Dodge.Default
@@ -18,6 +21,7 @@ import Dodge.Creature.Inanimate
import Dodge.Creature.State import Dodge.Creature.State
import Dodge.Creature.Picture import Dodge.Creature.Picture
import Dodge.Creature.Rationality import Dodge.Creature.Rationality
import Dodge.Creature.ChooseTarget
import Dodge.Item import Dodge.Item
import Dodge.Picture.Layer import Dodge.Picture.Layer
import Dodge.Creature.Picture import Dodge.Creature.Picture
@@ -53,7 +57,7 @@ spawnerCrit = defaultCreature
} }
smallChaseCrit :: Creature smallChaseCrit :: Creature
smallChaseCrit = defaultCreature smallChaseCrit = defaultCreature
{ _crUpdate = stateUpdate chaseAI { _crUpdate = stateUpdate $ meleeCooldown $ impulsiveAI $ chaseTarget targetYouLOS
, _crHP = 1 , _crHP = 1
, _crRad = 4 , _crRad = 4
, _crPict = basicCrPict green , _crPict = basicCrPict green
@@ -66,18 +70,7 @@ smallChaseCrit = defaultCreature
} }
chaseCrit :: Creature chaseCrit :: Creature
chaseCrit = defaultCreature chaseCrit = defaultCreature
{ _crUpdate = stateUpdate $ impulsiveAI $ applyBasicImpulse { _crUpdate = stateUpdate $ meleeCooldown $ impulsiveAI $ chaseTarget targetYouLOS
, _crHP = 300
, _crPict = basicCrPict green
, _crState = defaultState
{_goals = [[Wait]]
,_faction = ChaseCritters
}
, _crInv = IM.empty
}
chaseCrit' :: Creature
chaseCrit' = defaultCreature
{ _crUpdate = stateUpdate chaseAI
, _crHP = 300 , _crHP = 300
, _crPict = basicCrPict green , _crPict = basicCrPict green
, _crState = defaultState , _crState = defaultState
@@ -85,10 +78,11 @@ chaseCrit' = defaultCreature
,_faction = ChaseCritters ,_faction = ChaseCritters
} }
, _crInv = IM.empty , _crInv = IM.empty
, _crMeleeCooldown = Just 0
} }
armourChaseCrit :: Creature armourChaseCrit :: Creature
armourChaseCrit = defaultCreature armourChaseCrit = defaultCreature
{ _crUpdate = stateUpdate chaseAI { _crUpdate = stateUpdate $ meleeCooldown $ impulsiveAI $ chaseTarget targetYouLOS
, _crHP = 300 , _crHP = 300
, _crPict = basicCrPict green , _crPict = basicCrPict green
, _crState = defaultState {_goals = [[Wait]]} , _crState = defaultState {_goals = [[Wait]]}
@@ -97,6 +91,20 @@ armourChaseCrit = defaultCreature
,(1,medkit 200) ,(1,medkit 200)
] ]
} }
miniGunCrit' :: Creature
miniGunCrit' = defaultCreature
{ _crPict = basicCrPict red
, _crUpdate = stateUpdate $ impulsiveAI $ actionUpdateAI $ shootAtTarget targetYouLOS
, _crInv = IM.fromList [(0,miniGun)]
, _crInvSel = 0
, _crRad = 10
, _crState = defaultState
, _crHP = 500
, _crRationality = ActionRat
{ _crImpulse = []
, _crAction = [AimAtCloseSlow 0 (0,0) 0.05 0.2 (pi/4) ]
}
}
miniGunCrit :: Creature miniGunCrit :: Creature
miniGunCrit = defaultCreature miniGunCrit = defaultCreature
{ _crPict = basicCrPict red { _crPict = basicCrPict red
src/Dodge/Creature/Action.hs
+55 -86
View File
@@ -30,20 +30,11 @@ import System.Random
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
import qualified Data.Map as M import qualified Data.Map as M
moveForwardSpeed
:: Float -- ^ Speed
-> Int -- ^ Creature id
-> World
-> World
moveForwardSpeed x n w = over (creatures . ix n . crPos) (+.+ p) w
where
p = (*.*) x $ unitVectorAtAngle $ _crDir $ _creatures w IM.! n
crStrafeLeft crStrafeLeft
:: Float -- ^ Speed :: Float -- ^ Speed
-> Creature -> Creature
-> Creature -> Creature
crStrafeLeft speed cr = stepForward s2 $ over crPos (+.+ p) cr crStrafeLeft speed cr = advanceStepCounter s2 $ over crPos (+.+ p) cr
where where
p = (*.*) s2 $ unitVectorAtAngle $ (_crDir cr + pi/2) p = (*.*) s2 $ unitVectorAtAngle $ (_crDir cr + pi/2)
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
@@ -53,42 +44,12 @@ crStrafeRight
:: Float -- ^ Speed :: Float -- ^ Speed
-> Creature -> Creature
-> Creature -> Creature
crStrafeRight speed cr = stepForward s2 $ over crPos (+.+ p) cr crStrafeRight speed cr = advanceStepCounter s2 $ over crPos (+.+ p) cr
where where
p = (*.*) s2 $ unitVectorAtAngle $ (_crDir cr - pi/2) p = (*.*) s2 $ unitVectorAtAngle $ (_crDir cr - pi/2)
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
s2 = (speed * equipFactor) s2 = (speed * equipFactor)
crMvForward
:: Float -- ^ Speed
-> Creature
-> Creature
crMvForward speed cr = over crPos (+.+ p) cr
where
p = (*.*) (speed * equipFactor) $ unitVectorAtAngle $ _crDir cr
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
crMvBy
:: Point2 -- ^ Movement translation vector
-> Creature
-> Creature
crMvBy p' cr = stepForward (magV p) $ over crPos (+.+ p) cr
where
p = (*.*) (equipFactor * aimingFactor) $ rotateV (_crDir cr) p'
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
aimingFactor | (_posture $ _crStance cr) == Aiming
= fromMaybe 1 $ it ^? itAimingSpeed
| otherwise = 1
it = _crInv cr IM.! _crInvSel cr
stepForward
:: Float -- ^ Speed
-> Creature
-> Creature
stepForward speed cr = over (crStance . carriage) f cr
where
f (w@Walking {}) = w {_stepToAdd = ceiling speed}
f s = s
turnTo turnTo
@@ -233,32 +194,7 @@ turnToward p n w
where where
cr = _creatures w IM.! n cr = _creatures w IM.! n
dirToTarget = argV (p -.- _crPos cr) dirToTarget = argV (p -.- _crPos cr)
{- | Translate a creature. -}
{- Move a creature forward in the direction it is facing. -}
moveForward
:: Int -- ^ Creature id
-> World
-> World
moveForward n w = over (creatures . ix n . crPos) (+.+ p) w
where
p = unitVectorAtAngle $ _crDir $ _creatures w IM.! n
{- Move a creature forward, faster if it is facing a target point -}
moveToward
:: Point2 -- ^ Target point
-> Int -- ^ Creature id
-> World
-> World
moveToward p n w
| angle < 10 = moveForwardSpeed 0.1 n w
| angle < 20 = moveForwardSpeed 0.02 n w
| angle < 40 = moveForwardSpeed 0.01 n w
| otherwise = w
where
angle = errorAngleVV 5 (p -.- curPos) (unitVectorAtAngle (_crDir (_creatures w IM.! n)))
curPos = _crPos (_creatures w IM.! n)
{- Translate a creature. -}
moveBy moveBy
:: Int -- ^ Creature id :: Int -- ^ Creature id
-> Point2 -- ^ Translation -> Point2 -- ^ Translation
@@ -280,7 +216,7 @@ reloadWeapon cid w =
$ set ( itRef . wpReloadState) rT w $ set ( itRef . wpReloadState) rT w
_ -> Nothing _ -> Nothing
{- Start reloading if clip is empty. -} {- | Start reloading if clip is empty. -}
crAutoReload :: Creature -> Creature crAutoReload :: Creature -> Creature
crAutoReload cr = case cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo of crAutoReload cr = case cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo of
Just 0 -> cr & crInv . ix (_crInvSel cr) . wpReloadState %~ (`fromMaybe` reloadT) Just 0 -> cr & crInv . ix (_crInvSel cr) . wpReloadState %~ (`fromMaybe` reloadT)
@@ -290,7 +226,7 @@ crAutoReload cr = case cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo of
reloadT = cr ^? crInv . ix (_crInvSel cr) . wpReloadTime reloadT = cr ^? crInv . ix (_crInvSel cr) . wpReloadTime
maxA = cr ^? crInv . ix (_crInvSel cr) . wpMaxAmmo maxA = cr ^? crInv . ix (_crInvSel cr) . wpMaxAmmo
{- Teleport a creature to the mouse position -} {- | Teleport a creature to the mouse position -}
blinkAction blinkAction
:: Int -- ^ Creature id :: Int -- ^ Creature id
-> World -> World
@@ -334,10 +270,7 @@ turnBy
-> World -> World
-> World -> World
turnBy a n = over (creatures . ix n . crDir) (+ a) turnBy a n = over (creatures . ix n . crDir) (+ a)
{- | Get your creature to drop the item under the cursor. -}
{-
Get your creature to drop the item under the cursor.
-}
youDropItem :: World -> World youDropItem :: World -> World
youDropItem w = case yourItem w of youDropItem w = case yourItem w of
NoItem -> w NoItem -> w
@@ -345,8 +278,7 @@ youDropItem w = case yourItem w of
. copyItemToFloor (you w) (_crInvSel $ you w) . copyItemToFloor (you w) (_crInvSel $ you w)
$ soundOnce putDownSound $ soundOnce putDownSound
w w
{- | Copy an inventory item to the floor. -}
{- Copy an inventory item to the floor. -}
copyItemToFloor copyItemToFloor
:: Creature :: Creature
-> Int -- ^ Inventory position -> Int -- ^ Inventory position
@@ -354,9 +286,7 @@ copyItemToFloor
-> World -> World
copyItemToFloor cr i w = case _crInv cr IM.! i of copyItemToFloor cr i w = case _crInv cr IM.! i of
NoItem -> w NoItem -> w
it -> over floorItems (IM.insert flid theflit) it -> over floorItems (IM.insert flid theflit) . updateLocation $ set randGen g w
. updateLocation
$ set randGen g w
where where
(rot, g) = randomR (-pi,pi) $ _randGen w (rot, g) = randomR (-pi,pi) $ _randGen w
offset = (_crRad cr + 2) *.* unitVectorAtAngle rot offset = (_crRad cr + 2) *.* unitVectorAtAngle rot
@@ -370,16 +300,19 @@ copyItemToFloor cr i w = case _crInv cr IM.! i of
,_flItRot = rot ,_flItRot = rot
,_flItID = flid ,_flItID = flid
} }
{- | Pick up a specific item. -}
{- Pick up a specific item. -} pickUpItem
pickUpItem :: FloorItem -> World -> World :: Int -- ^ Creature id
pickUpItem flit w = case maybeInvSlot of -> FloorItem
-> World
-> World
pickUpItem cid flit w = case maybeInvSlot of
Nothing -> w Nothing -> w
Just i -> w Just i -> w
& soundOnce pickUpSound & soundOnce pickUpSound
& updateItLocation i & updateItLocation i
& floorItems %~ IM.delete (_flItID flit) & floorItems %~ IM.delete (_flItID flit)
& creatures . ix 0 . crInv . ix i %~ addItem it & creatures . ix cid . crInv . ix i %~ addItem it
where where
it = _flIt flit it = _flIt flit
maybeInvSlot = checkInvSlotsYou it w maybeInvSlot = checkInvSlotsYou it w
@@ -387,12 +320,48 @@ pickUpItem flit w = case maybeInvSlot of
Nothing -> w' Nothing -> w'
Just j -> w' & itemPositions . ix j .~ InInv 0 invid Just j -> w' & itemPositions . ix j .~ InInv 0 invid
{- | A creature attempts to move under its own steam. {- | Creature attempts to moves under its own steam.
The idea is that this may or may not work, depending on the status of the creature. The idea is that this may or may not work, depending on the status of the creature.
For now, though, this cannot fail. -} For now, though, this cannot fail. -}
creatureMove :: Point2 -> Creature -> Creature crMvBy
creatureMove p = crPos %~ (+.+ p) :: Point2 -- ^ Movement translation vector
-> Creature
-> Creature
crMvBy p' cr = advanceStepCounter (magV p) $ over crPos (+.+ p) cr
where
p = (*.*) (equipFactor * aimingFactor) $ rotateV (_crDir cr) p'
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
aimingFactor | (_posture $ _crStance cr) == Aiming
= fromMaybe 1 $ it ^? itAimingSpeed
| otherwise = 1
it = _crInv cr IM.! _crInvSel cr
crMvForward
:: Float -- ^ Speed
-> Creature
-> Creature
crMvForward speed cr = crMvBy (speed,0) cr
advanceStepCounter
:: Float -- ^ Speed
-> Creature
-> Creature
advanceStepCounter speed cr = over (crStance . carriage) f cr
where
f (w@Walking {}) = w {_stepToAdd = ceiling speed}
f s = s
creatureTurn :: Float -> Creature -> Creature creatureTurn :: Float -> Creature -> Creature
creatureTurn a = crDir +~ a creatureTurn a = crDir +~ a
creatureTurnToward :: Point2 -> Float -> Creature -> Creature
creatureTurnToward p turnSpeed cr
| vToTarg == (0,0) = cr -- this should deal with the angleVV error
| errorAngleVV 3 vToTarg (unitVectorAtAngle (_crDir cr)) <= turnSpeed
= cr & crDir .~ dirToTarget
| isLeftOfA dirToTarget (_crDir cr) = cr & crDir +~ turnSpeed
| otherwise = cr & crDir -~ turnSpeed
where
vToTarg = p -.- _crPos cr
dirToTarget = argV vToTarg
src/Dodge/Creature/ActionRat.hs
+25
View File
@@ -0,0 +1,25 @@
module Dodge.Creature.ActionRat
where
import Dodge.Data
import Dodge.Base.Collide
import Dodge.Creature.ChooseTarget
import Dodge.Creature.Rationality.Data
import Geometry
import Data.List
import Control.Lens
{- | Action update for a simple shooting creature -}
shootAtTarget
:: (Creature -> World -> Maybe Creature) -- ^ Function for determining target
-> World
-> Creature
-> Creature
shootAtTarget targFunc w cr = case targFunc cr w of
Nothing -> cr
Just crTarg -> cr & crRationality . crAction %~ shootAtTarg w cr crTarg
shootAtTarg :: World -> Creature -> Creature -> [Action] -> [Action]
shootAtTarg w cr tcr as
| canSee (_crID cr) (_crID tcr) w = nub (ShootTillEmpty : as)
| otherwise = as
src/Dodge/Creature/ImpulseRat.hs
+41 -7
View File
@@ -5,21 +5,55 @@ import Dodge.Creature.ChooseTarget
import Dodge.Creature.Rationality.Data import Dodge.Creature.Rationality.Data
import Geometry import Geometry
chaseImpulse' import Control.Lens
chaseTarget
:: (Creature -> World -> Maybe Creature) -- ^ Function for determining target :: (Creature -> World -> Maybe Creature) -- ^ Function for determining target
-> Creature
-> World -> World
-> [Impulse] -> Creature
chaseImpulse' targFunc cr w = case targFunc cr w of -> Creature
Nothing -> [] chaseTarget targFunc w cr = case targFunc cr w of
Just crTarg -> chaseTarg cr crTarg Nothing -> cr
Just crTarg -> cr & crRationality . crImpulse .~ chaseTarg cr crTarg
chaseTarg :: Creature -> Creature -> [Impulse] chaseTarg :: Creature -> Creature -> [Impulse]
chaseTarg cr crT chaseTarg cr crT
| dist tpos cpos < combinedRad + 5 | dist tpos cpos < combinedRad + 5
&& abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4 && abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
&& _crMeleeCooldown cr == Just 0
= [Melee (_crID crT)] = [Melee (_crID crT)]
| otherwise = [MoveForward 3 , TurnToward 0.05 tpos] | dist tpos cpos < combinedRad + 5
&& abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
= [ TurnToward tpos 0.05 ]
| abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
= [MoveForward 2.5 , TurnToward tpos 0.2, RandomTurn 0.2 ]
| otherwise = [MoveForward 2.5 , TurnToward tpos 0.05, RandomTurn 0.2 ]
where
cpos = _crPos cr
tpos = _crPos crT
combinedRad = _crRad cr + _crRad crT
impulseShootAtTarget
:: (Creature -> World -> Maybe Creature) -- ^ Function for determining target
-> World
-> Creature
-> Creature
impulseShootAtTarget targFunc w cr = case targFunc cr w of
Nothing -> cr
Just crTarg -> cr & crRationality . crImpulse .~ impulseShootAtTarg cr crTarg
impulseShootAtTarg :: Creature -> Creature -> [Impulse]
impulseShootAtTarg cr crT
| dist tpos cpos < combinedRad + 5
&& abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
&& _crMeleeCooldown cr == Just 0
= [Melee (_crID crT)]
| dist tpos cpos < combinedRad + 5
&& abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
= [ TurnToward tpos 0.05 ]
| abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
= [MoveForward 2.5 , TurnToward tpos 0.2, RandomTurn 0.2 ]
| otherwise = [MoveForward 2.5 , TurnToward tpos 0.05, RandomTurn 0.2 ]
where where
cpos = _crPos cr cpos = _crPos cr
tpos = _crPos crT tpos = _crPos crT
src/Dodge/Creature/Picture.hs
+5 -1
View File
@@ -22,8 +22,9 @@ basicCrPict col cr = pictures [ onLayer CrLayer . piercingMod $ bluntScale naked
where where
cdir = _crDir cr cdir = _crDir cr
naked naked
| strikeMelee = color white $ circleSolid $ _crRad cr
| pdam > 200 = color red $ circleSolid $ _crRad cr | pdam > 200 = color red $ circleSolid $ _crRad cr
| pdam > 100 = color white $ circleSolid $ _crRad cr | pdam > 99 = color white $ circleSolid $ _crRad cr
| otherwise = pictures [color col' $ circleSolid $ _crRad cr, circLine $ _crRad cr] | otherwise = pictures [color col' $ circleSolid $ _crRad cr, circLine $ _crRad cr]
pastDams = _crPastDamage $ _crState cr pastDams = _crPastDamage $ _crState cr
pdam = sum $ concatMap (map _dmAmount) $ pastDams pdam = sum $ concatMap (map _dmAmount) $ pastDams
@@ -41,6 +42,9 @@ basicCrPict col cr = pictures [ onLayer CrLayer . piercingMod $ bluntScale naked
piercingMod = case fmap argV piercingDam of piercingMod = case fmap argV piercingDam of
Just a -> rotate (a + cdir) . scale 0.8 1.2 . rotate (negate $ cdir + a) Just a -> rotate (a + cdir) . scale 0.8 1.2 . rotate (negate $ cdir + a)
_ -> id _ -> id
strikeMelee = case _crMeleeCooldown cr of
Nothing -> False
Just x -> x > 5
drawEquipment drawEquipment
:: Creature :: Creature
src/Dodge/Creature/Rationality.hs
+84 -12
View File
@@ -1,33 +1,105 @@
module Dodge.Creature.Rationality module Dodge.Creature.Rationality
where where
import Dodge.Data import Dodge.Data
import Dodge.Base.Collide
import Dodge.Creature.Rationality.Data import Dodge.Creature.Rationality.Data
import Dodge.Creature.Action import Dodge.Creature.Action
import Dodge.Creature.Action.UseItem import Dodge.Creature.Action.UseItem
import Dodge.Creature.State.Data
import Dodge.SoundLogic
import Geometry
import Data.Maybe
import qualified Data.IntMap.Strict as IM
import System.Random import System.Random
import Control.Lens import Control.Lens
impulsiveAI impulsiveAI
:: (Impulse -> World -> Creature -> (World -> World, Creature)) :: (World -> Creature -> Creature) -- ^ Internal AI update, should determine impulses
-> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) -> World
impulsiveAI impulseFunc w (f,g) cr -> (World -> World,StdGen)
= (\(f''' ,cr) -> ((f''',g),Just cr)) -> Creature
$ foldr -> ((World -> World,StdGen), Maybe Creature)
(\imp (f' , cr') -> let (f'', cr'') = impulseFunc imp w cr' in (f'' . f', cr'')) impulsiveAI impF w (f,g) = followImpulses w (f,g) . impF w
(id, cr)
(_crImpulse $ _crRationality cr)
applyBasicImpulse followImpulses
:: World
-> (World -> World,StdGen)
-> Creature
-> ((World -> World,StdGen), Maybe Creature)
followImpulses w (f,g) cr
= (\(f''' ,cr) -> ((f''',g'),Just cr))
$ foldr
(\imp (f' , cr') -> let (f'', cr'') = followImpulse imp w cr' in (f'' . f', cr''))
(f, cr)
(_crImpulse $ _crRationality cr)
where
g' = snd $ next g
followImpulse
:: Impulse :: Impulse
-> World -> World
-> Creature -> Creature
-> (World -> World , Creature) -> (World -> World , Creature)
applyBasicImpulse imp w cr = case imp of followImpulse imp w cr = case imp of
Move p -> (id, creatureMove p cr) Move p -> (id, crMvBy p cr)
MoveForward x -> (id, crMvForward x cr)
Turn a -> (id, creatureTurn a cr) Turn a -> (id, creatureTurn a cr)
TurnToward p a -> (id, creatureTurnToward p a cr)
UseItem -> (crUseItem cr, cr) UseItem -> (crUseItem cr, cr)
SwitchToItem i -> (id, cr & crInvSel .~ i) SwitchToItem i -> (id, cr & crInvSel .~ i)
_ -> (id, cr) Melee crID ->
(hitCr crID
, crMvBy (10 *.* normalizeV (posFromID crID -.- cpos)) $ cr & crMeleeCooldown ?~ 20) -- randomise cooldown?
RandomTurn a -> (id, creatureTurn (rr a) cr)
_ -> (id , cr)
DropItem -> undefined DropItem -> undefined
where
cpos = _crPos cr
posFromID cid = _crPos $ _creatures w IM.! cid
rr a = fst $ randomR (-a,a) $ _randGen w
hitCr i = over (creatures . ix i . crState . crDamage) (addDam i)
. soundOnce (fromIntegral hitSound)
addDam i dams = (( Blunt 100 cpos (posFromID i) (posFromID i) ) : dams )
actionUpdateAI
:: (World -> Creature -> Creature) -- ^ the function updating the actions
-> World
-> Creature
-> Creature
actionUpdateAI actF w c = performActions w $ actF w c
performActions :: World -> Creature -> Creature
performActions w cr = cr
& crRationality . crImpulse .~ concat iss
& crRationality . crAction .~ catMaybes mayas
where
(iss, mayas) = unzip $ map (performAction cr w) $ cr ^. crRationality . crAction
{- | Performing an action means that a creature has some impulses for a frame, and
updates or deletes the action itself. -}
performAction
:: Creature
-> World
-> Action
-> ( [Impulse] , Maybe Action )
performAction cr w ac = case ac of
ShootTillEmpty -> case cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo of
Just x | x > 0 -> ( [UseItem] , Just ShootTillEmpty )
_ -> ( [] , Nothing )
AimAtCloseSlow tcid p speed slowSpeed a
| canSee (_crID cr) tcid w && abs (normalizeAngle $ cdir - argV (tpos -.- cpos)) < a
-> ([TurnToward tpos slowSpeed] , Just $ AimAtCloseSlow tcid tpos speed slowSpeed a)
| canSee (_crID cr) tcid w
-> ([TurnToward tpos speed] , Just $ AimAtCloseSlow tcid tpos speed slowSpeed a)
| abs (normalizeAngle (cdir - (argV (p -.- cpos)))) < a
-> ([TurnToward p slowSpeed] , Just $ AimAtCloseSlow tcid p speed slowSpeed a)
| otherwise -> ([TurnToward p speed] , Just $ AimAtCloseSlow tcid p speed slowSpeed a)
where
tpos = _crPos (_creatures w IM.! tcid)
ImpulsesList (xs:xss) -> (xs, Just $ ImpulsesList xss)
ImpulsesList _ -> ([], Nothing)
where
cpos = _crPos cr
cdir = _crDir cr
src/Dodge/Creature/Rationality/Data.hs
+16 -3
View File
@@ -12,18 +12,19 @@ data Rationality
{_crImpulse :: [Impulse] } {_crImpulse :: [Impulse] }
| ActionRat | ActionRat
{_crImpulse :: [Impulse] {_crImpulse :: [Impulse]
,_crAction :: Action ,_crAction :: [Action]
} }
| StrategyRat | StrategyRat
{_crImpulse :: [Impulse] {_crImpulse :: [Impulse]
,_crAction :: Action ,_crAction :: [Action]
,_crStrategy :: Strategy ,_crStrategy :: Strategy
} }
data Impulse data Impulse
= Move Point2 = Move Point2
| MoveForward Float | MoveForward Float
| Turn Float | Turn Float
| TurnToward Float Point2 | RandomTurn Float
| TurnToward Point2 Float
| UseItem | UseItem
| SwitchToItem Int | SwitchToItem Int
| DropItem | DropItem
@@ -33,9 +34,18 @@ data Impulse
| UseIntrinsicAbility | UseIntrinsicAbility
| Melee Int | Melee Int
| ChangePosture Posture | ChangePosture Posture
deriving (Eq,Ord,Show)
data Action data Action
= Attack Int = Attack Int
| AimAtCloseSlow
{_targetID :: Int
,_targetSeenAt :: Point2
,_aimSpeed :: Float
,_slowAimSpeed :: Float
,_slowAimAngle :: Float
}
| MeleeAttack Point2 Int
| PathTo Point2 | PathTo Point2
| FleeFrom Int | FleeFrom Int
| HealSelf | HealSelf
@@ -44,6 +54,9 @@ data Action
| SearchFor Int | SearchFor Int
| Search | Search
| PickupItem Int | PickupItem Int
| ShootTillEmpty
| ImpulsesList [[Impulse]]
deriving (Eq,Ord,Show)
data Strategy data Strategy
= Flank Int = Flank Int
src/Dodge/Creature/Stance/Data.hs
+1 -1
View File
@@ -18,7 +18,7 @@ data Carriage
| Boosting Point2 | Boosting Point2
deriving (Eq,Show) deriving (Eq,Show)
data Posture = Aiming | AtEase data Posture = Aiming | AtEase
deriving (Eq,Show) deriving (Eq,Ord,Show)
makeLenses ''Stance makeLenses ''Stance
makeLenses ''Carriage makeLenses ''Carriage
src/Dodge/Creature/State.hs
+3
View File
@@ -36,6 +36,9 @@ import Control.Concurrent
type CRUpdate = World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) type CRUpdate = World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
meleeCooldown :: CRUpdate -> CRUpdate
meleeCooldown u w (f,g) cr = u w (f,g) $ cr & crMeleeCooldown . _Just %~ (max 0 . (\x -> x - 1))
-- | The movement is updated before the ai in order to correctly set the oldpos. -- | The movement is updated before the ai in order to correctly set the oldpos.
-- the whole of this update cycle could do with a rethink, it is becoming -- the whole of this update cycle could do with a rethink, it is becoming
-- convoluted -- convoluted
src/Dodge/Creature/YourControl.hs
+16 -46
View File
@@ -20,62 +20,32 @@ import System.Random
yourControl :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) yourControl :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
yourControl w (f,g) cr = ( (updateUsingInput . f, g) yourControl w (f,g) cr = ( (updateUsingInput . f, g)
, Just . crAutoReload . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed strafeSpeed 0 cr , Just . crAutoReload . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed 0 cr
) )
where where
strafeSpeed = _varMovementSpeedModifier w * equipFactor * fromMaybe 1 (yourItem w ^? itAimingSpeed)
speed = _varMovementSpeedModifier w * equipFactor speed = _varMovementSpeedModifier w * equipFactor
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv $ _creatures w IM.! 0 equipFactor = product $ map equipSpeed $ IM.elems $ _crInv $ _creatures w IM.! 0
{- {-
Turns key presses into creature movement. Turns key presses into creature movement.
-} -}
wasdWithAiming :: World -> Float -> Float -> Int -> Creature -> Creature wasdWithAiming :: World -> Float -> Int -> Creature -> Creature
wasdWithAiming w speed aimSpeed i cr wasdWithAiming w speed i cr
| (any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr) && isMoving && isAiming
&& diffAngles mouseDir (argV mov) < pi/2
-- = over crPos (+.+ (speed *.* mov))
= over crPos (+.+ (speed *.* unitVectorAtAngle mouseDir))
. set crDir mouseDir
$ set (crStance . carriage) (Boosting mov)
cr
| any (\it -> it ^? itIdentity == Just JetPack) (_crInv cr) && isMoving && isAiming
= set crDir mouseDir
$ set (crStance . carriage) Floating
cr
| any (\it -> it ^? itIdentity == Just JetPack) (_crInv cr) && isMoving
= over crPos (+.+ (speed *.* mov))
. over crDir (flip fromMaybe dir)
$ set (crStance . carriage) (Boosting mov)
cr
| any (\it -> it ^? itIdentity == Just JetPack) (_crInv cr) && isAiming
= set (crStance . carriage) Floating
$ set crDir mouseDir
cr
| any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr
= set (crStance . carriage) Floating
cr
| isAiming | isAiming
= stepForward aimSpeed = set crDir mouseDir
$ over crPos (+.+ (aimSpeed *.* mov)) $ crMvBy (speed *.* mov)
$ set crDir mouseDir
$ set (crStance . carriage) (Walking 0 0)
cr cr
| isMoving | isMoving
= stepForward speed = crMvForward speed -- controls the base speed
$ over crPos (+.+ (speed *.* mov))
$ over crDir (`fromMaybe` dir) $ over crDir (`fromMaybe` dir)
$ set (crStance . carriage) (Walking 0 0)
cr
| otherwise
= over crDir (`fromMaybe` dir)
$ set (crStance . carriage) Standing
cr cr
| otherwise = cr
where where
(mov',dir') = wasdComp (view keys w) w (mov',dir') = wasdComp (view keys w) w
(mov,dir) = (rotateV (_cameraRot w) mov',fmap (_cameraRot w +) dir') dir = fmap (_cameraRot w +) dir'
isMoving = mov' /= (0,0) mov = rotateV (negate $ _crDir cr) mov'
isAiming = _posture (_crStance cr) == Aiming isAiming = _posture (_crStance cr) == Aiming
isMoving = mov' /= (0,0)
mouseDir = case w ^? creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) mouseDir = case w ^? creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
. itAttachment of . itAttachment of
Just (Just ItScope{_scopePos = p}) -> normalizeAngle $ argV Just (Just ItScope{_scopePos = p}) -> normalizeAngle $ argV
@@ -97,12 +67,12 @@ wasdComp ks w = f $ foldr ( (+.+) . wasdM w ) (0,0) ks
where f (0,0) = ((0,0), Nothing) where f (0,0) = ((0,0), Nothing)
f p = (errorNormalizeV 46 p, Just $ argV p) f p = (errorNormalizeV 46 p, Just $ argV p)
{- | Set posture according to mouse presses. -}
mouseActionsCr :: S.Set SDL.MouseButton -> Creature -> Creature mouseActionsCr :: S.Set SDL.MouseButton -> Creature -> Creature
mouseActionsCr keys cr mouseActionsCr keys
| rbPressed | rbPressed = crStance . posture .~ Aiming
= set ( crStance . posture) Aiming cr | otherwise = crStance . posture .~ AtEase
| otherwise where
= set ( crStance . posture) AtEase cr lbPressed = SDL.ButtonLeft `S.member` keys
where lbPressed = SDL.ButtonLeft `S.member` keys
rbPressed = SDL.ButtonRight `S.member` keys rbPressed = SDL.ButtonRight `S.member` keys
src/Dodge/Data.hs
+1
View File
@@ -151,6 +151,7 @@ data Creature = Creature
, _crApplyDamage :: [DamageType] -> Creature -> (World -> World,Creature) , _crApplyDamage :: [DamageType] -> Creature -> (World -> World,Creature)
, _crStance :: Stance , _crStance :: Stance
, _crRationality :: Rationality , _crRationality :: Rationality
, _crMeleeCooldown :: Maybe Int
} }
data WorldState data WorldState
= DoorNumOpen Int = DoorNumOpen Int
src/Dodge/Default.hs
+1
View File
@@ -91,6 +91,7 @@ defaultCreature = Creature
, _crApplyDamage = defaultApplyDamage , _crApplyDamage = defaultApplyDamage
, _crStance = Stance {_carriage=Walking 0 0,_posture=AtEase} , _crStance = Stance {_carriage=Walking 0 0,_posture=AtEase}
, _crRationality = ImpulseRat [] , _crRationality = ImpulseRat []
, _crMeleeCooldown = Nothing
} }
defaultState = CrSt defaultState = CrSt
{ _goals = [] { _goals = []
src/Dodge/Event/Keyboard.hs
+3 -7
View File
@@ -34,10 +34,7 @@ see 'handlePressedKeyInGame'.
handleKeyboardEvent :: KeyboardEventData -> World -> Maybe World handleKeyboardEvent :: KeyboardEventData -> World -> Maybe World
handleKeyboardEvent kev w = case keyboardEventKeyMotion kev of handleKeyboardEvent kev w = case keyboardEventKeyMotion kev of
Released -> Just $ w & keys %~ S.delete kcode Released -> Just $ w & keys %~ S.delete kcode
Pressed -> handlePressedKey Pressed -> handlePressedKey (keyboardEventRepeat kev) kcode (w & keys %~ S.insert kcode)
(keyboardEventRepeat kev)
kcode
(w & keys %~ S.insert kcode)
where where
kcode = (keysymScancode . keyboardEventKeysym) kev kcode = (keysymScancode . keyboardEventKeysym) kev
@@ -59,8 +56,7 @@ handlePressedKeyInGame _ w = Just w
handlePressedKey :: Bool -> Scancode -> World -> Maybe World handlePressedKey :: Bool -> Scancode -> World -> Maybe World
handlePressedKey True _ w = Just w handlePressedKey True _ w = Just w
handlePressedKey _ scode w handlePressedKey _ scode w
| null (_menuLayers w) | null (_menuLayers w) = handlePressedKeyInGame scode w
= handlePressedKeyInGame scode w
| otherwise = handlePressedKeyInMenu (head $ _menuLayers w) scode w | otherwise = handlePressedKeyInMenu (head $ _menuLayers w) scode w
handlePressedKey _ _ w = Just w handlePressedKey _ _ w = Just w
@@ -78,7 +74,7 @@ spaceAction w = if _carteDisplay w
w & carteCenter .~ theLoc w & carteCenter .~ theLoc
else else
case listToMaybe $ _closeActiveObjects w of case listToMaybe $ _closeActiveObjects w of
Just (Left flit) -> pickUpItem flit w Just (Left flit) -> pickUpItem 0 flit w
Just (Right but) -> updateTopCloseObject (_btID but) $ _btEvent but but w Just (Right but) -> updateTopCloseObject (_btID but) $ _btEvent but but w
Nothing -> w Nothing -> w
where where
src/Dodge/Floor.hs
+3 -2
View File
@@ -49,8 +49,9 @@ roomTreex = do
t = treeFromTrunk t = treeFromTrunk
[[StartRoom] [[StartRoom]
,[Corridor] ,[Corridor]
,[Corridor] ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400
,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 200] & rmPS %~ (PS (0,0) 0 (PutCrit miniGunCrit') :)
]
,[Corridor] ,[Corridor]
,[Corridor] ,[Corridor]
,[SpecificRoom . fmap (pure . Right) $ twinSlowDoorChasers 30] ,[SpecificRoom . fmap (pure . Right) $ twinSlowDoorChasers 30]
src/Geometry/Vector.hs
+9 -1
View File
@@ -87,11 +87,19 @@ Always positive.
-} -}
angleVV :: Point2 -> Point2 -> Float angleVV :: Point2 -> Point2 -> Float
{-# INLINE angleVV #-} {-# INLINE angleVV #-}
angleVV a b = let ma = magV a angleVV a b =
let ma = magV a
mb = magV b mb = magV b
d = a `dotV` b d = a `dotV` b
in acos $ d / (ma * mb) in acos $ d / (ma * mb)
{- | Safe version of 'angleVV' that returns 0 if either vector is null. -}
safeAngleVV :: Point2 -> Point2 -> Float
{-# INLINE safeAngleVV #-}
safeAngleVV a b
| a == (0,0) || b == (0,0) = 0
| otherwise = angleVV a b
{- | Dot product. {- | Dot product.
-} -}
dotV :: Point2 -> Point2 -> Float dotV :: Point2 -> Point2 -> Float