-- Copyright (c) 2008--2011 Andres Loeh
-- Copyright (c) 2010--2021 Mikolaj Konarski and others (see git history)
-- This file is a part of the computer game Allure of the Stars
-- and is released under the terms of the GNU Affero General Public License.
-- For license and copyright information, see the file LICENSE.
--
-- | Definitions of game mode kinds.
module Content.ModeKind
  ( -- * Group name patterns
    groupNamesSingleton, groupNames
  , -- * Content
    content
#ifdef EXPOSE_INTERNAL
  -- * Group name patterns
  , pattern GAUNTLET, pattern RAID, pattern BRAWL, pattern LONG, pattern CRAWL, pattern FOGGY, pattern SHOOTOUT, pattern PERILOUS, pattern HUNT, pattern NIGHT, pattern FLIGHT, pattern BURNING, pattern ZOO, pattern RANGED, pattern AMBUSH, pattern SAFARI, pattern DIG, pattern SEE, pattern SHORT, pattern FUN, pattern CRAWL_EMPTY, pattern CRAWL_SURVIVAL, pattern SAFARI_SURVIVAL, pattern BATTLE, pattern BATTLE_DEFENSE, pattern BATTLE_SURVIVAL, pattern DEFENSE, pattern DEFENSE_EMPTY
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.Text as T

import Game.LambdaHack.Content.CaveKind (CaveKind, pattern DEFAULT_RANDOM)
import Game.LambdaHack.Content.FactionKind (Outcome (..))
import Game.LambdaHack.Content.ModeKind
import Game.LambdaHack.Core.Dice
import Game.LambdaHack.Definition.Defs
import Game.LambdaHack.Definition.DefsInternal

import Content.CaveKind hiding (content, groupNames, groupNamesSingleton)
import Content.FactionKind hiding (content, groupNames, groupNamesSingleton)
import Content.ItemKindActor

-- * Group name patterns

groupNamesSingleton :: [GroupName ModeKind]
groupNamesSingleton :: [GroupName ModeKind]
groupNamesSingleton =
       [GroupName ModeKind
GAUNTLET, GroupName ModeKind
RAID, GroupName ModeKind
BRAWL, GroupName ModeKind
LONG, GroupName ModeKind
CRAWL, GroupName ModeKind
FOGGY, GroupName ModeKind
SHOOTOUT, GroupName ModeKind
PERILOUS, GroupName ModeKind
HUNT, GroupName ModeKind
NIGHT, GroupName ModeKind
FLIGHT, GroupName ModeKind
BURNING, GroupName ModeKind
ZOO, GroupName ModeKind
RANGED, GroupName ModeKind
AMBUSH, GroupName ModeKind
SAFARI, GroupName ModeKind
DIG, GroupName ModeKind
SEE, GroupName ModeKind
SHORT, GroupName ModeKind
FUN, GroupName ModeKind
CRAWL_EMPTY, GroupName ModeKind
CRAWL_SURVIVAL, GroupName ModeKind
SAFARI_SURVIVAL, GroupName ModeKind
BATTLE, GroupName ModeKind
BATTLE_DEFENSE, GroupName ModeKind
BATTLE_SURVIVAL, GroupName ModeKind
DEFENSE, GroupName ModeKind
DEFENSE_EMPTY]

pattern GAUNTLET, RAID, BRAWL, LONG, CRAWL, FOGGY, SHOOTOUT, PERILOUS, HUNT, NIGHT, FLIGHT, BURNING, ZOO, RANGED, AMBUSH, SAFARI, DIG, SEE, SHORT, FUN, CRAWL_EMPTY, CRAWL_SURVIVAL, SAFARI_SURVIVAL, BATTLE, BATTLE_DEFENSE, BATTLE_SURVIVAL, DEFENSE, DEFENSE_EMPTY :: GroupName ModeKind

groupNames :: [GroupName ModeKind]
groupNames :: [GroupName ModeKind]
groupNames = []

pattern $bGAUNTLET :: GroupName ModeKind
$mGAUNTLET :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
GAUNTLET = GroupName "gauntlet"
pattern $bRAID :: GroupName ModeKind
$mRAID :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
RAID = GroupName "raid"
pattern $bBRAWL :: GroupName ModeKind
$mBRAWL :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
BRAWL = GroupName "brawl"
pattern $bLONG :: GroupName ModeKind
$mLONG :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
LONG = GroupName "long crawl"
pattern $bCRAWL :: GroupName ModeKind
$mCRAWL :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
CRAWL = GroupName "crawl"
pattern $bFOGGY :: GroupName ModeKind
$mFOGGY :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
FOGGY = GroupName "foggy shootout"
pattern $bSHOOTOUT :: GroupName ModeKind
$mSHOOTOUT :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
SHOOTOUT = GroupName "shootout"
pattern $bPERILOUS :: GroupName ModeKind
$mPERILOUS :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
PERILOUS = GroupName "perilous hunt"
pattern $bHUNT :: GroupName ModeKind
$mHUNT :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
HUNT = GroupName "hunt"
pattern $bNIGHT :: GroupName ModeKind
$mNIGHT :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
NIGHT = GroupName "night flight"
pattern $bFLIGHT :: GroupName ModeKind
$mFLIGHT :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
FLIGHT = GroupName "flight"
pattern $bBURNING :: GroupName ModeKind
$mBURNING :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
BURNING = GroupName "burning zoo"
pattern $bZOO :: GroupName ModeKind
$mZOO :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
ZOO = GroupName "zoo"
pattern $bRANGED :: GroupName ModeKind
$mRANGED :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
RANGED = GroupName "ranged ambush"
pattern $bAMBUSH :: GroupName ModeKind
$mAMBUSH :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
AMBUSH = GroupName "ambush"
pattern $bSAFARI :: GroupName ModeKind
$mSAFARI :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
SAFARI = GroupName "safari"
pattern $bDIG :: GroupName ModeKind
$mDIG :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
DIG = GroupName "dig"
pattern $bSEE :: GroupName ModeKind
$mSEE :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
SEE = GroupName "see"
pattern $bSHORT :: GroupName ModeKind
$mSHORT :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
SHORT = GroupName "short"
pattern $bFUN :: GroupName ModeKind
$mFUN :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
FUN = GroupName "fun"
pattern $bCRAWL_EMPTY :: GroupName ModeKind
$mCRAWL_EMPTY :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
CRAWL_EMPTY = GroupName "crawlEmpty"  -- only the first word matters
pattern $bCRAWL_SURVIVAL :: GroupName ModeKind
$mCRAWL_SURVIVAL :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
CRAWL_SURVIVAL = GroupName "crawlSurvival"
pattern $bSAFARI_SURVIVAL :: GroupName ModeKind
$mSAFARI_SURVIVAL :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
SAFARI_SURVIVAL = GroupName "safariSurvival"
pattern $bBATTLE :: GroupName ModeKind
$mBATTLE :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
BATTLE = GroupName "battle"
pattern $bBATTLE_DEFENSE :: GroupName ModeKind
$mBATTLE_DEFENSE :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
BATTLE_DEFENSE = GroupName "battleDefense"
pattern $bBATTLE_SURVIVAL :: GroupName ModeKind
$mBATTLE_SURVIVAL :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
BATTLE_SURVIVAL = GroupName "battleSurvival"
pattern $bDEFENSE :: GroupName ModeKind
$mDEFENSE :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
DEFENSE = GroupName "defense"
pattern $bDEFENSE_EMPTY :: GroupName ModeKind
$mDEFENSE_EMPTY :: forall r. GroupName ModeKind -> (Void# -> r) -> (Void# -> r) -> r
DEFENSE_EMPTY = GroupName "defenseEmpty"

-- * Content

content :: [ModeKind]
content :: [ModeKind]
content =
  [ModeKind
gauntlet, ModeKind
raid, ModeKind
brawl, ModeKind
crawl, ModeKind
shootout, ModeKind
hunt, ModeKind
flight, ModeKind
zoo, ModeKind
ambush, ModeKind
safari, ModeKind
dig, ModeKind
see, ModeKind
short, ModeKind
fun, ModeKind
crawlEmpty, ModeKind
crawlSurvival, ModeKind
safariSurvival, ModeKind
battle, ModeKind
battleDefense, ModeKind
battleSurvival, ModeKind
defense, ModeKind
defenseEmpty, ModeKind
screensaverGauntlet, ModeKind
screensaverRaid, ModeKind
screensaverBrawl, ModeKind
screensaverCrawl, ModeKind
screensaverShootout, ModeKind
screensaverHunt, ModeKind
screensaverFlight, ModeKind
screensaverZoo, ModeKind
screensaverAmbush, ModeKind
screensaverSafari]

gauntlet,    raid, brawl, crawl, shootout, hunt, flight, zoo, ambush, safari, dig, see, short, fun, crawlEmpty, crawlSurvival, safariSurvival, battle, battleDefense, battleSurvival, defense, defenseEmpty, screensaverGauntlet, screensaverRaid, screensaverBrawl, screensaverCrawl, screensaverShootout, screensaverHunt, screensaverFlight, screensaverZoo, screensaverAmbush, screensaverSafari :: ModeKind

-- What other symmetric (two only-one-moves factions) and asymmetric vs crowd
-- scenarios make sense (e.g., are good for a tutorial or for standalone
-- extreme fun or are impossible as part of a crawl)?
-- sparse melee at night: no, shade ambush in brawl is enough
-- dense melee: no, keeping big party together is a chore and big enemy
--   party is less fun than huge enemy party
-- crowd melee in daylight: no, possible in crawl and at night is more fun
-- sparse ranged at night: no, less fun than dense and if no reaction fire,
--   just a camp fest or firing blindly
-- dense ranged in daylight: no, less fun than at night with flares
-- crowd ranged: no, fish in a barrel, less predictable and more fun inside
--   crawl, even without reaction fire

gauntlet :: ModeKind
gauntlet = ModeKind :: Text
-> Freqs ModeKind
-> Bool
-> Bool
-> Roster
-> Caves
-> [(Outcome, Text)]
-> Text
-> Text
-> Text
-> Text
-> ModeKind
ModeKind
  { mname :: Text
mname   = Text
"gauntlet (tutorial, 1)"
  , mfreq :: Freqs ModeKind
mfreq   = [(GroupName ModeKind
GAUNTLET, Int
1), (GroupName ModeKind
CAMPAIGN_SCENARIO, Int
1)]
  , mtutorial :: Bool
mtutorial = Bool
True
  , mattract :: Bool
mattract = Bool
False
  , mroster :: Roster
mroster = Roster
rosterGauntlet
  , mcaves :: Caves
mcaves  = Caves
cavesGauntlet
  , mendMsg :: [(Outcome, Text)]
mendMsg = [ (Outcome
Killed, Text
"That was unfortunate. Perhaps the growing wave of rogue robots indeed could not be stemmed. The bill for the nano medbot treatment will reach the stars once the checkout clock alerts authorities and a full drone city sweep (another bill) recovers your remains.\nBut was it really impossible to run a few dozen meters into the tunnel, side-stepping or displacing (Shift-direction) enemies, and trigger the red alarm console? Perhaps one person could distract the replicants, while another searched for a passage around them? Or was the challenge just too difficult and could the difficulty have been lowered otherwise?")  -- hint, hint
              , (Outcome
Conquer, Text
"Not alerting the authorities was a choice that paid off handsomely. You can now collect the semiconductors parts from the infected robots all for yourself. Nobody needs to know. Replicant scrap gives a hefty premium on the darknet, even counting in anonymizing intermediaries. This will make for an enormous PTSD-shedding party.")
              , (Outcome
Escape, Text
"The moment you press the red button, robots get distracted and disperse towards the walls, scanning. You disengage and watch fascinated, but you don't get to see what happens next. The security force contacts you and hauls you up the chute, where you are sternly reprimanded and, unexpectedly, released scot-free after being sworn to silence. Oh well, saving own life is definitely worth more than whatever makes the officer that shooed you off so excited.") ]
  , mrules :: Text
mrules  = Text -> [Text] -> Text
T.intercalate Text
"\n"
      [ Text
"* One level only"
      , Text
"* Two heroes vs. Spawned enemies"
      , Text
"* Incapacitate all enemies faster than they can spawn"
      , Text
"* Or find and activate the red alarm console ASAP"
      ]
  , mdesc :: Text
mdesc   = Text -> [Text] -> Text
T.intercalate Text
"\n"
      [ Text
"Taking this shortcut may not have been the best idea. The tunnel's entry chute was much deeper than the net search suggested and the landing turned out on a pile of robot scrap that dampened the shock, but promptly started moving on its own, shooting rays of light down the corridor and drowning the area in clanking and echoes."
      , Text
"Gasping huddled behind a hardware stack you appraise your misery. That must be the Internet of Things gone wrong, the notorious Robot Replicants, viruses that take over robots or their components, modify, repair, rebuild, clone, merge and divide, spawn and multiply. You've heard about them but you weren't one of the lucky few that experienced the thrill of seeing them. And survived." ]
  , mreason :: Text
mreason = Text
"This is a simple introductory tutorial adventure. It teaches (avoiding) combat, escape, particularly via displacing, aggression, audacity, speed and multiple good endings and dying."
  , mhint :: Text
mhint   = Text
"Speaking plainly, the two good endings are evacuation thanks to the alarm console and killing off all the replicants. The former requires a long and nerve-wrecking jog with lots of displacing (Shift-direction), while being harassed by robots, to the far end of the tunnel. The latter is hard, because the infected machines initially spawn faster than they can be killed and they keep spawning for as long as a single survivor hides under a crate somewhere. Killing off all robots results in higher score, unless it required much more time.\nWhen meleeing, it's best to keep all characters together, but when running past enemies, a sole sprinter will have a higher speed, though breaking through an unexpected wall of enemies may prove impossible for a single brave. If any of the endings seem unattainable, it may be wise to lower game  difficulty level from main menu and/or return after trying out subsequent game modes, battle-hardened and full of mastery."
  }

raid :: ModeKind
raid = ModeKind :: Text
-> Freqs ModeKind
-> Bool
-> Bool
-> Roster
-> Caves
-> [(Outcome, Text)]
-> Text
-> Text
-> Text
-> Text
-> ModeKind
ModeKind
  { mname :: Text
mname   = Text
"raid (tutorial, 2)"
  , mfreq :: Freqs ModeKind
mfreq   = [(GroupName ModeKind
RAID, Int
1), (GroupName ModeKind
CAMPAIGN_SCENARIO, Int
1)]
  , mtutorial :: Bool
mtutorial = Bool
True
  , mattract :: Bool
mattract = Bool
False
  , mroster :: Roster
mroster = Roster
rosterRaid
  , mcaves :: Caves
mcaves  = Caves
cavesRaid
  , mendMsg :: [(Outcome, Text)]
mendMsg = [ (Outcome
Killed, Text
"The search&rescue and nano-medical revival fees are going to kill you (anew). Perhaps more stealth was needed? Perhaps the items lying around the area could aid survival instead of ending up ignored or passively hoarded? Or perhaps a wise course of action would be to choose a Neptune Economic Area Administration challenge with a lower difficulty?")
              , (Outcome
Defeated, Text
"Sadly, you got worked up in the tunnels while another team snatched the prize. Remember, you are at the Outer Frontier to gain wealth and independence through industriousness and commerce. This pits you in a fight against competing agents, not just against the feral nature.")
              , (Outcome
Escape, Text
"You are the first to clear a route through the sewer system. Triton City authorities will now be able to establish a perimeter and mop up the side tunnels. You collect your reward of 100 gold grains and start looking for a way to invest it profitably on this Solar System's commercial frontier, abounding in more or less (usually less) regulated opportunities.\nAfter some thought you decide to start by splurging on genetic enhancement for your team. The effects won't be visible at once, but you have to plan ahead, having just made fresh enemies.") ]
  , mrules :: Text
mrules  = Text -> [Text] -> Text
T.intercalate Text
"\n"
      [ Text
"* One level only"
      , Text
"* Two heroes vs. Competition and Spawned enemies"
      , Text
"* Gather gold"
      , Text
"* Find a way out and escape ASAP"
      ]
  , mdesc :: Text
mdesc   = Text
"Neptune Economic Area Administration confirms isolated spottings of oversize vermin in non-residential zones of the Neptune's Triton moon's largest city. To put it plainly: Triton City sewers need purging. The first person to break through to the other exit will be paid 100 gold grains. The Administration \"strongly urges participants not to resort to violence against each other.\" However, no punitive consequences are specified, not even disqualification from the contest."
  , mreason :: Text
mreason = Text
"In addition to initiating the game plot, this adventure teaches treasure gathering and item use, looking after the shared inventory stash and dealing with many enemy factions at once. Combat, however, is not a focus, so relax, explore, gather loot, find the way out and escape. With some luck, you won't even need to fight anything."
  , mhint :: Text
mhint   = Text
"You can't use gathered items in your next encounters, so trigger any consumables at will, in particular the throwaway electronic chips as common as pebbles on the muddy sewer floors.\nFeel free to scout with only one of the heroes and keep the other one immobile, e.g., standing guard over the squad's shared inventory stash. If in grave danger, retreat with the scout to join forces with the guard. The more gold collected and the faster the victory, the higher your score in this encounter."
  }

brawl :: ModeKind
brawl = ModeKind :: Text
-> Freqs ModeKind
-> Bool
-> Bool
-> Roster
-> Caves
-> [(Outcome, Text)]
-> Text
-> Text
-> Text
-> Text
-> ModeKind
ModeKind  -- sparse melee in daylight, with shade for melee ambush
  { mname :: Text
mname   = Text
"brawl (tutorial, 3)"
  , mfreq :: Freqs ModeKind
mfreq   = [(GroupName ModeKind
BRAWL, Int
1), (GroupName ModeKind
CAMPAIGN_SCENARIO, Int
1)]
  , mtutorial :: Bool
mtutorial = Bool
True
  , mattract :: Bool
mattract = Bool
False
  , mroster :: Roster
mroster = Roster
rosterBrawl
  , mcaves :: Caves
mcaves  = Caves
cavesBrawl
  , mendMsg :: [(Outcome, Text)]
mendMsg = [ (Outcome
Killed, Text
"That treacherous villain didn't honour his word and brought his friends to the fight. It would still not turn so bad if we remembered to use terrain to protect us from missiles or even completely hide our presence and if we honourably kept together to the end, at the same time preventing the overwhelming enemy forces from brutishly ganging up on our modest-sized, though valiant, squad.\nHaving to repurchase the genetic therapy is the most painful result. If repeated, that's going to send you broke and in shame to Earth, to start collecting your Basic Income.")
              , (Outcome
Conquer, Text
"Bringing help was a sober and prudent move that resulted in well-earned victory and a splendid trophy of a title to a real inter-planetary space vessel. Unfortunately, the treacherous foe called reinforcements at the last moment, a new wave arriving even now. It may be wise to move the celebration of the victory to a more fitting area, assuming that the dignified translocation can be accomplished timely and inconspicuously.") ]
  , mrules :: Text
mrules  = Text -> [Text] -> Text
T.intercalate Text
"\n"
      [ Text
"* Two levels"
      , Text
"* Three heroes vs. Six human enemies"
      , Text
"* Minimize losses"
      , Text
"* Incapacitate all enemies ASAP"
      ]
  , mdesc :: Text
mdesc   = Text
"Last evening: \"You scoundrel! You cheated in the sewers, fighting two against one. Come alone to the woody biosphere behind the saloon at noon, if you dare. Given that I win, I take back all your gold. Otherwise, you get the scrapping rights for the giant spaceliner's hull in orbit.\nYes, it's mine, you tramp; here's the docking transmitter and the paperwork. The fight is to the last man standing, no evasion, no breaks for nano-healing in town.\"\nIt's noon now."
  , mreason :: Text
mreason = Text
"In addition to advancing the game plot, this encounter trains melee, squad formation, stealth and stairs use. On each level separately, the battle is symmetric: three vs three. Similar are also goals (incapacitate all enemies) and squad capabilities (only the pointman moves, while all others either melee or wait). Observe and mimic the enemies. If you can't see an enemy that apparently can see you, in reversed circumstances you would have the same advantage. Savour the relative fairness --- you won't find any in the main crawl adventure that follows."
  , mhint :: Text
mhint   = Text
"Run a short distance with Shift or LMB, switch the pointman with Tab, repeat. In open terrain, if you keep distance between teammates, this resembles the leap frog infantry tactics. For best effects, end each sprint behind a cover or concealment.\nOnce you clear a level, descend by bumping into stairs. Use Tab to switch to remaining heroes until all gather on the new level.\nIf you get beaten repeatedly, try using all consumables you find, particularly the vials that collect healing extracts abounding in this rich biosphere. Ponder the hints from the defeat message, in particular the one about keeping your party together once the opponents are spotted. However, if you want to discover a winning tactics on your own, make sure to ignore any such tips until you succeed."
  }

crawl :: ModeKind
crawl = ModeKind :: Text
-> Freqs ModeKind
-> Bool
-> Bool
-> Roster
-> Caves
-> [(Outcome, Text)]
-> Text
-> Text
-> Text
-> Text
-> ModeKind
ModeKind
  { mname :: Text
mname   = Text
"long crawl (main)"
  , mfreq :: Freqs ModeKind
mfreq   = [(GroupName ModeKind
LONG, Int
1), (GroupName ModeKind
CRAWL, Int
1), (GroupName ModeKind
CAMPAIGN_SCENARIO, Int
1)]
  , mtutorial :: Bool
mtutorial = Bool
False
  , mattract :: Bool
mattract = Bool
False
  , mroster :: Roster
mroster = Roster
rosterCrawl
  , mcaves :: Caves
mcaves  = Caves
cavesCrawl
  , mendMsg :: [(Outcome, Text)]
mendMsg = [ (Outcome
Killed, Text
"It was not supposed to end this way. Perhaps more stealth was in order? Perhaps foes that didn't carry any key resources for your survival nor escape could have been eluded and ignored? Perhaps the gathered items should be used for survival instead of hoarded? Or perhaps the challenge, chosen freely but without awareness of the grisly difficulty, was insurmountable and lost from the very start?")
              , (Outcome
Escape, Text
"The shuttle doors close behind, docking clamps grind in farewell and the giant rotating disc slowly tumbles away in rear view. You feel at once a relief and a sense of loss. This is not finished. You are changed forever, but you know nothing. You've heard the call, but you made no answer. You came for petty change, found a treasure beyond comprehension, then barely escaped with your life as the prize.\nAnd nobody will believe you at home. But you don't need their understanding any more. You have enough money to heal, regroup, track the ship down and try again. It's your personal space cruiser, after all, with a world of its own, inside.") ]
  , mrules :: Text
mrules  = Text -> [Text] -> Text
T.intercalate Text
"\n"
      [ Text
"* Many levels, some requiring tools to access"
      , Text
"* Three heroes vs. Spawned enemies"
      , Text
"* Gather gold, gems and stimpacks"
      , Text
"* Find a way out and escape ASAP"
      ]
  , mdesc :: Text
mdesc   = Text
"You are busy looting, with utmost satisfaction, the blasted bridge of an old and extravagantly luxurious cruise liner.\nSuddenly, the inert spaceship, supposedly long deserted and barely able to sustain life support, tremors and dials her fusion engines up to red overdrive. The space map flickering among the irreversibly damaged consoles shows the ship manoeuvre deftly off Triton orbit and purposefully climb the Neptune's gravity well. There's no way to control the ship and static floods all communication channels.\nYou decide to scour the nearby dilapidated decks for missing squad members, this time sending them in pairs and mapping the area properly, and then get back to the spaceport the way you came, in your shuttle. However, you are determined not to leave the ship without taking at least a portion of the wealth that is rightfully yours."
  , mreason :: Text
mreason = Text
"This is the main, longest and most replayable scenario of the game. The fundamental goal is the survival of your crew. Sub-goals will present themselves as you take in newly visited spaceship decks and figure out ways to reach those that are presently cut off."
  , mhint :: Text
mhint   = Text
"If you keep dying, attempt the subsequent adventures as a breather (perhaps at lowered difficulty). They fill the gaps in the plot and teach particular skills that may come in handy and help you discover new tactics of your own or come up with a strategy for staving off the attrition. On the other hand, experimenting with the initial adventures, e.g., to obtain a higher score, may open to you more efficient ways of solving the puzzles."
 -- later, when the player can visit other level sections: you turn on the deck status list display and notice that most levels are fully pressurized, including the complete autonomous slice of the disc that includes the bridge deck
  }

-- The trajectory tip is important because of tactics of scout looking from
-- behind a bush and others hiding in mist. If no suitable bushes,
-- fire once and flee into mist or behind cover. Then whomever is out of LOS
-- range or inside mist can shoot at the last seen enemy locations,
-- adjusting aim according to sounds and incoming missile trajectories.
-- If the scout can't find bushes or glass building to set a lookout,
-- the other team members are more spotters and guardians than snipers
-- and that's their only role, so a small party makes sense.
shootout :: ModeKind
shootout = ModeKind :: Text
-> Freqs ModeKind
-> Bool
-> Bool
-> Roster
-> Caves
-> [(Outcome, Text)]
-> Text
-> Text
-> Text
-> Text
-> ModeKind
ModeKind  -- sparse ranged in daylight
  { mname :: Text
mname   = Text
"foggy shootout (4)"
  , mfreq :: Freqs ModeKind
mfreq   = [(GroupName ModeKind
FOGGY, Int
1), (GroupName ModeKind
SHOOTOUT, Int
1), (GroupName ModeKind
CAMPAIGN_SCENARIO, Int
1)]
  , mtutorial :: Bool
mtutorial = Bool
False
  , mattract :: Bool
mattract = Bool
False
  , mroster :: Roster
mroster = Roster
rosterShootout
  , mcaves :: Caves
mcaves  = Caves
cavesShootout
  , mendMsg :: [(Outcome, Text)]
mendMsg = [ (Outcome
Killed, Text
"This is a disgrace. How is a thuggish robbery in broad daylight even possible in a moon city that styles itself as the capital of Outer System technological innovation and commercial opportunity? Where are the municipal surveillance drones, normally so eager to eavesdrop and needlessly complicate an honest tax-free business, when one's health and wealth for once depend on their nosy presence?\nSpeaking of drones, we could use one in this skirmish, or even just a human lookout placed in a covered but unobstructed spot. Then the rest of the squad could snipe from concealment or from a safe distance.\nBarring that, we would end up in a better shape even if we all hid and fired blindly. We'd listen to impact sounds and wait vigilantly for incoming enemy missiles in order to register their trajectories and derive hints of enemy location. Apparently, ranged combat requires a change of pace and better planning than our previous illustrious successes accustomed us to.")
              , (Outcome
Conquer, Text
"That was a good fight, with skillful application of missiles, cover and concealment. The outcome is especially commendable given the high bar of tactical proficiency. Not even professional enforcement units can routinely deduce enemy position from the trajectory of their projectiles nor by firing without line of sight and interpreting auditory cues. However, while this steep hurdle is overcome, the chase is not over yet.") ]
  , mrules :: Text
mrules  = Text -> [Text] -> Text
T.intercalate Text
"\n"
      [ Text
"* One level only"
      , Text
"* Three heroes vs. Three human enemies"
      , Text
"* Minimize losses"
      , Text
"* Incapacitate all enemies ASAP"
      ]
  , mdesc :: Text
mdesc   = Text
"The fight crashes over to a nearby mechanized farm. Law enforcement, crippled by the ban on firearms, won't show up until only wounded and dying remain to be revived and locked up.\nParcels and flasks of agricultural chemicals, scattered around, beg to be flung at foes as improvised missiles. Intense light makes it easy to aim and to discern trajectory of soaring items (by pointing at enemy projectiles with the crosshair in aiming mode). The effects of your last infracellular therapy finally start showing."
  , mreason :: Text
mreason = Text
"This adventure is a flashback, picking the plot up where brawl (2) left it. It also teaches specifically the ranged combat skill in the simplified setup of a fully symmetric battle."
  , mhint :: Text
mhint   = Text
"Try to come up with the best squad formation for this tactical challenge. Don't despair if you run out of ammo, because if you aim truly, enemy is left with few hit points remaining. Fight, ranged or melee, until all aggressors are disabled."
  }

hunt :: ModeKind
hunt = ModeKind :: Text
-> Freqs ModeKind
-> Bool
-> Bool
-> Roster
-> Caves
-> [(Outcome, Text)]
-> Text
-> Text
-> Text
-> Text
-> ModeKind
ModeKind  -- melee vs ranged with reaction fire in daylight
  { mname :: Text
mname   = Text
"perilous hunt (5)"
  , mfreq :: Freqs ModeKind
mfreq   = [(GroupName ModeKind
PERILOUS, Int
1), (GroupName ModeKind
HUNT, Int
1), (GroupName ModeKind
CAMPAIGN_SCENARIO, Int
1)]
  , mtutorial :: Bool
mtutorial = Bool
False
  , mattract :: Bool
mattract = Bool
False
  , mroster :: Roster
mroster = Roster
rosterHunt
  , mcaves :: Caves
mcaves  = Caves
cavesHunt
  , mendMsg :: [(Outcome, Text)]
mendMsg = [ (Outcome
Killed, Text
"Next time let's try to remember we are not on a sightseeing expedition. Also, leaving concealment is risky, leaving cover is foolhardy and wandering off is deadly. Also, what was that taking pictures by the mangrove tree all about? Were you trying to immortalize your handsome faces in case our shared pool of money was not enough to revive your sorry carcasses after the defeat?\nGood call, because after paying the techno-medical bills we are broke, while the gang foot soldiers that chase us seem to have military grade communication and reaction fire implants. And we were so close to complete victory and unfathomable wealth, if only we strove to lower the difficulty of this mission instead of raising it.")
      -- the guy is wrong about implants (though the items are genetically attuned), but being wrong is plausible when the team is killed off/chased off and can't scour the battleground
      -- this is in the middle of the scenario list and the mission is not tricky, so a subtle reminder about lowering difficulty, in case the player struggles
              , (Outcome
Conquer, Text
"We chased them off, like we knew that we would. It feels nice to stick together and prevail. Now we can do no wrong just minding our business and going our way to the spaceport. We taught them a lesson, despite their superior equipment, and nobody else needs to be harmed while we take possession of our rightful property, the glorious spaceship in Triton's orbit.") ]
  , mrules :: Text
mrules  = Text -> [Text] -> Text
T.intercalate Text
"\n"
      [ Text
"* One level only"
      , Text
"* Seven heroes vs. Seven human enemies capable of concurrent attacks"
      , Text
"* Minimize losses"
      , Text
"* Incapacitate all human enemies ASAP"
      ]
  , mdesc :: Text
mdesc   = Text
"Who is the hunter and who is the prey? The only criterion is last man standing when the chase ends."
  , mreason :: Text
mreason = Text
"This is yet another reminiscence of the events that led to the long crawl adventure. This encounter is quite a tactical challenge, because enemies are allowed to fling their ammo simultaneously at your team, which has no such ability."
  , mhint :: Text
mhint   = Text
"Try not to outshoot the enemy, but to instead focus more on melee tactics. A useful concept here is communication overhead. Any team member that is not waiting and spotting for everybody, but acts, e.g., melees or moves or manages items, slows down all other team members by roughly 10%, because they need to keep track of his actions. Therefore, if other heroes melee, consider carefully if it makes sense to come to their aid, slowing them while you move, or if it's better to stay put and monitor the perimeter. This is true for all factions and all actors on each level separately, except the pointman of each faction, if it has one."  -- this also eliminates lag in big battles and helps the player to focus on combat and not get distracted by distant team members frantically trying to reach the battleground in time
  }

flight :: ModeKind
flight = ModeKind :: Text
-> Freqs ModeKind
-> Bool
-> Bool
-> Roster
-> Caves
-> [(Outcome, Text)]
-> Text
-> Text
-> Text
-> Text
-> ModeKind
ModeKind  -- asymmetric ranged and stealth race at night
  { mname :: Text
mname   = Text
"night flight (6)"
  , mfreq :: Freqs ModeKind
mfreq   = [(GroupName ModeKind
NIGHT, Int
1), (GroupName ModeKind
FLIGHT, Int
1), (GroupName ModeKind
CAMPAIGN_SCENARIO, Int
1)]
  , mtutorial :: Bool
mtutorial = Bool
False
  , mattract :: Bool
mattract = Bool
False
  , mroster :: Roster
mroster = Roster
rosterFlight
  , mcaves :: Caves
mcaves  = Caves
cavesFlight
  , mendMsg :: [(Outcome, Text)]
mendMsg = [ (Outcome
Killed, Text
"Somebody must have tipped the gang guards off. However, us walking along a lit trail, yelling, could have been a contributing factor. Also, it's worth noting that the torches prepared for this assault are best used as thrown makeshift flares.\nOn the other hand, equipping a lit torch makes one visible in the dark, regrettably but not quite unexpectedly. Lastly, the goal of this foray was to find the way back to the city, marked by a yellow '>' sign, and to gather some treasure along the way. Not to harass every local evildoer, as much as they do deserve it.")
              , (Outcome
Conquer, Text
"It was enough to reach the escape area, namely the exit tunnel from the park marked by yellow '>' symbol. Spilling that much blood was risky. unnecessary and alerted the authorities. Having said that --- impressive indeed.")
              , (Outcome
Escape, Text
"Congratulations, you took your revenge and it's heavy in your pockets.") ]
  , mrules :: Text
mrules  = Text -> [Text] -> Text
T.intercalate Text
"\n"
      [ Text
"* One level only"
      , Text
"* Three heroes vs. Seven human enemies capable of concurrent attacks"
      , Text
"* Minimize losses"
      , Text
"* Gather gems"
      , Text
"* Find a way out and escape ASAP"
      ]
  , mdesc :: Text
mdesc   = Text
"Bloodied spaceship deed in hand notwithstanding, you can reach the derelict spaceliner only via a shuttle from the Central Triton Spaceport across the city. After hours of being chased in the opposite direction towards the border wall, you sneak back and make a desperate dash through the very den of the pursuing gang. Any valuables you come upon in this public park turned miscreant lair will be fair compensation for your losses, but you need to find the way out before the foes find you. Rein in your wrath and don't attack your tormentors. Foiling their plans by eluding them will be revenge enough."
  , mreason :: Text
mreason = Text
"The focus of this installment is on stealthy exploration under the threat of numerically superior enemy."
  , mhint :: Text
mhint   = Text
""
  }

zoo :: ModeKind
zoo = ModeKind :: Text
-> Freqs ModeKind
-> Bool
-> Bool
-> Roster
-> Caves
-> [(Outcome, Text)]
-> Text
-> Text
-> Text
-> Text
-> ModeKind
ModeKind  -- asymmetric crowd melee at night
  { mname :: Text
mname   = Text
"burning zoo (7)"
  , mfreq :: Freqs ModeKind
mfreq   = [(GroupName ModeKind
BURNING, Int
1), (GroupName ModeKind
ZOO, Int
1), (GroupName ModeKind
CAMPAIGN_SCENARIO, Int
1)]
  , mtutorial :: Bool
mtutorial = Bool
False
  , mattract :: Bool
mattract = Bool
False
  , mroster :: Roster
mroster = Roster
rosterZoo
  , mcaves :: Caves
mcaves  = Caves
cavesZoo
  , mendMsg :: [(Outcome, Text)]
mendMsg = [ (Outcome
Killed, Text
"Against such an onslaught, only clever positioning, use of terrain and patient vigilance gives any chance of survival.")
              , (Outcome
Conquer, Text
"That was a grim harvest. The city is safe again. So are your precious selves, with nothing and no one blocking your way to the spaceport any more.") ]
  , mrules :: Text
mrules  = Text -> [Text] -> Text
T.intercalate Text
"\n"
      [ Text
"* One level only"
      , Text
"* Five heroes vs. Many enemies"
      , Text
"* Minimize losses"
      , Text
"* Incapacitate all enemies ASAP"
      ]
  , mdesc :: Text
mdesc   = Text
"As justified and satisfying as the setting of enemy headquarters on fire has been, it backfires when the blaze immediately spreads to the public zoo on the path to the spaceport. Crazed animals mill around while the flames ignite greenery and consume nets, cages and security equipment. Whether that's a good sign or bad, apparently nobody is willing to pursue you any more. You are on your own, having to completely clean up the area, up to the last lurking predator, in order to safely move through."
  , mreason :: Text
mreason = Text
"This is a crowd control exercise, at night, with a raging fire."
  , mhint :: Text
mhint   = Text
"Note that communication overhead, as explained in perilous hunt adventure hints, makes it impossible for any faction to hit your heroes by more than 10 normal speed actors each turn. However, this is still too many, so position is everything."
  }

-- The tactic is to sneak in the dark, highlight enemy with thrown torches
-- (and douse thrown enemy torches with blankets) and only if this fails,
-- actually scout using extended noctovision.
-- With reaction fire, larger team is more fun.
--
-- For now, while we have no shooters with timeout, massive ranged battles
-- without reaction fire don't make sense, because then usually only one hero
-- shoots (and often also scouts) and others just gather ammo.
ambush :: ModeKind
ambush = ModeKind :: Text
-> Freqs ModeKind
-> Bool
-> Bool
-> Roster
-> Caves
-> [(Outcome, Text)]
-> Text
-> Text
-> Text
-> Text
-> ModeKind
ModeKind  -- dense ranged with reaction fire vs melee at night
  { mname :: Text
mname   = Text
"ranged ambush (8)"
  , mfreq :: Freqs ModeKind
mfreq   = [(GroupName ModeKind
RANGED, Int
1), (GroupName ModeKind
AMBUSH, Int
1), (GroupName ModeKind
CAMPAIGN_SCENARIO, Int
1)]
  , mtutorial :: Bool
mtutorial = Bool
False
  , mattract :: Bool
mattract = Bool
False
  , mroster :: Roster
mroster = Roster
rosterAmbush
  , mcaves :: Caves
mcaves  = Caves
cavesAmbush
  , mendMsg :: [(Outcome, Text)]
mendMsg = [ (Outcome
Killed, Text
"You turned out to be the prey, this time, not the hunter. In fact, you are not even in the hunters' league. When fighting against such odds, passively waiting for enemy to spring a trap is to no avail, because a professional team can sneak in darkness and ambush the ambushers.\nGranted, good positioning is crucial, so that each squad member can overwatch the battlefield and fire opportunistically, using the recently recovered mil-grade communication equipment. However, there is no hope without active scouting, throwing lit objects and probing suspect areas with missiles while paying attention to sounds. And that may still not be enough.")
              , (Outcome
Conquer, Text
"The new communication equipment enabling simultaneous ranged attacks with indirect aiming proved effective beyond expectation. With the mercenaries gone and nobody else having the slightest wish to interfere, the shuttle to the space cruiser at orbit is easy to launch at last. You let yourself bask in the battle's afterglow of bliss and relief. Now your turbulent adventure ends and the boring life of space cruiser scrap parts supplier or, as it may be, of a refurbished giant space liner operator, commences.\nA pity that the last round of shoddy genetic enhancements, bought at the grey market, scandalously auto-reverts at this very moment, leaving your personalized equipment that attuned to the previous genetic configuration inoperable. Fortunately, danger, debt and the gangster debt collectors are now behind you and the grey market won't see you ever again.") ]
  , mrules :: Text
mrules  = Text -> [Text] -> Text
T.intercalate Text
"\n"
      [ Text
"* One level only"
      , Text
"* Three heroes with concurrent attacks vs. Unidentified foes"
      , Text
"* Minimize losses"
      , Text
"* Assert control of the situation ASAP"
      ]
  , mdesc :: Text
mdesc   = Text
"Not even the unexplained carnage at the Central Triton Spaceport will prevent you from claiming the prize awaiting at the orbit. After all, you didn't take to the stars to let others decide your fate. There is still no news coverage from this ruin of what was the largest facility with tightest security in the whole Neptune Economic Area. Without waiting for explanations nor for the personnel to return, you creep along the burning booths, scouting for any airlock with a shuttle still attached and a way to restore power needed for the docking gear."
  , mreason :: Text
mreason = Text
"In this encounter, finally, your heroes are able to all use ranged attacks simultaneously, given enough ammunition. Once you prevail in the encounter, the story catches up with the start of the main adventure, the long crawl." -- this is the only scenario with no objective specified, to give a bit of suspense, misdirection and mystery until the first win (death gives a hint only); being the last of the small scenarios, it won't scare off new players
  , mhint :: Text
mhint   = Text
"Beware of friendly fire, particularly from explosives. But you need no more hints. Go fulfill your destiny!"
  }

safari :: ModeKind
safari = ModeKind :: Text
-> Freqs ModeKind
-> Bool
-> Bool
-> Roster
-> Caves
-> [(Outcome, Text)]
-> Text
-> Text
-> Text
-> Text
-> ModeKind
ModeKind  -- Easter egg available only via screensaver
  { mname :: Text
mname   = Text
"safari"
  , mfreq :: Freqs ModeKind
mfreq   = [(GroupName ModeKind
SAFARI, Int
1)]
  , mtutorial :: Bool
mtutorial = Bool
False
  , mattract :: Bool
mattract = Bool
False
  , mroster :: Roster
mroster = Roster
rosterSafari
  , mcaves :: Caves
mcaves  = Caves
cavesSafari
  , mendMsg :: [(Outcome, Text)]
mendMsg = []
  , mrules :: Text
mrules  = Text -> [Text] -> Text
T.intercalate Text
"\n"
      [ Text
"* Three levels"
      , Text
"* Many teammates capable of concurrent action vs. Many enemies"
      , Text
"* Minimize losses"
      , Text
"* Find a way out and escape ASAP"
      ]
  , mdesc :: Text
mdesc   = Text
"\"In this simulation you'll discover the joys of hunting the most exquisite of Earth's flora and fauna, both animal and semi-intelligent. Exit at the topmost level.\" This is a VR recording recovered from an alien nest debris."
  , mreason :: Text
mreason = Text
"This is an Easter egg. The default squad doctrine is that all team members follow the pointman, but it can be changed from the settings submenu of the main menu."
  , mhint :: Text
mhint   = Text
""
  }

-- * Testing modes

dig :: ModeKind
dig = ModeKind :: Text
-> Freqs ModeKind
-> Bool
-> Bool
-> Roster
-> Caves
-> [(Outcome, Text)]
-> Text
-> Text
-> Text
-> Text
-> ModeKind
ModeKind
  { mname :: Text
mname   = Text
"dig"
  , mfreq :: Freqs ModeKind
mfreq   = [(GroupName ModeKind
DIG, Int
1)]
  , mtutorial :: Bool
mtutorial = Bool
False
  , mattract :: Bool
mattract = Bool
False
  , mroster :: Roster
mroster = Roster
rosterCrawlEmpty
  , mcaves :: Caves
mcaves  = Caves
cavesDig
  , mendMsg :: [(Outcome, Text)]
mendMsg = []
  , mrules :: Text
mrules  = Text
""
  , mdesc :: Text
mdesc   = Text
"Delve deeper!"
  , mreason :: Text
mreason = Text
""
  , mhint :: Text
mhint   = Text
""
  }

see :: ModeKind
see = ModeKind :: Text
-> Freqs ModeKind
-> Bool
-> Bool
-> Roster
-> Caves
-> [(Outcome, Text)]
-> Text
-> Text
-> Text
-> Text
-> ModeKind
ModeKind
  { mname :: Text
mname   = Text
"see"
  , mfreq :: Freqs ModeKind
mfreq   = [(GroupName ModeKind
SEE, Int
1)]
  , mtutorial :: Bool
mtutorial = Bool
False
  , mattract :: Bool
mattract = Bool
False
  , mroster :: Roster
mroster = Roster
rosterCrawlEmpty
  , mcaves :: Caves
mcaves  = Caves
cavesSee
  , mendMsg :: [(Outcome, Text)]
mendMsg = []
  , mrules :: Text
mrules  = Text
""
  , mdesc :: Text
mdesc   = Text
"See all!"
  , mreason :: Text
mreason = Text
""
  , mhint :: Text
mhint   = Text
""
  }

short :: ModeKind
short = ModeKind :: Text
-> Freqs ModeKind
-> Bool
-> Bool
-> Roster
-> Caves
-> [(Outcome, Text)]
-> Text
-> Text
-> Text
-> Text
-> ModeKind
ModeKind
  { mname :: Text
mname   = Text
"short"
  , mfreq :: Freqs ModeKind
mfreq   = [(GroupName ModeKind
SHORT, Int
1)]
  , mtutorial :: Bool
mtutorial = Bool
False
  , mattract :: Bool
mattract = Bool
False
  , mroster :: Roster
mroster = Roster
rosterCrawlEmpty
  , mcaves :: Caves
mcaves  = Caves
cavesShort
  , mendMsg :: [(Outcome, Text)]
mendMsg = []
  , mrules :: Text
mrules  = Text
""
  , mdesc :: Text
mdesc   = Text
"See all short scenarios!"
  , mreason :: Text
mreason = Text
""
  , mhint :: Text
mhint   = Text
""
  }

fun :: ModeKind
fun = ModeKind :: Text
-> Freqs ModeKind
-> Bool
-> Bool
-> Roster
-> Caves
-> [(Outcome, Text)]
-> Text
-> Text
-> Text
-> Text
-> ModeKind
ModeKind
  { mname :: Text
mname   = Text
"fun"
  , mfreq :: Freqs ModeKind
mfreq   = [(GroupName ModeKind
FUN, Int
1)]
  , mtutorial :: Bool
mtutorial = Bool
False
  , mattract :: Bool
mattract = Bool
False
  , mroster :: Roster
mroster = Roster
rosterCrawlEmpty
  , mcaves :: Caves
mcaves  = Caves
cavesFun
  , mendMsg :: [(Outcome, Text)]
mendMsg = []
  , mrules :: Text
mrules  = Text
""
  , mdesc :: Text
mdesc   = Text
"See all fun maps!"
  , mreason :: Text
mreason = Text
""
  , mhint :: Text
mhint   = Text
""
  }

crawlEmpty :: ModeKind
crawlEmpty = ModeKind :: Text
-> Freqs ModeKind
-> Bool
-> Bool
-> Roster
-> Caves
-> [(Outcome, Text)]
-> Text
-> Text
-> Text
-> Text
-> ModeKind
ModeKind
  { mname :: Text
mname   = Text
"crawl empty"
  , mfreq :: Freqs ModeKind
mfreq   = [(GroupName ModeKind
CRAWL_EMPTY, Int
1)]
  , mtutorial :: Bool
mtutorial = Bool
False
  , mattract :: Bool
mattract = Bool
False
  , mroster :: Roster
mroster = Roster
rosterCrawlEmpty
  , mcaves :: Caves
mcaves  = Caves
cavesCrawlEmpty
  , mendMsg :: [(Outcome, Text)]
mendMsg = []
  , mrules :: Text
mrules  = Text
""
  , mdesc :: Text
mdesc   = Text
"Enjoy the extra legroom."
  , mreason :: Text
mreason = Text
""
  , mhint :: Text
mhint   = Text
""
  }

crawlSurvival :: ModeKind
crawlSurvival = ModeKind :: Text
-> Freqs ModeKind
-> Bool
-> Bool
-> Roster
-> Caves
-> [(Outcome, Text)]
-> Text
-> Text
-> Text
-> Text
-> ModeKind
ModeKind
  { mname :: Text
mname   = Text
"crawl survival"
  , mfreq :: Freqs ModeKind
mfreq   = [(GroupName ModeKind
CRAWL_SURVIVAL, Int
1)]
  , mtutorial :: Bool
mtutorial = Bool
False
  , mattract :: Bool
mattract = Bool
False
  , mroster :: Roster
mroster = Roster
rosterCrawlSurvival
  , mcaves :: Caves
mcaves  = Caves
cavesCrawl
  , mendMsg :: [(Outcome, Text)]
mendMsg = []
  , mrules :: Text
mrules  = Text
""
  , mdesc :: Text
mdesc   = Text
"Lure the human intruders deeper and deeper."
  , mreason :: Text
mreason = Text
""
  , mhint :: Text
mhint   = Text
""
  }

safariSurvival :: ModeKind
safariSurvival = ModeKind :: Text
-> Freqs ModeKind
-> Bool
-> Bool
-> Roster
-> Caves
-> [(Outcome, Text)]
-> Text
-> Text
-> Text
-> Text
-> ModeKind
ModeKind
  { mname :: Text
mname   = Text
"safari survival"
  , mfreq :: Freqs ModeKind
mfreq   = [(GroupName ModeKind
SAFARI_SURVIVAL, Int
1)]
  , mtutorial :: Bool
mtutorial = Bool
False
  , mattract :: Bool
mattract = Bool
False
  , mroster :: Roster
mroster = Roster
rosterSafariSurvival
  , mcaves :: Caves
mcaves  = Caves
cavesSafari
  , mendMsg :: [(Outcome, Text)]
mendMsg = []
  , mrules :: Text
mrules  = Text
""
  , mdesc :: Text
mdesc   = Text
"In this simulation you'll discover the joys of being hunted among the most exquisite of Earth's flora and fauna, both animal and semi-intelligent."
  , mreason :: Text
mreason = Text
""
  , mhint :: Text
mhint   = Text
""
  }

battle :: ModeKind
battle = ModeKind :: Text
-> Freqs ModeKind
-> Bool
-> Bool
-> Roster
-> Caves
-> [(Outcome, Text)]
-> Text
-> Text
-> Text
-> Text
-> ModeKind
ModeKind
  { mname :: Text
mname   = Text
"battle"
  , mfreq :: Freqs ModeKind
mfreq   = [(GroupName ModeKind
BATTLE, Int
1)]
  , mtutorial :: Bool
mtutorial = Bool
False
  , mattract :: Bool
mattract = Bool
False
  , mroster :: Roster
mroster = Roster
rosterBattle
  , mcaves :: Caves
mcaves  = Caves
cavesBattle
  , mendMsg :: [(Outcome, Text)]
mendMsg = []
  , mrules :: Text
mrules  = Text
""
  , mdesc :: Text
mdesc   = Text
"Odds are stacked against those that reveal what should have been kept in the dark."
  , mreason :: Text
mreason = Text
""
  , mhint :: Text
mhint   = Text
""
  }

battleDefense :: ModeKind
battleDefense = ModeKind :: Text
-> Freqs ModeKind
-> Bool
-> Bool
-> Roster
-> Caves
-> [(Outcome, Text)]
-> Text
-> Text
-> Text
-> Text
-> ModeKind
ModeKind
  { mname :: Text
mname   = Text
"battle defense"
  , mfreq :: Freqs ModeKind
mfreq   = [(GroupName ModeKind
BATTLE_DEFENSE, Int
1)]
  , mtutorial :: Bool
mtutorial = Bool
False
  , mattract :: Bool
mattract = Bool
False
  , mroster :: Roster
mroster = Roster
rosterBattleDefense
  , mcaves :: Caves
mcaves  = Caves
cavesBattle
  , mendMsg :: [(Outcome, Text)]
mendMsg = []
  , mrules :: Text
mrules  = Text
""
  , mdesc :: Text
mdesc   = Text
"Odds are stacked for those that set the rules."
  , mreason :: Text
mreason = Text
""
  , mhint :: Text
mhint   = Text
""
  }

battleSurvival :: ModeKind
battleSurvival = ModeKind :: Text
-> Freqs ModeKind
-> Bool
-> Bool
-> Roster
-> Caves
-> [(Outcome, Text)]
-> Text
-> Text
-> Text
-> Text
-> ModeKind
ModeKind
  { mname :: Text
mname   = Text
"battle survival"
  , mfreq :: Freqs ModeKind
mfreq   = [(GroupName ModeKind
BATTLE_SURVIVAL, Int
1)]
  , mtutorial :: Bool
mtutorial = Bool
False
  , mattract :: Bool
mattract = Bool
False
  , mroster :: Roster
mroster = Roster
rosterBattleSurvival
  , mcaves :: Caves
mcaves  = Caves
cavesBattle
  , mendMsg :: [(Outcome, Text)]
mendMsg = []
  , mrules :: Text
mrules  = Text
""
  , mdesc :: Text
mdesc   = Text
"Odds are stacked for those that ally with the strongest."
  , mreason :: Text
mreason = Text
""
  , mhint :: Text
mhint   = Text
""
  }

defense :: ModeKind
defense = ModeKind :: Text
-> Freqs ModeKind
-> Bool
-> Bool
-> Roster
-> Caves
-> [(Outcome, Text)]
-> Text
-> Text
-> Text
-> Text
-> ModeKind
ModeKind  -- perhaps a real scenario in the future
  { mname :: Text
mname   = Text
"defense"
  , mfreq :: Freqs ModeKind
mfreq   = [(GroupName ModeKind
DEFENSE, Int
1)]
  , mtutorial :: Bool
mtutorial = Bool
False
  , mattract :: Bool
mattract = Bool
False
  , mroster :: Roster
mroster = Roster
rosterDefense
  , mcaves :: Caves
mcaves  = Caves
cavesCrawl
  , mendMsg :: [(Outcome, Text)]
mendMsg = []
  , mrules :: Text
mrules  = Text
""
  , mdesc :: Text
mdesc   = Text
"Don't let the half-witted humans derail your operation and flee, like the puny, naked, tentacle-less beasts that they are!"
  , mreason :: Text
mreason = Text
"This is an initial sketch of the reversed crawl game mode. Play on high difficulty to avoid guaranteed victories against the pitiful humans."
  , mhint :: Text
mhint   = Text
""
  }

defenseEmpty :: ModeKind
defenseEmpty = ModeKind :: Text
-> Freqs ModeKind
-> Bool
-> Bool
-> Roster
-> Caves
-> [(Outcome, Text)]
-> Text
-> Text
-> Text
-> Text
-> ModeKind
ModeKind
  { mname :: Text
mname   = Text
"defense empty"
  , mfreq :: Freqs ModeKind
mfreq   = [(GroupName ModeKind
DEFENSE_EMPTY, Int
1)]
  , mtutorial :: Bool
mtutorial = Bool
False
  , mattract :: Bool
mattract = Bool
False
  , mroster :: Roster
mroster = Roster
rosterDefenseEmpty
  , mcaves :: Caves
mcaves  = Caves
cavesCrawlEmpty
  , mendMsg :: [(Outcome, Text)]
mendMsg = []
  , mrules :: Text
mrules  = Text
""
  , mdesc :: Text
mdesc   = Text
"Lord over empty halls."
  , mreason :: Text
mreason = Text
""
  , mhint :: Text
mhint   = Text
""
  }

-- * Screensaver modes

screensaverGauntlet :: ModeKind
screensaverGauntlet = ModeKind
gauntlet
  { mname :: Text
mname   = Text
"auto-gauntlet (1)"
  , mfreq :: Freqs ModeKind
mfreq   = []
  , mattract :: Bool
mattract = Bool
True
  }

screensaverRaid :: ModeKind
screensaverRaid = ModeKind
raid
  { mname :: Text
mname   = Text
"auto-raid (2)"
  , mfreq :: Freqs ModeKind
mfreq   = [(GroupName ModeKind
INSERT_COIN, Int
2)]
  , mattract :: Bool
mattract = Bool
True
  }

screensaverBrawl :: ModeKind
screensaverBrawl = ModeKind
brawl
  { mname :: Text
mname   = Text
"auto-brawl (3)"
  , mfreq :: Freqs ModeKind
mfreq   = []
  , mattract :: Bool
mattract = Bool
True
  }

screensaverCrawl :: ModeKind
screensaverCrawl = ModeKind
crawl
  { mname :: Text
mname   = Text
"auto-crawl (long)"
  , mfreq :: Freqs ModeKind
mfreq   = []
  , mattract :: Bool
mattract = Bool
True
  }

screensaverShootout :: ModeKind
screensaverShootout = ModeKind
shootout
  { mname :: Text
mname   = Text
"auto-shootout (4)"
  , mfreq :: Freqs ModeKind
mfreq   = [(GroupName ModeKind
INSERT_COIN, Int
2)]
  , mattract :: Bool
mattract = Bool
True
  }

screensaverHunt :: ModeKind
screensaverHunt = ModeKind
hunt
  { mname :: Text
mname   = Text
"auto-hunt (5)"
  , mfreq :: Freqs ModeKind
mfreq   = [(GroupName ModeKind
INSERT_COIN, Int
2)]
  , mattract :: Bool
mattract = Bool
True
  }

screensaverFlight :: ModeKind
screensaverFlight = ModeKind
flight
  { mname :: Text
mname   = Text
"auto-flight (6)"
  , mfreq :: Freqs ModeKind
mfreq   = [(GroupName ModeKind
INSERT_COIN, Int
2)]
  , mattract :: Bool
mattract = Bool
True
  }

screensaverZoo :: ModeKind
screensaverZoo = ModeKind
zoo
  { mname :: Text
mname   = Text
"auto-zoo (7)"
  , mfreq :: Freqs ModeKind
mfreq   = []
  , mattract :: Bool
mattract = Bool
True
  }

screensaverAmbush :: ModeKind
screensaverAmbush = ModeKind
ambush
  { mname :: Text
mname   = Text
"auto-ambush (8)"
  , mfreq :: Freqs ModeKind
mfreq   = []
  , mattract :: Bool
mattract = Bool
True
  }

screensaverSafari :: ModeKind
screensaverSafari = ModeKind
safari
  { mname :: Text
mname   = Text
"auto-safari"
  , mfreq :: Freqs ModeKind
mfreq   = [(GroupName ModeKind
INSERT_COIN, Int
1)]
  , mattract :: Bool
mattract = Bool
True
  }

rosterGauntlet, rosterRaid, rosterBrawl, rosterCrawl, rosterShootout, rosterHunt, rosterFlight, rosterZoo, rosterAmbush, rosterSafari, rosterCrawlEmpty, rosterCrawlSurvival, rosterSafariSurvival, rosterBattle, rosterBattleDefense, rosterBattleSurvival, rosterDefense, rosterDefenseEmpty :: Roster

rosterGauntlet :: Roster
rosterGauntlet =
  [ ( GroupName FactionKind
EXPLORER_EXTERMINATOR
    , [(Int
1, Dice
2, GroupName ItemKind
EXTERMINATOR_HERO)] )
  , ( GroupName FactionKind
ROBOT_GAUNTLET
    , [] )  -- avoid a robot that sleeps far away and keeps the faction spawning
  , (GroupName FactionKind
HORROR_REPRESENTATIVE, []) ]

rosterRaid :: Roster
rosterRaid =
  [ ( GroupName FactionKind
ANIMAL_REPRESENTATIVE  -- starting over escape
    , [(Int
2, Dice
2, GroupName ItemKind
ANIMAL)] )
  , ( GroupName FactionKind
EXPLORER_SHORT
    , [(Int
2, Dice
2, GroupName ItemKind
HERO)] )
  , ( GroupName FactionKind
COMPETITOR_SHORT
    , [(Int
2, Dice
1, GroupName ItemKind
RAIDER_HERO)] )
  , ( GroupName FactionKind
ROBOT_REPRESENTATIVE
    , [(Int
2, Dice
1, GroupName ItemKind
ROBOT)] )
  , (GroupName FactionKind
HORROR_REPRESENTATIVE, []) ]  -- for summoned monsters

rosterBrawl :: Roster
rosterBrawl =
  [ ( GroupName FactionKind
EXPLORER_NO_ESCAPE
    , [(Int
3, Dice
3, GroupName ItemKind
BRAWLER_HERO)] )
        -- start heroes on stairs, since they go first
  , ( GroupName FactionKind
COMPETITOR_NO_ESCAPE
    , [ (Int
3, Dice
3, GroupName ItemKind
BRAWLER_HERO)
      , (Int
2, Dice
3, GroupName ItemKind
BRAWLER_HERO) ] )
  , (GroupName FactionKind
HORROR_REPRESENTATIVE, []) ]

rosterCrawl :: Roster
rosterCrawl =
  [ ( GroupName FactionKind
EXPLORER_REPRESENTATIVE  -- start on stairs so that stash is handy
    , [(Int
3, Dice
3, GroupName ItemKind
CRAWL_HERO)] )
  , ( GroupName FactionKind
MONSTER_REPRESENTATIVE
    , [] )
  , ( GroupName FactionKind
ANIMAL_REPRESENTATIVE
    , [ (Int
2, Dice
5, GroupName ItemKind
ANIMAL)
      , (Int
3, Dice
4, GroupName ItemKind
ANIMAL)
      , -- Optional huge battle at the end:
        (Int
16, Dice
100, GroupName ItemKind
MOBILE_ANIMAL) ] )
  , ( GroupName FactionKind
ROBOT_REPRESENTATIVE
    , [(Int
2, Dice
4, GroupName ItemKind
ROBOT)] )
  , ( GroupName FactionKind
ROBOT_VIRUS
    , [] ) ]

-- Exactly one scout gets a sight boost, to help the aggressor, because he uses
-- the scout for initial attack, while camper (on big enough maps)
-- can't guess where the attack would come and so can't position his single
-- scout to counter the stealthy advance.
rosterShootout :: Roster
rosterShootout =
  [ ( GroupName FactionKind
EXPLORER_NO_ESCAPE
    , [(Int
5, Dice
2, GroupName ItemKind
RANGER_HERO), (Int
5, Dice
1, GroupName ItemKind
SCOUT_HERO)] )
  , ( GroupName FactionKind
COMPETITOR_NO_ESCAPE
    , [(Int
5, Dice
2, GroupName ItemKind
RANGER_HERO), (Int
5, Dice
1, GroupName ItemKind
SCOUT_HERO)] )
  , (GroupName FactionKind
HORROR_REPRESENTATIVE, []) ]

rosterHunt :: Roster
rosterHunt =
  [ ( GroupName FactionKind
EXPLORER_NO_ESCAPE
    , [(Int
6, Dice
7, GroupName ItemKind
SOLDIER_HERO)] )
  , ( GroupName FactionKind
COMPETITOR_NO_ESCAPE
    , [(Int
6, Dice
6, GroupName ItemKind
AMBUSHER_HERO), (Int
6, Dice
1, GroupName ItemKind
SCOUT_HERO)] )
  , (GroupName FactionKind
HORROR_REPRESENTATIVE, []) ]

rosterFlight :: Roster
rosterFlight =
  [ ( GroupName FactionKind
COMPETITOR_NO_ESCAPE  -- start on escape
    , [(Int
7, Dice
6, GroupName ItemKind
AMBUSHER_HERO), (Int
7, Dice
1, GroupName ItemKind
SCOUT_HERO)] )
  , ( GroupName FactionKind
EXPLORER_MEDIUM
    , [(Int
7, Dice
2, GroupName ItemKind
ESCAPIST_HERO), (Int
7, Dice
1, GroupName ItemKind
SCOUT_HERO)] )
      -- second on the list to let the bros occupy the escape
  , (GroupName FactionKind
HORROR_REPRESENTATIVE, []) ]

rosterZoo :: Roster
rosterZoo =
  [ ( GroupName FactionKind
EXPLORER_TRAPPED
    , [(Int
8, Dice
5, GroupName ItemKind
SOLDIER_HERO)] )
  , ( GroupName FactionKind
ANIMAL_CAPTIVE
    , [(Int
8, Dice
100, GroupName ItemKind
MOBILE_ANIMAL)] )
  , (GroupName FactionKind
HORROR_REPRESENTATIVE, []) ]  -- for summoned monsters

rosterAmbush :: Roster
rosterAmbush =
  [ ( GroupName FactionKind
EXPLORER_NO_ESCAPE
    , [(Int
9, Dice
5, GroupName ItemKind
AMBUSHER_HERO), (Int
9, Dice
1, GroupName ItemKind
SCOUT_HERO)] )
  , ( GroupName FactionKind
OFF_WORLD_REPRESENTATIVE
    , [(Int
9, Dice
12, GroupName ItemKind
MERCENARY_HERO)] )
  , (GroupName FactionKind
HORROR_REPRESENTATIVE, []) ]

-- No horrors faction needed, because spawned heroes land in civilian faction.
rosterSafari :: Roster
rosterSafari =
  [ ( GroupName FactionKind
MONSTER_TOURIST
    , [(Int
5, Dice
15, GroupName ItemKind
MONSTER)] )
  , ( GroupName FactionKind
CONVICT_REPRESENTATIVE
    , [(Int
5, Dice
2, GroupName ItemKind
CIVILIAN)] )
  , ( GroupName FactionKind
ANIMAL_MAGNIFICENT
    , [(Int
10, Dice
15, GroupName ItemKind
MOBILE_ANIMAL)] )
  , ( GroupName FactionKind
ANIMAL_EXQUISITE  -- start on escape
    , [(Int
16, Dice
20, GroupName ItemKind
MOBILE_ANIMAL)] )
  , (GroupName FactionKind
HORROR_REPRESENTATIVE, []) ]
      -- construction hooter; neutral

rosterCrawlEmpty :: Roster
rosterCrawlEmpty =
  [ ( GroupName FactionKind
EXPLORER_PACIFIST
    , [(Int
1, Dice
1, GroupName ItemKind
CRAWL_HERO)] )
  , (GroupName FactionKind
HORROR_PACIFIST, []) ]
      -- for spawned and summoned monsters

rosterCrawlSurvival :: Roster
rosterCrawlSurvival =
  [ ( GroupName FactionKind
EXPLORER_AUTOMATED
    , [(Int
3, Dice
3, GroupName ItemKind
CRAWL_HERO)] )
  , ( GroupName FactionKind
MONSTER_REPRESENTATIVE
    , [(Int
5, Dice
1, GroupName ItemKind
MONSTER)] )
  , ( GroupName FactionKind
ANIMAL_OR_ROBOT_NARRATING
    , [(Int
5, Dice
10, GroupName ItemKind
ANIMAL)] )  -- explore unopposed for some time
  , (GroupName FactionKind
HORROR_REPRESENTATIVE, []) ]

rosterSafariSurvival :: Roster
rosterSafariSurvival =
  [ ( GroupName FactionKind
MONSTER_TOURIST_PASSIVE
    , [(Int
5, Dice
15, GroupName ItemKind
MONSTER)] )
  , ( GroupName FactionKind
CONVICT_REPRESENTATIVE
    , [(Int
5, Dice
3, GroupName ItemKind
CIVILIAN)] )
  , ( GroupName FactionKind
ANIMAL_MAGNIFICENT_NARRATING
    , [(Int
10, Dice
20, GroupName ItemKind
MOBILE_ANIMAL)] )
  , ( GroupName FactionKind
ANIMAL_EXQUISITE
    , [(Int
16, Dice
30, GroupName ItemKind
MOBILE_ANIMAL)] )
  , (GroupName FactionKind
HORROR_REPRESENTATIVE, []) ]

rosterBattle :: Roster
rosterBattle =
  [ ( GroupName FactionKind
EXPLORER_TRAPPED
    , [(Int
10, Dice
5, GroupName ItemKind
SOLDIER_HERO)] )
  , ( GroupName FactionKind
MONSTER_CAPTIVE
    , [(Int
10, Dice
35, GroupName ItemKind
MOBILE_MONSTER)] )
  , ( GroupName FactionKind
ANIMAL_CAPTIVE
    , [(Int
10, Dice
20, GroupName ItemKind
MOBILE_ANIMAL)] )
  , ( GroupName FactionKind
ROBOT_CAPTIVE
    , [(Int
10, Dice
15, GroupName ItemKind
MOBILE_ROBOT)] ) ]

rosterBattleDefense :: Roster
rosterBattleDefense =
  [ ( GroupName FactionKind
EXPLORER_AUTOMATED_TRAPPED
    , [(Int
10, Dice
5, GroupName ItemKind
SOLDIER_HERO)] )
  , ( GroupName FactionKind
MONSTER_CAPTIVE_NARRATING
    , [(Int
10, Dice
35, GroupName ItemKind
MOBILE_MONSTER)] )
  , ( GroupName FactionKind
ANIMAL_CAPTIVE
    , [(Int
10, Dice
20, GroupName ItemKind
MOBILE_ANIMAL)] )
  , ( GroupName FactionKind
ROBOT_CAPTIVE
    , [(Int
10, Dice
15, GroupName ItemKind
MOBILE_ROBOT)] ) ]

rosterBattleSurvival :: Roster
rosterBattleSurvival =
  [ ( GroupName FactionKind
EXPLORER_AUTOMATED_TRAPPED
    , [(Int
10, Dice
5, GroupName ItemKind
SOLDIER_HERO)] )
  , ( GroupName FactionKind
MONSTER_CAPTIVE
    , [(Int
10, Dice
35, GroupName ItemKind
MOBILE_MONSTER)] )
  , ( GroupName FactionKind
ANIMAL_CAPTIVE_NARRATING
    , [(Int
10, Dice
20, GroupName ItemKind
MOBILE_ANIMAL)] )
  , ( GroupName FactionKind
ROBOT_CAPTIVE
    , [(Int
10, Dice
15, GroupName ItemKind
MOBILE_ROBOT)] ) ]

rosterDefense :: Roster
rosterDefense =
  [ ( GroupName FactionKind
EXPLORER_AUTOMATED
    , [(Int
3, Dice
3, GroupName ItemKind
CRAWL_HERO)] )
  , ( GroupName FactionKind
MONSTER_ANTI
    , [] )
  , ( GroupName FactionKind
ANIMAL_REPRESENTATIVE
    , -- Fun from the start to avoid empty initial level:
      [ (Int
3, Dice
5 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
2, GroupName ItemKind
ANIMAL)  -- many, because no spawning
      -- Optional huge battle at the end:
      , (Int
16, Dice
100, GroupName ItemKind
MOBILE_ANIMAL) ] )
  , ( GroupName FactionKind
ROBOT_REPRESENTATIVE
    , [] ) ]

rosterDefenseEmpty :: Roster
rosterDefenseEmpty =
  [ ( GroupName FactionKind
MONSTER_ANTI_PACIFIST
    , [(Int
4, Dice
1, GroupName ItemKind
SCOUT_MONSTER)] )
  , (GroupName FactionKind
HORROR_PACIFIST, []) ]
      -- for spawned and summoned animals

cavesGauntlet, cavesRaid, cavesBrawl, cavesCrawl, cavesShootout, cavesHunt, cavesFlight, cavesZoo, cavesAmbush, cavesSafari, cavesDig, cavesSee, cavesShort, cavesFun, cavesCrawlEmpty, cavesBattle :: Caves

cavesGauntlet :: Caves
cavesGauntlet = [([Int
1], [GroupName CaveKind
CAVE_GAUNTLET])]

cavesRaid :: Caves
cavesRaid = [([Int
2], [GroupName CaveKind
CAVE_RAID])]

cavesBrawl :: Caves
cavesBrawl = Caves -> Caves
forall a. [a] -> [a]
reverse [([Int
2], [GroupName CaveKind
CAVE_BRAWL_ALT]), ([Int
3], [GroupName CaveKind
CAVE_BRAWL])]

listCrawl :: [([Int], [GroupName CaveKind])]
listCrawl :: Caves
listCrawl =
  [ ([Int
1], [GroupName CaveKind
CAVE_OUTERMOST])
  , ([Int
2], [GroupName CaveKind
CAVE_SHALLOW_ROGUE])
  , ([Int
3], [GroupName CaveKind
CAVE_BRIDGE])
  , ([Int
4], [GroupName CaveKind
CAVE_NOISE])
  , ([Int
8, Int
7, Int
6, Int
5], [GroupName CaveKind
CAVE_VIRUS, GroupName CaveKind
CAVE_ROGUE, GroupName CaveKind
CAVE_ARENA, GroupName CaveKind
CAVE_RESIDENTIAL])
       -- reversed order, to match @reverse@ later on
  , ([Int
9], [GroupName CaveKind
CAVE_LABORATORY])
  , ([Int
12, Int
11, Int
10], [GroupName CaveKind
DEFAULT_RANDOM, GroupName CaveKind
DEFAULT_RANDOM, GroupName CaveKind
CAVE_MUSEUM])
  , ([Int
13], [GroupName CaveKind
CAVE_EGRESS])
  , ([Int
15, Int
14], [GroupName CaveKind
DEFAULT_RANDOM, GroupName CaveKind
CAVE_CASINO])
  , ([Int
16], [GroupName CaveKind
CAVE_POWER]) ]

cavesCrawl :: Caves
cavesCrawl = Caves -> Caves
forall a. [a] -> [a]
reverse Caves
listCrawl

cavesShootout :: Caves
cavesShootout = [([Int
5], [GroupName CaveKind
CAVE_SHOOTOUT])]

cavesHunt :: Caves
cavesHunt = [([Int
6], [GroupName CaveKind
CAVE_HUNT])]

cavesFlight :: Caves
cavesFlight = [([Int
7], [GroupName CaveKind
CAVE_FLIGHT])]

cavesZoo :: Caves
cavesZoo = [([Int
8], [GroupName CaveKind
CAVE_ZOO])]

cavesAmbush :: Caves
cavesAmbush = [([Int
9], [GroupName CaveKind
CAVE_AMBUSH])]

cavesSafari :: Caves
cavesSafari = Caves -> Caves
forall a. [a] -> [a]
reverse [ ([Int
5], [GroupName CaveKind
CAVE_SAFARI_1])
                      , ([Int
10], [GroupName CaveKind
CAVE_SAFARI_2])
                      , ([Int
16], [GroupName CaveKind
CAVE_SAFARI_3]) ]

cavesDig :: Caves
cavesDig =
  Caves -> Caves
forall a. [a] -> [a]
reverse (Caves -> Caves) -> Caves -> Caves
forall a b. (a -> b) -> a -> b
$ [Caves] -> Caves
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  ([Caves] -> Caves) -> [Caves] -> Caves
forall a b. (a -> b) -> a -> b
$ (Int -> Caves -> Caves) -> [Int] -> [Caves] -> [Caves]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((([Int], [GroupName CaveKind]) -> ([Int], [GroupName CaveKind]))
-> Caves -> Caves
forall a b. (a -> b) -> [a] -> [b]
map ((([Int], [GroupName CaveKind]) -> ([Int], [GroupName CaveKind]))
 -> Caves -> Caves)
-> (Int
    -> ([Int], [GroupName CaveKind]) -> ([Int], [GroupName CaveKind]))
-> Int
-> Caves
-> Caves
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> ([Int], [GroupName CaveKind]) -> ([Int], [GroupName CaveKind])
renumberCaves)
            [Int
0, Int
16 ..]
            (Int -> Caves -> [Caves]
forall a. Int -> a -> [a]
replicate Int
100 Caves
listCrawl)
--            [0, 2 ..]
--            (replicate 100 [([1], [CAVE_OUTERMOST]),([2], [CAVE_EGRESS])])

renumberCaves :: Int -> ([Int], [GroupName CaveKind])
              -> ([Int], [GroupName CaveKind])
renumberCaves :: Int
-> ([Int], [GroupName CaveKind]) -> ([Int], [GroupName CaveKind])
renumberCaves Int
offset ([Int]
ns, [GroupName CaveKind]
l) = ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset) [Int]
ns, [GroupName CaveKind]
l)

cavesSee :: Caves
cavesSee = let numberCaves :: a -> a -> ([a], [a])
numberCaves a
n a
c = ([a
n], [a
c])
           in Caves -> Caves
forall a. [a] -> [a]
reverse (Caves -> Caves) -> Caves -> Caves
forall a b. (a -> b) -> a -> b
$ (Int -> GroupName CaveKind -> ([Int], [GroupName CaveKind]))
-> [Int] -> [GroupName CaveKind] -> Caves
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> GroupName CaveKind -> ([Int], [GroupName CaveKind])
forall a a. a -> a -> ([a], [a])
numberCaves [Int
1..]
              ([GroupName CaveKind] -> Caves) -> [GroupName CaveKind] -> Caves
forall a b. (a -> b) -> a -> b
$ (GroupName CaveKind -> [GroupName CaveKind])
-> [GroupName CaveKind] -> [GroupName CaveKind]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> GroupName CaveKind -> [GroupName CaveKind]
forall a. Int -> a -> [a]
replicate Int
10) [GroupName CaveKind]
allCaves

cavesShort :: Caves
cavesShort = let numberCaves :: a -> a -> ([a], [a])
numberCaves a
n a
c = ([a
n], [a
c])
             in Caves -> Caves
forall a. [a] -> [a]
reverse (Caves -> Caves) -> Caves -> Caves
forall a b. (a -> b) -> a -> b
$ (Int -> GroupName CaveKind -> ([Int], [GroupName CaveKind]))
-> [Int] -> [GroupName CaveKind] -> Caves
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> GroupName CaveKind -> ([Int], [GroupName CaveKind])
forall a a. a -> a -> ([a], [a])
numberCaves [Int
1..]
                ([GroupName CaveKind] -> Caves) -> [GroupName CaveKind] -> Caves
forall a b. (a -> b) -> a -> b
$ (GroupName CaveKind -> [GroupName CaveKind])
-> [GroupName CaveKind] -> [GroupName CaveKind]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> GroupName CaveKind -> [GroupName CaveKind]
forall a. Int -> a -> [a]
replicate Int
100) ([GroupName CaveKind] -> [GroupName CaveKind])
-> [GroupName CaveKind] -> [GroupName CaveKind]
forall a b. (a -> b) -> a -> b
$ Int -> [GroupName CaveKind] -> [GroupName CaveKind]
forall a. Int -> [a] -> [a]
take Int
8 [GroupName CaveKind]
allCaves

cavesFun :: Caves
cavesFun = let numberCaves :: a -> a -> ([a], [a])
numberCaves a
n a
c = ([a
n], [a
c])
               funModes :: [GroupName CaveKind]
funModes = Int -> [GroupName CaveKind] -> [GroupName CaveKind]
forall a. Int -> [a] -> [a]
drop Int
4 (Int -> [GroupName CaveKind] -> [GroupName CaveKind]
forall a. Int -> [a] -> [a]
take Int
8 [GroupName CaveKind]
allCaves)
               funLevels :: [GroupName CaveKind]
funLevels = [ GroupName CaveKind
CAVE_OUTERMOST, GroupName CaveKind
CAVE_RESIDENTIAL, GroupName CaveKind
CAVE_ROGUE
                           , GroupName CaveKind
CAVE_AMBUSH ]
           in Caves -> Caves
forall a. [a] -> [a]
reverse (Caves -> Caves) -> Caves -> Caves
forall a b. (a -> b) -> a -> b
$ (Int -> GroupName CaveKind -> ([Int], [GroupName CaveKind]))
-> [Int] -> [GroupName CaveKind] -> Caves
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> GroupName CaveKind -> ([Int], [GroupName CaveKind])
forall a a. a -> a -> ([a], [a])
numberCaves [Int
1..]
              ([GroupName CaveKind] -> Caves) -> [GroupName CaveKind] -> Caves
forall a b. (a -> b) -> a -> b
$ (GroupName CaveKind -> [GroupName CaveKind])
-> [GroupName CaveKind] -> [GroupName CaveKind]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> GroupName CaveKind -> [GroupName CaveKind]
forall a. Int -> a -> [a]
replicate Int
33) ([GroupName CaveKind] -> [GroupName CaveKind])
-> [GroupName CaveKind] -> [GroupName CaveKind]
forall a b. (a -> b) -> a -> b
$ [GroupName CaveKind]
funModes [GroupName CaveKind]
-> [GroupName CaveKind] -> [GroupName CaveKind]
forall a. [a] -> [a] -> [a]
++ [GroupName CaveKind]
funLevels

allCaves :: [GroupName CaveKind]
allCaves :: [GroupName CaveKind]
allCaves =
  [ GroupName CaveKind
CAVE_GAUNTLET, GroupName CaveKind
CAVE_RAID, GroupName CaveKind
CAVE_BRAWL, GroupName CaveKind
CAVE_SHOOTOUT, GroupName CaveKind
CAVE_HUNT, GroupName CaveKind
CAVE_FLIGHT
  , GroupName CaveKind
CAVE_ZOO, GroupName CaveKind
CAVE_AMBUSH
  , GroupName CaveKind
CAVE_OUTERMOST, GroupName CaveKind
CAVE_SHALLOW_ROGUE, GroupName CaveKind
CAVE_BRIDGE, GroupName CaveKind
CAVE_NOISE, GroupName CaveKind
CAVE_ROGUE
  , GroupName CaveKind
CAVE_ARENA, GroupName CaveKind
CAVE_RESIDENTIAL, GroupName CaveKind
CAVE_VIRUS, GroupName CaveKind
CAVE_LABORATORY, GroupName CaveKind
CAVE_MUSEUM
  , GroupName CaveKind
CAVE_EGRESS, GroupName CaveKind
CAVE_CASINO, GroupName CaveKind
CAVE_POWER ]

cavesCrawlEmpty :: Caves
cavesCrawlEmpty = Caves -> Caves
forall a. [a] -> [a]
reverse (Caves -> Caves) -> Caves -> Caves
forall a b. (a -> b) -> a -> b
$
  (([Int], [GroupName CaveKind]) -> ([Int], [GroupName CaveKind]))
-> Caves -> Caves
forall a b. (a -> b) -> [a] -> [b]
map (\([Int]
ns, [GroupName CaveKind]
grps) ->
        ([Int]
ns, if [GroupName CaveKind]
grps [GroupName CaveKind] -> [GroupName CaveKind] -> Bool
forall a. Eq a => a -> a -> Bool
== [GroupName CaveKind
CAVE_BRIDGE] then [GroupName CaveKind
CAVE_SHALLOW_ROGUE] else [GroupName CaveKind]
grps))
      Caves
listCrawl

cavesBattle :: Caves
cavesBattle = [([Int
10], [GroupName CaveKind
CAVE_BATTLE])]