Implement basic attention and awareness
This commit is contained in:
@@ -9,6 +9,7 @@ import Dodge.Creature.Impulse.Data
|
||||
import Dodge.Creature.ImpulseRat
|
||||
import Dodge.Creature.ActionRat
|
||||
import Dodge.Creature.Rationality.Data
|
||||
import Dodge.Creature.AlertLevel
|
||||
import Dodge.Data
|
||||
import Dodge.AIs
|
||||
import Dodge.Default
|
||||
@@ -94,7 +95,11 @@ armourChaseCrit = defaultCreature
|
||||
miniGunCrit' :: Creature
|
||||
miniGunCrit' = defaultCreature
|
||||
{ _crPict = basicCrPict red
|
||||
, _crUpdate = stateUpdate $ impulsiveAI $ actionUpdateAI $ shootAtTarget targetYouLOS
|
||||
, _crUpdate = stateUpdate $ impulsiveAI $ composeInternalAIs
|
||||
[ actionUpdateAI performActions
|
||||
, shootAtTarget targetYouCognizant
|
||||
, basicPerceptionUpdate [0]
|
||||
]
|
||||
, _crInv = IM.fromList [(0,miniGun)]
|
||||
, _crInvSel = 0
|
||||
, _crRad = 10
|
||||
@@ -102,7 +107,7 @@ miniGunCrit' = defaultCreature
|
||||
, _crHP = 500
|
||||
, _crRationality = ActionRat
|
||||
{ _crImpulse = []
|
||||
, _crAction = [AimAtCloseSlow 0 (0,0) 0.05 0.2 (pi/4) ]
|
||||
, _crAction = [AimAtCloseSlow 0 (0,0) 0.2 0.01 (pi/4) ]
|
||||
}
|
||||
}
|
||||
miniGunCrit :: Creature
|
||||
@@ -237,7 +242,7 @@ startCr = defaultCreature
|
||||
, _crUpdate = stateUpdate yourControl
|
||||
, _crRad = 10
|
||||
, _crMass = 10
|
||||
, _crHP = 1000
|
||||
, _crHP = 1000000000
|
||||
, _crMaxHP = 1500
|
||||
, _crInv = startInventory
|
||||
, _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ pictures [color (greyN 0.8) $ circleSolid 10, circLine 10]
|
||||
|
||||
@@ -220,7 +220,7 @@ reloadWeapon cid w =
|
||||
crAutoReload :: Creature -> Creature
|
||||
crAutoReload cr = case cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo of
|
||||
Just 0 -> cr & crInv . ix (_crInvSel cr) . wpReloadState %~ (`fromMaybe` reloadT)
|
||||
& crInv . ix (_crInvSel cr) . wpLoadedAmmo %~ (`fromMaybe` maxA)
|
||||
& crInv . ix (_crInvSel cr) . wpLoadedAmmo %~ (`fromMaybe` maxA)
|
||||
_ -> cr
|
||||
where
|
||||
reloadT = cr ^? crInv . ix (_crInvSel cr) . wpReloadTime
|
||||
@@ -360,7 +360,7 @@ 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
|
||||
| isLeftOfA (normalizeAngle dirToTarget) (normalizeAngle $ _crDir cr) = cr & crDir +~ turnSpeed
|
||||
| otherwise = cr & crDir -~ turnSpeed
|
||||
where
|
||||
vToTarg = p -.- _crPos cr
|
||||
|
||||
@@ -0,0 +1,57 @@
|
||||
{- | Deals with changes in a creature's awareness of other creatures. -}
|
||||
module Dodge.Creature.AlertLevel
|
||||
where
|
||||
import Dodge.Data
|
||||
import Dodge.Creature.AlertLevel.Data
|
||||
import Dodge.Base.Collide
|
||||
|
||||
import Control.Lens
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
|
||||
{- | Ties together (currently) an awareness and attention update -}
|
||||
basicPerceptionUpdate
|
||||
:: [Int] -- ^ List of creature ids that may direct attention and awareness
|
||||
-> World
|
||||
-> Creature
|
||||
-> Creature
|
||||
basicPerceptionUpdate is w cr
|
||||
= basicAwarenessUpdate w $
|
||||
basicAttentionUpdate is w cr
|
||||
{- | Update a creatures awareness based upon the creatures current direction
|
||||
of attention -}
|
||||
basicAwarenessUpdate
|
||||
:: World -> Creature -> Creature
|
||||
basicAwarenessUpdate w cr = case _crAttentionDir cr of
|
||||
AttentiveTo is -> cr & crAwarenessLevel %~ updateAwareness is
|
||||
Fixated i -> cr & crAwarenessLevel
|
||||
%~ ( IM.insert i (Cognizant 100) . IM.mapMaybe decreaseAwareness)
|
||||
{- | Increase awareness of a given list of ids -}
|
||||
updateAwareness :: [Int] -> IM.IntMap AwarenessLevel -> IM.IntMap AwarenessLevel
|
||||
updateAwareness is imawareness
|
||||
= foldr (\k -> IM.insertWith (\_ x -> increaseAwareness x) k (AwarenessInt 1))
|
||||
(IM.mapMaybe decreaseAwareness imawareness) is
|
||||
-- (IM.mapMaybe decreaseAwareness imawareness) is
|
||||
{- | Increase awareness level -}
|
||||
increaseAwareness :: AwarenessLevel -> AwarenessLevel
|
||||
increaseAwareness (AwarenessInt x)
|
||||
| x < 100 = AwarenessInt $ x + 2
|
||||
| otherwise = Cognizant 1
|
||||
increaseAwareness (Cognizant x)
|
||||
| x < 100 = Cognizant (x + 2)
|
||||
| otherwise = Cognizant 100
|
||||
{- | Decrease awareness level. Returns 'Maybe' value for use with 'IM.mapMaybe'
|
||||
-}
|
||||
decreaseAwareness :: AwarenessLevel -> Maybe AwarenessLevel
|
||||
decreaseAwareness (AwarenessInt 0) = Nothing
|
||||
decreaseAwareness (AwarenessInt x) = Just $ AwarenessInt (x - 1)
|
||||
decreaseAwareness (Cognizant 0) = Just $ AwarenessInt 100
|
||||
decreaseAwareness (Cognizant x) = Just $ Cognizant $ x - 1
|
||||
{- | Given a fixed group of creatures, direct attention to those of them that
|
||||
- are in view. -}
|
||||
basicAttentionUpdate
|
||||
:: [Int] -- ^ Creatures that may attract this creature's attention
|
||||
-> World
|
||||
-> Creature
|
||||
-> Creature
|
||||
basicAttentionUpdate cids w cr = cr & crAttentionDir .~
|
||||
AttentiveTo (filter (\cid -> canSee (_crID cr) cid w) cids)
|
||||
@@ -0,0 +1,17 @@
|
||||
module Dodge.Creature.AlertLevel.Data
|
||||
where
|
||||
|
||||
data AwakeLevel
|
||||
= Comatose
|
||||
| Asleep
|
||||
| Lethargic
|
||||
| Vigilant
|
||||
| Overstrung
|
||||
|
||||
data AttentionDir
|
||||
= AttentiveTo [Int]
|
||||
| Fixated Int
|
||||
|
||||
data AwarenessLevel
|
||||
= AwarenessInt Int
|
||||
| Cognizant Int
|
||||
@@ -2,8 +2,22 @@ module Dodge.Creature.ChooseTarget
|
||||
where
|
||||
import Dodge.Data
|
||||
import Dodge.Base
|
||||
import Dodge.Creature.AlertLevel.Data
|
||||
|
||||
import Control.Lens
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
|
||||
targetYouLOS :: Creature -> World -> Maybe Creature
|
||||
targetYouLOS cr w
|
||||
| hasLOS (_crPos cr) (_crPos $ you w) w = Just $ you w
|
||||
| otherwise = Nothing
|
||||
|
||||
targetYouCognizant :: Creature -> World -> Maybe Creature
|
||||
targetYouCognizant cr w
|
||||
| hasLOS (_crPos cr) (_crPos $ you w) w
|
||||
&& isCog (cr ^? crAwarenessLevel . ix 0) = Just $ you w
|
||||
| otherwise = Nothing
|
||||
where
|
||||
isCog x = case x of
|
||||
Just (Cognizant _) -> True
|
||||
_ -> False
|
||||
|
||||
@@ -7,6 +7,7 @@ module Dodge.Creature.Picture
|
||||
) where
|
||||
import Dodge.Data
|
||||
import Dodge.Creature.State.Data
|
||||
import Dodge.Creature.AlertLevel.Data
|
||||
import Dodge.Picture.Layer
|
||||
import Picture
|
||||
import Geometry
|
||||
@@ -18,7 +19,11 @@ basicCrPict
|
||||
:: Color -- ^ Creature color
|
||||
-> Creature
|
||||
-> Picture
|
||||
basicCrPict col cr = pictures [ onLayer CrLayer . piercingMod $ bluntScale naked , drawEquipment cr]
|
||||
basicCrPict col cr = pictures
|
||||
[ onLayer CrLayer . piercingMod $ bluntScale naked
|
||||
, drawAwakeLevel cr
|
||||
, drawEquipment cr
|
||||
]
|
||||
where
|
||||
cdir = _crDir cr
|
||||
naked
|
||||
@@ -46,6 +51,15 @@ basicCrPict col cr = pictures [ onLayer CrLayer . piercingMod $ bluntScale naked
|
||||
Nothing -> False
|
||||
Just x -> x > 5
|
||||
|
||||
drawAwakeLevel
|
||||
:: Creature
|
||||
-> Picture
|
||||
drawAwakeLevel cr = case cr ^? crAttentionDir of
|
||||
Just (AttentiveTo [0]) -> setPos . color red $ circleSolid 5
|
||||
_ -> setPos . color blue $ circleSolid 5
|
||||
where
|
||||
setPos = translate 0 (_crRad cr)
|
||||
|
||||
drawEquipment
|
||||
:: Creature
|
||||
-> Picture
|
||||
|
||||
@@ -14,6 +14,13 @@ import qualified Data.IntMap.Strict as IM
|
||||
import System.Random
|
||||
import Control.Lens
|
||||
|
||||
composeInternalAIs
|
||||
:: [World -> Creature -> Creature]
|
||||
-> World
|
||||
-> Creature
|
||||
-> Creature
|
||||
composeInternalAIs fs w c = foldr ($ w) c fs
|
||||
|
||||
impulsiveAI
|
||||
:: (World -> Creature -> Creature) -- ^ Internal AI update, should determine impulses
|
||||
-> World
|
||||
@@ -46,7 +53,7 @@ followImpulse imp w cr = case imp of
|
||||
MoveForward x -> (id, crMvForward x 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)
|
||||
Melee crID ->
|
||||
(hitCr crID
|
||||
@@ -88,11 +95,11 @@ performAction cr w ac = case ac 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
|
||||
| canSee (_crID cr) tcid w && safeAngleVV (unitVectorAtAngle cdir) (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
|
||||
| safeAngleVV (unitVectorAtAngle cdir) (tpos -.- cpos) < a
|
||||
-> ([TurnToward p slowSpeed] , Just $ AimAtCloseSlow tcid p speed slowSpeed a)
|
||||
| otherwise -> ([TurnToward p speed] , Just $ AimAtCloseSlow tcid p speed slowSpeed a)
|
||||
where
|
||||
|
||||
@@ -48,7 +48,7 @@ stateUpdate u w (f,g) cr =
|
||||
in case u w (f,g'') cr' of
|
||||
((f',g') , maybeCr) -> ( (invSideEff cr . movementSideEff cr . deathEff . f'
|
||||
, g')
|
||||
, fmap (updateReloadCounter . doDamage)
|
||||
, fmap (updateReloadCounter . doDamage . crAutoReload)
|
||||
$ crOrCorpse =<< maybeCr
|
||||
)
|
||||
where
|
||||
|
||||
@@ -17,28 +17,25 @@ import Data.Maybe
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import System.Random
|
||||
|
||||
{- | The AI equivalent for your control. -}
|
||||
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 0 cr
|
||||
)
|
||||
yourControl w (f,g) cr =
|
||||
( (updateUsingInput . f, g)
|
||||
, Just . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed 0 cr
|
||||
)
|
||||
where
|
||||
speed = _varMovementSpeedModifier w * equipFactor
|
||||
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv $ _creatures w IM.! 0
|
||||
|
||||
{-
|
||||
Turns key presses into creature movement.
|
||||
-}
|
||||
wasdWithAiming :: World -> Float -> Int -> Creature -> Creature
|
||||
{- | Turn key presses into creature movement. -}
|
||||
wasdWithAiming
|
||||
:: World
|
||||
-> Float -- ^ Base speed
|
||||
-> Int -- ^ Creature id
|
||||
-> Creature
|
||||
-> Creature
|
||||
wasdWithAiming w speed i cr
|
||||
| isAiming
|
||||
= set crDir mouseDir
|
||||
$ crMvBy (speed *.* mov)
|
||||
cr
|
||||
| isMoving
|
||||
= crMvForward speed -- controls the base speed
|
||||
$ over crDir (`fromMaybe` dir)
|
||||
cr
|
||||
| isAiming = set crDir mouseDir $ crMvBy (speed *.* mov) cr
|
||||
| isMoving = crMvForward speed $ over crDir (`fromMaybe` dir) cr
|
||||
| otherwise = cr
|
||||
where
|
||||
(mov',dir') = wasdComp (view keys w) w
|
||||
@@ -56,16 +53,17 @@ wasdWithAiming w speed i cr
|
||||
|
||||
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)
|
||||
| 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)
|
||||
|
||||
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)
|
||||
where
|
||||
f (0,0) = ((0,0), Nothing)
|
||||
f p = (errorNormalizeV 46 p, Just $ argV p)
|
||||
|
||||
{- | Set posture according to mouse presses. -}
|
||||
mouseActionsCr :: S.Set SDL.MouseButton -> Creature -> Creature
|
||||
@@ -75,4 +73,3 @@ mouseActionsCr keys
|
||||
where
|
||||
lbPressed = SDL.ButtonLeft `S.member` keys
|
||||
rbPressed = SDL.ButtonRight `S.member` keys
|
||||
|
||||
|
||||
+22
-18
@@ -19,6 +19,7 @@ import Dodge.Creature.Data
|
||||
import Dodge.Creature.State.Data
|
||||
import Dodge.Creature.Stance.Data
|
||||
import Dodge.Creature.Rationality.Data
|
||||
import Dodge.Creature.AlertLevel.Data
|
||||
import Dodge.Data.Menu
|
||||
import Dodge.Data.SoundOrigin
|
||||
import Dodge.Data.DamageType
|
||||
@@ -129,29 +130,32 @@ data TempLightSource = TLS
|
||||
, _tlsUpdate :: World -> TempLightSource -> (World, Maybe TempLightSource)
|
||||
}
|
||||
data Creature = Creature
|
||||
{ _crPos :: Point2
|
||||
, _crOldPos :: Point2
|
||||
, _crVel :: Point2
|
||||
, _crDir :: Float
|
||||
, _crID :: Int
|
||||
, _crPict :: Creature -> Picture
|
||||
{ _crPos :: Point2
|
||||
, _crOldPos :: Point2
|
||||
, _crVel :: 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
|
||||
, _crApplyDamage :: [DamageType] -> Creature -> (World -> World,Creature)
|
||||
, _crStance :: Stance
|
||||
, _crRationality :: Rationality
|
||||
, _crMeleeCooldown :: Maybe Int
|
||||
, _crRad :: Float
|
||||
, _crMass :: Float
|
||||
, _crHP :: Int
|
||||
, _crMaxHP :: Int
|
||||
, _crInv :: IM.IntMap Item
|
||||
, _crInvSel :: Int
|
||||
, _crState :: CreatureState
|
||||
, _crCorpse :: Picture
|
||||
, _crApplyDamage :: [DamageType] -> Creature -> (World -> World,Creature)
|
||||
, _crStance :: Stance
|
||||
, _crRationality :: Rationality
|
||||
, _crMeleeCooldown :: Maybe Int
|
||||
, _crAwakeLevel :: AwakeLevel
|
||||
, _crAttentionDir :: AttentionDir
|
||||
, _crAwarenessLevel :: IM.IntMap AwarenessLevel
|
||||
}
|
||||
data WorldState
|
||||
= DoorNumOpen Int
|
||||
|
||||
@@ -11,6 +11,7 @@ import Dodge.Data
|
||||
import Dodge.Creature.Stance.Data
|
||||
import Dodge.Creature.State.Data
|
||||
import Dodge.Creature.Rationality.Data
|
||||
import Dodge.Creature.AlertLevel.Data
|
||||
import Dodge.Data.Menu
|
||||
import Dodge.SoundLogic
|
||||
import Dodge.Base
|
||||
@@ -92,6 +93,9 @@ defaultCreature = Creature
|
||||
, _crStance = Stance {_carriage=Walking 0 0,_posture=AtEase}
|
||||
, _crRationality = ImpulseRat []
|
||||
, _crMeleeCooldown = Nothing
|
||||
, _crAwakeLevel = Vigilant
|
||||
, _crAttentionDir = AttentiveTo []
|
||||
, _crAwarenessLevel = IM.empty
|
||||
}
|
||||
defaultState = CrSt
|
||||
{ _goals = []
|
||||
|
||||
+71
-82
@@ -197,26 +197,27 @@ rot90Around cen p = cen +.+ vNormal (p -.- cen)
|
||||
-- inside an inner tree
|
||||
roomMiniIntro :: RandomGen g => State g (Tree (Either Room Room))
|
||||
roomMiniIntro = fmap (g . expandTreeBy f) $ sequence $ treeFromPost
|
||||
[return $ connectRoom door
|
||||
,join $ takeOne [miniTree2,glassLesson]
|
||||
-- ,join $ takeOne [miniRoom1]
|
||||
]
|
||||
$ fmap connectRoom $ randomiseOutLinks corridor
|
||||
where f (Node (Right x) xs) = Node (Right (Right x)) $ map f xs
|
||||
f (Node (Left x) xs) = Node (Left (Left x)) $ map f xs
|
||||
g (Node (Right x) []) = Node (Right x) []
|
||||
g (Node (Right x) xs) = Node (Left x) $ map g xs
|
||||
g (Node y ys) = Node y $ map g ys
|
||||
|
||||
[return $ connectRoom door
|
||||
,join $ takeOne [miniTree2,glassLesson]
|
||||
]
|
||||
$ fmap connectRoom $ randomiseOutLinks corridor
|
||||
where
|
||||
f (Node (Right x) xs) = Node (Right (Right x)) $ map f xs
|
||||
f (Node (Left x) xs) = Node (Left (Left x)) $ map f xs
|
||||
g (Node (Right x) []) = Node (Right x) []
|
||||
g (Node (Right x) xs) = Node (Left x) $ map g xs
|
||||
g (Node y ys) = Node y $ map g ys
|
||||
|
||||
roomCenterPillar :: RandomGen g => State g Room
|
||||
roomCenterPillar = changeLinkTo ((\p -> dist p (120,0) < 10) . fst)
|
||||
$ set rmPS plmnts $ roomRect 240 240 2 2
|
||||
where plmnts = [ blockLine (115,115) (115,125)
|
||||
, blockLine (125,115) (125,125)
|
||||
, PS (40,120) 0 putLamp
|
||||
, PS (200,120) 0 putLamp
|
||||
]
|
||||
$ set rmPS plmnts $ roomRect 240 240 2 2
|
||||
where
|
||||
plmnts =
|
||||
[ blockLine (115,115) (115,125)
|
||||
, blockLine (125,115) (125,125)
|
||||
, PS (40,120) 0 putLamp
|
||||
, PS (200,120) 0 putLamp
|
||||
]
|
||||
|
||||
roomOctogon :: Room
|
||||
roomOctogon = Room
|
||||
@@ -227,15 +228,18 @@ roomOctogon = Room
|
||||
, _rmPS = []
|
||||
, _rmBound = [[(-20,30),(20,30),(60,70),(60,110),(20,150),(-20,150),(-60,110),(-60,70)] ]
|
||||
}
|
||||
where lnks = [((0,140),0)
|
||||
,((35,125),0-pi/4)
|
||||
,((-35,125),pi/4)
|
||||
,( (50,90),0-pi/2)
|
||||
,( (-50,90),pi/2)
|
||||
,((35,55),0-3*pi/4)
|
||||
,((-35,55),3*pi/4)
|
||||
,( (0,40),pi)
|
||||
]
|
||||
where
|
||||
lnks =
|
||||
[((0,140),0)
|
||||
,((35,125),0-pi/4)
|
||||
,((-35,125),pi/4)
|
||||
,( (50,90),0-pi/2)
|
||||
,( (-50,90),pi/2)
|
||||
,((35,55),0-3*pi/4)
|
||||
,((-35,55),3*pi/4)
|
||||
,( (0,40),pi)
|
||||
]
|
||||
|
||||
allPairs :: Eq a => [a] -> [(a,a)]
|
||||
allPairs xs = [(x,y) | x <- xs, y <- xs, x /= y]
|
||||
|
||||
@@ -243,10 +247,7 @@ randomCorridorFrom :: RandomGen g => [a] -> State g (Tree (Either a a))
|
||||
randomCorridorFrom xs = do
|
||||
rooms <- sequence $ replicate 5 $ takeOne xs
|
||||
return $ treeFromTrunk (map Left $ init rooms) (Node (Right (last rooms)) [])
|
||||
|
||||
{-
|
||||
Probabilites of the type of the first floor weapon.
|
||||
-}
|
||||
{- Probabilites of the type of the first floor weapon. -}
|
||||
randFirstWeapon :: State StdGen PSType
|
||||
randFirstWeapon = do
|
||||
takeOne $ map PutFlIt $
|
||||
@@ -256,15 +257,9 @@ randFirstWeapon = do
|
||||
++ replicate 5 multGun
|
||||
++ replicate 2 autoGun
|
||||
++ [launcher]
|
||||
-- ++ [lasGun]
|
||||
-- ++ [flamer]
|
||||
|
||||
--randC1 :: State StdGen PSType
|
||||
|
||||
randC = randC1
|
||||
|
||||
-- randSwarmCrit = RandPS $ takeOne $ map PutCrit $ (armouredSwarmCrit : replicate 100 swarmCrit)
|
||||
|
||||
weaponEmptyRoom :: RandomGen g => State g (Tree (Either Room Room))
|
||||
weaponEmptyRoom = do
|
||||
w <- state $ randomR (220,300)
|
||||
@@ -277,25 +272,24 @@ weaponEmptyRoom = do
|
||||
(fmap connectRoom . randomiseOutLinks) =<< (changeLinkTo ((\p -> dist p (w/2,0) < 10) . fst)
|
||||
$ set rmPS plmnts $ roomRect w h 2 2)
|
||||
|
||||
|
||||
weaponUnderCrits :: RandomGen g => State g (Tree (Either Room Room))
|
||||
weaponUnderCrits = do
|
||||
let plmnts = [PS (20,0) 0 $ RandPS randFirstWeapon
|
||||
,PS (20,0) (0-pi/2) $ randC1
|
||||
,PS (20,20) (0-pi/2) $ randC1
|
||||
]
|
||||
let continuationRoom = treeFromTrunk [Left corridorN,Left corridorN]
|
||||
(connectRoom (set rmPS plmnts $ corridorN))
|
||||
rcp' <- roomCenterPillar
|
||||
let rcp = over rmPS ( PS (120,80) 0 putLamp : ) rcp'
|
||||
deadEndRoom <- takeOne [roomPillars,rcp]
|
||||
junctionRoom <- takeOne [Left tEast,Left tWest]
|
||||
return $ treeFromTrunk [Left corridorN,Left corridorN]
|
||||
$ Node junctionRoom
|
||||
[continuationRoom
|
||||
,deadRoom deadEndRoom
|
||||
]
|
||||
|
||||
let plmnts =
|
||||
[PS (20,0) 0 $ RandPS randFirstWeapon
|
||||
,PS (20,0) (0-pi/2) $ randC1
|
||||
,PS (20,20) (0-pi/2) $ randC1
|
||||
]
|
||||
let continuationRoom = treeFromTrunk [Left corridorN,Left corridorN]
|
||||
(connectRoom (set rmPS plmnts $ corridorN))
|
||||
rcp' <- roomCenterPillar
|
||||
let rcp = over rmPS ( PS (120,80) 0 putLamp : ) rcp'
|
||||
deadEndRoom <- takeOne [roomPillars,rcp]
|
||||
junctionRoom <- takeOne [Left tEast,Left tWest]
|
||||
return $ treeFromTrunk [Left corridorN,Left corridorN]
|
||||
$ Node junctionRoom
|
||||
[continuationRoom
|
||||
,deadRoom deadEndRoom
|
||||
]
|
||||
|
||||
weaponBehindPillar :: RandomGen g => State g (Tree (Either Room Room))
|
||||
weaponBehindPillar = do
|
||||
@@ -312,17 +306,19 @@ weaponBehindPillar = do
|
||||
|
||||
weaponBetweenPillars :: RandomGen g => State g (Tree (Either Room Room))
|
||||
weaponBetweenPillars = do
|
||||
wpPos <- takeOne [(x,y) | x <- [20,120,220], y <- [20,120,220]]
|
||||
(ps,_) <- takeNMore 2 ([], [(x,y) | x <- [20,220], y <- [20,120,220]])
|
||||
let crPos1 = ps !! 0
|
||||
let crPos2 = ps !! 1
|
||||
let d p = argV $ (120,120) -.- p
|
||||
let plmnts = [PS wpPos 0 $ RandPS randFirstWeapon
|
||||
,PS crPos1 (d crPos1) $ randC1
|
||||
,PS crPos2 (d crPos2) $ randC1
|
||||
]
|
||||
(fmap connectRoom . randomiseOutLinks) =<< (filterLinks f $ over rmPS (++plmnts) $ roomPillars)
|
||||
where f (_,a) = a == 0
|
||||
wpPos <- takeOne [(x,y) | x <- [20,120,220], y <- [20,120,220]]
|
||||
(ps,_) <- takeNMore 2 ([], [(x,y) | x <- [20,220], y <- [20,120,220]])
|
||||
let crPos1 = ps !! 0
|
||||
crPos2 = ps !! 1
|
||||
d p = argV $ (120,120) -.- p
|
||||
plmnts =
|
||||
[PS wpPos 0 $ RandPS randFirstWeapon
|
||||
,PS crPos1 (d crPos1) $ randC1
|
||||
,PS crPos2 (d crPos2) $ randC1
|
||||
]
|
||||
(fmap connectRoom . randomiseOutLinks) =<< (filterLinks f $ over rmPS (++plmnts) $ roomPillars)
|
||||
where
|
||||
f (_,a) = a == 0
|
||||
|
||||
weaponLongCorridor :: RandomGen g => State g (Tree (Either Room Room))
|
||||
weaponLongCorridor = do
|
||||
@@ -355,21 +351,17 @@ deadEndRoom = Room
|
||||
, _rmPS = [PS (0,-10) 0 putLamp]
|
||||
, _rmBound = [rectNSWE 20 (-20) (-30) 30]
|
||||
}
|
||||
where lnks = [((0,30) ,0)
|
||||
]
|
||||
|
||||
{-
|
||||
A random Either tree with a weapon and melee monster challenge.
|
||||
-}
|
||||
where
|
||||
lnks = [((0,30) ,0) ]
|
||||
{- A random Either tree with a weapon and melee monster challenge. -}
|
||||
weaponRoom :: RandomGen g => State g (Tree (Either Room Room))
|
||||
weaponRoom = do
|
||||
x <- takeOne [ weaponEmptyRoom
|
||||
, weaponUnderCrits
|
||||
, weaponBehindPillar
|
||||
, weaponBetweenPillars
|
||||
, weaponLongCorridor
|
||||
]
|
||||
x
|
||||
weaponRoom = join $ takeOne
|
||||
[ weaponEmptyRoom
|
||||
, weaponUnderCrits
|
||||
, weaponBehindPillar
|
||||
, weaponBetweenPillars
|
||||
, weaponLongCorridor
|
||||
]
|
||||
|
||||
roomCCrits :: RandomGen g => State g (Tree (Either Room Room))
|
||||
roomCCrits = do
|
||||
@@ -397,10 +389,7 @@ longRoom = do
|
||||
]
|
||||
brls <- fmap (map (\p -> PS (p +.+ (10,200)) 0 $ PutCrit explosiveBarrel) )
|
||||
$ sequence $ replicate 5 $ randInRect (w-20) 900
|
||||
let rm = roomRect w (h+70) 1 1 & rmPolys %~ ( (++)
|
||||
[rectNSWE h (h-165) (-45) (w+45)
|
||||
]
|
||||
)
|
||||
let rm = roomRect w (h+70) 1 1 & rmPolys %~ ([rectNSWE h (h-165) (-45) (w+45)] ++)
|
||||
changeLinkTo cond $ set rmPS (ws ++ brls ++ wsDefense ++
|
||||
[PS ( 12.5,h-25) 0 $ PutCrit longCrit
|
||||
,PS ( 37.5,h-25) 0 $ PutCrit longCrit
|
||||
|
||||
Reference in New Issue
Block a user