From 86faf9fd0186a573c0b4144fb32a7641130f5e95 Mon Sep 17 00:00:00 2001 From: jgk Date: Sat, 8 May 2021 17:34:25 +0200 Subject: [PATCH] Implement basic attention and awareness --- src/Dodge/Creature.hs | 11 +- src/Dodge/Creature/Action.hs | 4 +- src/Dodge/Creature/AlertLevel.hs | 57 ++++++++++ src/Dodge/Creature/AlertLevel/Data.hs | 17 +++ src/Dodge/Creature/ChooseTarget.hs | 14 +++ src/Dodge/Creature/Picture.hs | 16 ++- src/Dodge/Creature/Rationality.hs | 13 ++- src/Dodge/Creature/State.hs | 2 +- src/Dodge/Creature/YourControl.hs | 47 ++++---- src/Dodge/Data.hs | 40 ++++--- src/Dodge/Default.hs | 4 + src/Dodge/Room.hs | 153 ++++++++++++-------------- 12 files changed, 243 insertions(+), 135 deletions(-) create mode 100644 src/Dodge/Creature/AlertLevel.hs create mode 100644 src/Dodge/Creature/AlertLevel/Data.hs diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 96a76ad6c..d4bb4234c 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -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] diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index 127ebf879..2052a49e9 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -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 diff --git a/src/Dodge/Creature/AlertLevel.hs b/src/Dodge/Creature/AlertLevel.hs new file mode 100644 index 000000000..ca845bf56 --- /dev/null +++ b/src/Dodge/Creature/AlertLevel.hs @@ -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) diff --git a/src/Dodge/Creature/AlertLevel/Data.hs b/src/Dodge/Creature/AlertLevel/Data.hs new file mode 100644 index 000000000..5beb0f9ba --- /dev/null +++ b/src/Dodge/Creature/AlertLevel/Data.hs @@ -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 diff --git a/src/Dodge/Creature/ChooseTarget.hs b/src/Dodge/Creature/ChooseTarget.hs index 8051ee937..c8e14091e 100644 --- a/src/Dodge/Creature/ChooseTarget.hs +++ b/src/Dodge/Creature/ChooseTarget.hs @@ -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 diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index 8b9b36c5e..2124c76c0 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/src/Dodge/Creature/Picture.hs @@ -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 diff --git a/src/Dodge/Creature/Rationality.hs b/src/Dodge/Creature/Rationality.hs index 49f9ab27e..3b801c95b 100644 --- a/src/Dodge/Creature/Rationality.hs +++ b/src/Dodge/Creature/Rationality.hs @@ -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 diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 1def08749..56374ea35 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -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 diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index 4798f5e1d..c2d4bcd03 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -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 - diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index b6baefcd4..c8c9f9579 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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 diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 4750f995f..a11f9e267 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -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 = [] diff --git a/src/Dodge/Room.hs b/src/Dodge/Room.hs index e55784984..9ba90753b 100644 --- a/src/Dodge/Room.hs +++ b/src/Dodge/Room.hs @@ -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