module Game.LambdaHack.Server.StartM
( initPer, reinitGame, gameReset, applyDebug
#ifdef EXPOSE_INTERNAL
, sampleTrunks, sampleItems
, mapFromFuns, resetFactions, populateDungeon, findEntryPoss
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Control.Monad.Trans.State.Strict as St
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import qualified Data.IntMap.Strict as IM
import Data.Key (mapWithKeyM_)
import qualified Data.Map.Strict as M
import Data.Ord
import qualified Data.Set as S
import qualified Data.Text as T
import Data.Tuple (swap)
import qualified NLP.Miniutter.English as MU
import qualified System.Random as R
import Game.LambdaHack.Atomic
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Analytics
import Game.LambdaHack.Common.Area
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Item
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Types
import qualified Game.LambdaHack.Content.CaveKind as CK
import qualified Game.LambdaHack.Content.ItemKind as IK
import Game.LambdaHack.Content.ModeKind
import qualified Game.LambdaHack.Core.Dice as Dice
import Game.LambdaHack.Core.Random
import qualified Game.LambdaHack.Definition.Color as Color
import Game.LambdaHack.Definition.Defs
import Game.LambdaHack.Definition.Flavour
import Game.LambdaHack.Server.CommonM
import qualified Game.LambdaHack.Server.DungeonGen as DungeonGen
import Game.LambdaHack.Server.Fov
import Game.LambdaHack.Server.ItemM
import Game.LambdaHack.Server.ItemRev
import Game.LambdaHack.Server.MonadServer
import Game.LambdaHack.Server.ServerOptions
import Game.LambdaHack.Server.State
initPer :: MonadServer m => m ()
initPer :: m ()
initPer = do
( sfovLitLid :: FovLitLid
sfovLitLid, sfovClearLid :: FovClearLid
sfovClearLid, sfovLucidLid :: FovLucidLid
sfovLucidLid
,sperValidFid :: PerValidFid
sperValidFid, sperCacheFid :: PerCacheFid
sperCacheFid, sperFid :: PerFid
sperFid ) <- (State
-> (FovLitLid, FovClearLid, FovLucidLid, PerValidFid, PerCacheFid,
PerFid))
-> m (FovLitLid, FovClearLid, FovLucidLid, PerValidFid,
PerCacheFid, PerFid)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State
-> (FovLitLid, FovClearLid, FovLucidLid, PerValidFid, PerCacheFid,
PerFid)
perFidInDungeon
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser ->
StateServer
ser { FovLitLid
sfovLitLid :: FovLitLid
sfovLitLid :: FovLitLid
sfovLitLid, FovClearLid
sfovClearLid :: FovClearLid
sfovClearLid :: FovClearLid
sfovClearLid, FovLucidLid
sfovLucidLid :: FovLucidLid
sfovLucidLid :: FovLucidLid
sfovLucidLid
, PerValidFid
sperValidFid :: PerValidFid
sperValidFid :: PerValidFid
sperValidFid, PerCacheFid
sperCacheFid :: PerCacheFid
sperCacheFid :: PerCacheFid
sperCacheFid, PerFid
sperFid :: PerFid
sperFid :: PerFid
sperFid }
reinitGame :: MonadServerAtomic m => m ()
reinitGame :: m ()
reinitGame = do
COps{ContentData ItemKind
coitem :: COps -> ContentData ItemKind
coitem :: ContentData ItemKind
coitem} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
PerFid
pers <- (StateServer -> PerFid) -> m PerFid
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> PerFid
sperFid
ServerOptions{Challenge
scurChalSer :: ServerOptions -> Challenge
scurChalSer :: Challenge
scurChalSer, Bool
sknowMap :: ServerOptions -> Bool
sknowMap :: Bool
sknowMap, Bool
sshowItemSamples :: ServerOptions -> Bool
sshowItemSamples :: Bool
sshowItemSamples, ClientOptions
sclientOptions :: ServerOptions -> ClientOptions
sclientOptions :: ClientOptions
sclientOptions}
<- (StateServer -> ServerOptions) -> m ServerOptions
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> ServerOptions
soptions
State
s <- m State
forall (m :: * -> *). MonadStateRead m => m State
getState
DiscoveryKind
discoS <- (State -> DiscoveryKind) -> m DiscoveryKind
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> DiscoveryKind
sdiscoKind
let discoKindFiltered :: DiscoveryKind
discoKindFiltered =
let f :: ContentId ItemKind -> Bool
f kindId :: ContentId ItemKind
kindId = Maybe (GroupName ItemKind) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (GroupName ItemKind) -> Bool)
-> Maybe (GroupName ItemKind) -> Bool
forall a b. (a -> b) -> a -> b
$ ItemKind -> Maybe (GroupName ItemKind)
IK.getMandatoryHideAsFromKind
(ItemKind -> Maybe (GroupName ItemKind))
-> ItemKind -> Maybe (GroupName ItemKind)
forall a b. (a -> b) -> a -> b
$ ContentData ItemKind -> ContentId ItemKind -> ItemKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ItemKind
coitem ContentId ItemKind
kindId
in (ContentId ItemKind -> Bool) -> DiscoveryKind -> DiscoveryKind
forall a k. (a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filter ContentId ItemKind -> Bool
f DiscoveryKind
discoS
defL :: State
defL | Bool
sknowMap = State
s
| Bool
otherwise = State -> State
localFromGlobal State
s
defLocal :: State
defLocal = (DiscoveryKind -> DiscoveryKind) -> State -> State
updateDiscoKind (DiscoveryKind -> DiscoveryKind -> DiscoveryKind
forall a b. a -> b -> a
const DiscoveryKind
discoKindFiltered) State
defL
FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser -> StateServer
ser {sclientStates :: EnumMap FactionId State
sclientStates = (Faction -> State) -> FactionDict -> EnumMap FactionId State
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (State -> Faction -> State
forall a b. a -> b -> a
const State
defLocal) FactionDict
factionD}
let updRestart :: FactionId -> StdGen -> UpdAtomic
updRestart fid :: FactionId
fid = FactionId
-> PerLid
-> State
-> Challenge
-> ClientOptions
-> StdGen
-> UpdAtomic
UpdRestart FactionId
fid (PerFid
pers PerFid -> FactionId -> PerLid
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) State
defLocal
Challenge
scurChalSer ClientOptions
sclientOptions
(Key (EnumMap FactionId) -> Faction -> m ()) -> FactionDict -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(FoldableWithKey t, Monad m) =>
(Key t -> a -> m b) -> t a -> m ()
mapWithKeyM_ (\fid :: Key (EnumMap FactionId)
fid _ -> do
StdGen
gen1 <- (StateServer -> StdGen) -> m StdGen
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> StdGen
srandom
let (clientRandomSeed :: StdGen
clientRandomSeed, gen2 :: StdGen
gen2) = StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
R.split StdGen
gen1
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser -> StateServer
ser {srandom :: StdGen
srandom = StdGen
gen2}
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> StdGen -> UpdAtomic
updRestart Key (EnumMap FactionId)
FactionId
fid StdGen
clientRandomSeed) FactionDict
factionD
Dungeon
dungeon <- (State -> Dungeon) -> m Dungeon
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Dungeon
sdungeon
let sactorTime :: EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
sactorTime = (Faction -> EnumMap LevelId (EnumMap ActorId Time))
-> FactionDict
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (EnumMap LevelId (EnumMap ActorId Time)
-> Faction -> EnumMap LevelId (EnumMap ActorId Time)
forall a b. a -> b -> a
const ((Level -> EnumMap ActorId Time)
-> Dungeon -> EnumMap LevelId (EnumMap ActorId Time)
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (EnumMap ActorId Time -> Level -> EnumMap ActorId Time
forall a b. a -> b -> a
const EnumMap ActorId Time
forall k a. EnumMap k a
EM.empty) Dungeon
dungeon)) FactionDict
factionD
strajTime :: EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
strajTime = (Faction -> EnumMap LevelId (EnumMap ActorId Time))
-> FactionDict
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (EnumMap LevelId (EnumMap ActorId Time)
-> Faction -> EnumMap LevelId (EnumMap ActorId Time)
forall a b. a -> b -> a
const ((Level -> EnumMap ActorId Time)
-> Dungeon -> EnumMap LevelId (EnumMap ActorId Time)
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (EnumMap ActorId Time -> Level -> EnumMap ActorId Time
forall a b. a -> b -> a
const EnumMap ActorId Time
forall k a. EnumMap k a
EM.empty) Dungeon
dungeon)) FactionDict
factionD
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser -> StateServer
ser {EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
sactorTime :: EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
sactorTime :: EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
sactorTime, EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
strajTime :: EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
strajTime :: EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
strajTime}
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
sshowItemSamples (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
StdGen
genOrig <- (StateServer -> StdGen) -> m StdGen
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> StdGen
srandom
UniqueSet
uniqueSetOrig <- (StateServer -> UniqueSet) -> m UniqueSet
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> UniqueSet
suniqueSet
GenerationAnalytics
genOld <- (StateServer -> GenerationAnalytics) -> m GenerationAnalytics
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> GenerationAnalytics
sgenerationAn
GenerationAnalytics
genSampleTrunks <- Dungeon -> m GenerationAnalytics
forall (m :: * -> *).
MonadServerAtomic m =>
Dungeon -> m GenerationAnalytics
sampleTrunks Dungeon
dungeon
GenerationAnalytics
genSampleItems <- Dungeon -> m GenerationAnalytics
forall (m :: * -> *).
MonadServerAtomic m =>
Dungeon -> m GenerationAnalytics
sampleItems Dungeon
dungeon
let sgenerationAn :: GenerationAnalytics
sgenerationAn = [GenerationAnalytics] -> GenerationAnalytics
forall k a. [EnumMap k a] -> EnumMap k a
EM.unions [GenerationAnalytics
genSampleTrunks, GenerationAnalytics
genSampleItems, GenerationAnalytics
genOld]
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser -> StateServer
ser {GenerationAnalytics
sgenerationAn :: GenerationAnalytics
sgenerationAn :: GenerationAnalytics
sgenerationAn}
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser -> StateServer
ser {srandom :: StdGen
srandom = StdGen
genOrig, suniqueSet :: UniqueSet
suniqueSet = UniqueSet
uniqueSetOrig}
m ()
forall (m :: * -> *). MonadServerAtomic m => m ()
populateDungeon
(FactionId -> m ()) -> [FactionId] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\fid :: FactionId
fid -> (LevelId -> m ()) -> [LevelId] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FactionId -> LevelId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> LevelId -> m ()
updatePer FactionId
fid) (Dungeon -> [LevelId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys Dungeon
dungeon))
(FactionDict -> [FactionId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys FactionDict
factionD)
sampleTrunks :: MonadServerAtomic m => Dungeon -> m GenerationAnalytics
sampleTrunks :: Dungeon -> m GenerationAnalytics
sampleTrunks dungeon :: Dungeon
dungeon = do
COps{ContentData CaveKind
cocave :: COps -> ContentData CaveKind
cocave :: ContentData CaveKind
cocave, ContentData ItemKind
coitem :: ContentData ItemKind
coitem :: COps -> ContentData ItemKind
coitem} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
let getGroups :: Level -> [GroupName ItemKind]
getGroups Level{ContentId CaveKind
lkind :: Level -> ContentId CaveKind
lkind :: ContentId CaveKind
lkind} = ((GroupName ItemKind, Int) -> GroupName ItemKind)
-> [(GroupName ItemKind, Int)] -> [GroupName ItemKind]
forall a b. (a -> b) -> [a] -> [b]
map (GroupName ItemKind, Int) -> GroupName ItemKind
forall a b. (a, b) -> a
fst ([(GroupName ItemKind, Int)] -> [GroupName ItemKind])
-> [(GroupName ItemKind, Int)] -> [GroupName ItemKind]
forall a b. (a -> b) -> a -> b
$ CaveKind -> [(GroupName ItemKind, Int)]
CK.cactorFreq (CaveKind -> [(GroupName ItemKind, Int)])
-> CaveKind -> [(GroupName ItemKind, Int)]
forall a b. (a -> b) -> a -> b
$ ContentData CaveKind -> ContentId CaveKind -> CaveKind
forall a. ContentData a -> ContentId a -> a
okind ContentData CaveKind
cocave ContentId CaveKind
lkind
groups :: [GroupName ItemKind]
groups = Set (GroupName ItemKind) -> [GroupName ItemKind]
forall a. Set a -> [a]
S.elems (Set (GroupName ItemKind) -> [GroupName ItemKind])
-> Set (GroupName ItemKind) -> [GroupName ItemKind]
forall a b. (a -> b) -> a -> b
$ [GroupName ItemKind] -> Set (GroupName ItemKind)
forall a. Ord a => [a] -> Set a
S.fromList ([GroupName ItemKind] -> Set (GroupName ItemKind))
-> [GroupName ItemKind] -> Set (GroupName ItemKind)
forall a b. (a -> b) -> a -> b
$ (Level -> [GroupName ItemKind]) -> [Level] -> [GroupName ItemKind]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Level -> [GroupName ItemKind]
getGroups ([Level] -> [GroupName ItemKind])
-> [Level] -> [GroupName ItemKind]
forall a b. (a -> b) -> a -> b
$ Dungeon -> [Level]
forall k a. EnumMap k a -> [a]
EM.elems Dungeon
dungeon
addGroupToSet :: UniqueSet -> GroupName ItemKind -> UniqueSet
addGroupToSet !UniqueSet
s0 !GroupName ItemKind
grp =
ContentData ItemKind
-> GroupName ItemKind
-> (UniqueSet
-> Int -> ContentId ItemKind -> ItemKind -> UniqueSet)
-> UniqueSet
-> UniqueSet
forall a b.
ContentData a
-> GroupName a -> (b -> Int -> ContentId a -> a -> b) -> b -> b
ofoldlGroup' ContentData ItemKind
coitem GroupName ItemKind
grp (\s :: UniqueSet
s _ ik :: ContentId ItemKind
ik _ -> ContentId ItemKind -> UniqueSet -> UniqueSet
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.insert ContentId ItemKind
ik UniqueSet
s) UniqueSet
s0
trunkKindIds :: [ContentId ItemKind]
trunkKindIds = UniqueSet -> [ContentId ItemKind]
forall k. Enum k => EnumSet k -> [k]
ES.elems (UniqueSet -> [ContentId ItemKind])
-> UniqueSet -> [ContentId ItemKind]
forall a b. (a -> b) -> a -> b
$ (UniqueSet -> GroupName ItemKind -> UniqueSet)
-> UniqueSet -> [GroupName ItemKind] -> UniqueSet
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' UniqueSet -> GroupName ItemKind -> UniqueSet
addGroupToSet UniqueSet
forall k. EnumSet k
ES.empty [GroupName ItemKind]
groups
minLid :: LevelId
minLid = (LevelId, Level) -> LevelId
forall a b. (a, b) -> a
fst ((LevelId, Level) -> LevelId) -> (LevelId, Level) -> LevelId
forall a b. (a -> b) -> a -> b
$ ((LevelId, Level) -> (LevelId, Level) -> Ordering)
-> [(LevelId, Level)] -> (LevelId, Level)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (((LevelId, Level) -> AbsDepth)
-> (LevelId, Level) -> (LevelId, Level) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Level -> AbsDepth
ldepth (Level -> AbsDepth)
-> ((LevelId, Level) -> Level) -> (LevelId, Level) -> AbsDepth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LevelId, Level) -> Level
forall a b. (a, b) -> b
snd))
([(LevelId, Level)] -> (LevelId, Level))
-> [(LevelId, Level)] -> (LevelId, Level)
forall a b. (a -> b) -> a -> b
$ Dungeon -> [(LevelId, Level)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs Dungeon
dungeon
regItem :: ContentId ItemKind -> m (Maybe ItemId)
regItem itemKindId :: ContentId ItemKind
itemKindId = do
let itemKind :: ItemKind
itemKind = ContentData ItemKind -> ContentId ItemKind -> ItemKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ItemKind
coitem ContentId ItemKind
itemKindId
freq :: Frequency (ContentId ItemKind, ItemKind)
freq = (ContentId ItemKind, ItemKind)
-> Frequency (ContentId ItemKind, ItemKind)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ContentId ItemKind
itemKindId, ItemKind
itemKind)
case ItemKind -> FactionDict -> [(FactionId, Faction)]
possibleActorFactions ItemKind
itemKind FactionDict
factionD of
[] -> Maybe ItemId -> m (Maybe ItemId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ItemId
forall a. Maybe a
Nothing
(fid :: FactionId
fid, _) : _ -> do
let c :: Container
c = FactionId -> LevelId -> Point -> Container
CTrunk FactionId
fid LevelId
minLid Point
originPoint
jfid :: Maybe FactionId
jfid = FactionId -> Maybe FactionId
forall a. a -> Maybe a
Just FactionId
fid
Maybe (ItemKnown, ItemFullKit)
m2 <- Frequency (ContentId ItemKind, ItemKind)
-> LevelId -> m (Maybe (ItemKnown, ItemFullKit))
forall (m :: * -> *).
MonadServerAtomic m =>
Frequency (ContentId ItemKind, ItemKind)
-> LevelId -> m (Maybe (ItemKnown, ItemFullKit))
rollItemAspect Frequency (ContentId ItemKind, ItemKind)
freq LevelId
minLid
case Maybe (ItemKnown, ItemFullKit)
m2 of
Nothing -> [Char] -> m (Maybe ItemId)
forall a. HasCallStack => [Char] -> a
error "sampleTrunks: can't create actor trunk"
Just (ItemKnown kindIx :: ItemIdentity
kindIx ar :: AspectRecord
ar _, (itemFullRaw :: ItemFull
itemFullRaw, kit :: ItemQuant
kit)) -> do
let itemKnown :: ItemKnown
itemKnown = ItemIdentity -> AspectRecord -> Maybe FactionId -> ItemKnown
ItemKnown ItemIdentity
kindIx AspectRecord
ar Maybe FactionId
jfid
itemFull :: ItemFull
itemFull =
ItemFull
itemFullRaw {itemBase :: Item
itemBase = (ItemFull -> Item
itemBase ItemFull
itemFullRaw) {Maybe FactionId
jfid :: Maybe FactionId
jfid :: Maybe FactionId
jfid}}
ItemId -> Maybe ItemId
forall a. a -> Maybe a
Just (ItemId -> Maybe ItemId) -> m ItemId -> m (Maybe ItemId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ItemFullKit -> ItemKnown -> Container -> Bool -> m ItemId
forall (m :: * -> *).
MonadServerAtomic m =>
ItemFullKit -> ItemKnown -> Container -> Bool -> m ItemId
registerItem (ItemFull
itemFull, ItemQuant
kit) ItemKnown
itemKnown Container
c Bool
False
[Maybe ItemId]
miids <- (ContentId ItemKind -> m (Maybe ItemId))
-> [ContentId ItemKind] -> m [Maybe ItemId]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ContentId ItemKind -> m (Maybe ItemId)
regItem [ContentId ItemKind]
trunkKindIds
GenerationAnalytics -> m GenerationAnalytics
forall (m :: * -> *) a. Monad m => a -> m a
return (GenerationAnalytics -> m GenerationAnalytics)
-> GenerationAnalytics -> m GenerationAnalytics
forall a b. (a -> b) -> a -> b
$! SLore -> EnumMap ItemId Int -> GenerationAnalytics
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton SLore
STrunk
(EnumMap ItemId Int -> GenerationAnalytics)
-> EnumMap ItemId Int -> GenerationAnalytics
forall a b. (a -> b) -> a -> b
$ [(ItemId, Int)] -> EnumMap ItemId Int
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromAscList ([(ItemId, Int)] -> EnumMap ItemId Int)
-> [(ItemId, Int)] -> EnumMap ItemId Int
forall a b. (a -> b) -> a -> b
$ [ItemId] -> [Int] -> [(ItemId, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Maybe ItemId] -> [ItemId]
forall a. [Maybe a] -> [a]
catMaybes [Maybe ItemId]
miids) ([Int] -> [(ItemId, Int)]) -> [Int] -> [(ItemId, Int)]
forall a b. (a -> b) -> a -> b
$ Int -> [Int]
forall a. a -> [a]
repeat 0
sampleItems :: MonadServerAtomic m => Dungeon -> m GenerationAnalytics
sampleItems :: Dungeon -> m GenerationAnalytics
sampleItems dungeon :: Dungeon
dungeon = do
COps{ContentData CaveKind
cocave :: ContentData CaveKind
cocave :: COps -> ContentData CaveKind
cocave, ContentData ItemKind
coitem :: ContentData ItemKind
coitem :: COps -> ContentData ItemKind
coitem} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
let getGroups :: Level -> [GroupName ItemKind]
getGroups Level{ContentId CaveKind
lkind :: ContentId CaveKind
lkind :: Level -> ContentId CaveKind
lkind} = ((GroupName ItemKind, Int) -> GroupName ItemKind)
-> [(GroupName ItemKind, Int)] -> [GroupName ItemKind]
forall a b. (a -> b) -> [a] -> [b]
map (GroupName ItemKind, Int) -> GroupName ItemKind
forall a b. (a, b) -> a
fst ([(GroupName ItemKind, Int)] -> [GroupName ItemKind])
-> [(GroupName ItemKind, Int)] -> [GroupName ItemKind]
forall a b. (a -> b) -> a -> b
$ CaveKind -> [(GroupName ItemKind, Int)]
CK.citemFreq (CaveKind -> [(GroupName ItemKind, Int)])
-> CaveKind -> [(GroupName ItemKind, Int)]
forall a b. (a -> b) -> a -> b
$ ContentData CaveKind -> ContentId CaveKind -> CaveKind
forall a. ContentData a -> ContentId a -> a
okind ContentData CaveKind
cocave ContentId CaveKind
lkind
groups :: [GroupName ItemKind]
groups = Set (GroupName ItemKind) -> [GroupName ItemKind]
forall a. Set a -> [a]
S.elems (Set (GroupName ItemKind) -> [GroupName ItemKind])
-> Set (GroupName ItemKind) -> [GroupName ItemKind]
forall a b. (a -> b) -> a -> b
$ [GroupName ItemKind] -> Set (GroupName ItemKind)
forall a. Ord a => [a] -> Set a
S.fromList ([GroupName ItemKind] -> Set (GroupName ItemKind))
-> [GroupName ItemKind] -> Set (GroupName ItemKind)
forall a b. (a -> b) -> a -> b
$ (Level -> [GroupName ItemKind]) -> [Level] -> [GroupName ItemKind]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Level -> [GroupName ItemKind]
getGroups ([Level] -> [GroupName ItemKind])
-> [Level] -> [GroupName ItemKind]
forall a b. (a -> b) -> a -> b
$ Dungeon -> [Level]
forall k a. EnumMap k a -> [a]
EM.elems Dungeon
dungeon
addGroupToSet :: UniqueSet -> GroupName ItemKind -> UniqueSet
addGroupToSet !UniqueSet
s0 !GroupName ItemKind
grp =
ContentData ItemKind
-> GroupName ItemKind
-> (UniqueSet
-> Int -> ContentId ItemKind -> ItemKind -> UniqueSet)
-> UniqueSet
-> UniqueSet
forall a b.
ContentData a
-> GroupName a -> (b -> Int -> ContentId a -> a -> b) -> b -> b
ofoldlGroup' ContentData ItemKind
coitem GroupName ItemKind
grp (\s :: UniqueSet
s _ ik :: ContentId ItemKind
ik _ -> ContentId ItemKind -> UniqueSet -> UniqueSet
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.insert ContentId ItemKind
ik UniqueSet
s) UniqueSet
s0
itemKindIds :: [ContentId ItemKind]
itemKindIds = UniqueSet -> [ContentId ItemKind]
forall k. Enum k => EnumSet k -> [k]
ES.elems (UniqueSet -> [ContentId ItemKind])
-> UniqueSet -> [ContentId ItemKind]
forall a b. (a -> b) -> a -> b
$ (UniqueSet -> GroupName ItemKind -> UniqueSet)
-> UniqueSet -> [GroupName ItemKind] -> UniqueSet
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' UniqueSet -> GroupName ItemKind -> UniqueSet
addGroupToSet UniqueSet
forall k. EnumSet k
ES.empty [GroupName ItemKind]
groups
minLid :: LevelId
minLid = (LevelId, Level) -> LevelId
forall a b. (a, b) -> a
fst ((LevelId, Level) -> LevelId) -> (LevelId, Level) -> LevelId
forall a b. (a -> b) -> a -> b
$ ((LevelId, Level) -> (LevelId, Level) -> Ordering)
-> [(LevelId, Level)] -> (LevelId, Level)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (((LevelId, Level) -> AbsDepth)
-> (LevelId, Level) -> (LevelId, Level) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Level -> AbsDepth
ldepth (Level -> AbsDepth)
-> ((LevelId, Level) -> Level) -> (LevelId, Level) -> AbsDepth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LevelId, Level) -> Level
forall a b. (a, b) -> b
snd))
([(LevelId, Level)] -> (LevelId, Level))
-> [(LevelId, Level)] -> (LevelId, Level)
forall a b. (a -> b) -> a -> b
$ Dungeon -> [(LevelId, Level)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs Dungeon
dungeon
regItem :: ContentId ItemKind -> m (Maybe ItemId)
regItem itemKindId :: ContentId ItemKind
itemKindId = do
let itemKind :: ItemKind
itemKind = ContentData ItemKind -> ContentId ItemKind -> ItemKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ItemKind
coitem ContentId ItemKind
itemKindId
freq :: Frequency (ContentId ItemKind, ItemKind)
freq = (ContentId ItemKind, ItemKind)
-> Frequency (ContentId ItemKind, ItemKind)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ContentId ItemKind
itemKindId, ItemKind
itemKind)
c :: Container
c = LevelId -> Point -> Container
CFloor LevelId
minLid Point
originPoint
Maybe (ItemKnown, ItemFullKit)
m2 <- Frequency (ContentId ItemKind, ItemKind)
-> LevelId -> m (Maybe (ItemKnown, ItemFullKit))
forall (m :: * -> *).
MonadServerAtomic m =>
Frequency (ContentId ItemKind, ItemKind)
-> LevelId -> m (Maybe (ItemKnown, ItemFullKit))
rollItemAspect Frequency (ContentId ItemKind, ItemKind)
freq LevelId
minLid
case Maybe (ItemKnown, ItemFullKit)
m2 of
Nothing -> [Char] -> m (Maybe ItemId)
forall a. HasCallStack => [Char] -> a
error "sampleItems: can't create sample item"
Just (itemKnown :: ItemKnown
itemKnown, (itemFull :: ItemFull
itemFull, _kit :: ItemQuant
_kit)) ->
ItemId -> Maybe ItemId
forall a. a -> Maybe a
Just (ItemId -> Maybe ItemId) -> m ItemId -> m (Maybe ItemId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ItemFullKit -> ItemKnown -> Container -> Bool -> m ItemId
forall (m :: * -> *).
MonadServerAtomic m =>
ItemFullKit -> ItemKnown -> Container -> Bool -> m ItemId
registerItem (ItemFull
itemFull, (0, [])) ItemKnown
itemKnown Container
c Bool
False
[Maybe ItemId]
miids <- (ContentId ItemKind -> m (Maybe ItemId))
-> [ContentId ItemKind] -> m [Maybe ItemId]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ContentId ItemKind -> m (Maybe ItemId)
regItem [ContentId ItemKind]
itemKindIds
GenerationAnalytics -> m GenerationAnalytics
forall (m :: * -> *) a. Monad m => a -> m a
return (GenerationAnalytics -> m GenerationAnalytics)
-> GenerationAnalytics -> m GenerationAnalytics
forall a b. (a -> b) -> a -> b
$! SLore -> EnumMap ItemId Int -> GenerationAnalytics
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton SLore
SItem
(EnumMap ItemId Int -> GenerationAnalytics)
-> EnumMap ItemId Int -> GenerationAnalytics
forall a b. (a -> b) -> a -> b
$ [(ItemId, Int)] -> EnumMap ItemId Int
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromAscList ([(ItemId, Int)] -> EnumMap ItemId Int)
-> [(ItemId, Int)] -> EnumMap ItemId Int
forall a b. (a -> b) -> a -> b
$ [ItemId] -> [Int] -> [(ItemId, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Maybe ItemId] -> [ItemId]
forall a. [Maybe a] -> [a]
catMaybes [Maybe ItemId]
miids) ([Int] -> [(ItemId, Int)]) -> [Int] -> [(ItemId, Int)]
forall a b. (a -> b) -> a -> b
$ Int -> [Int]
forall a. a -> [a]
repeat 0
mapFromFuns :: Ord b => [a] -> [a -> b] -> M.Map b a
mapFromFuns :: [a] -> [a -> b] -> Map b a
mapFromFuns domain :: [a]
domain =
let fromFun :: (a -> b) -> Map b a -> Map b a
fromFun f :: a -> b
f m1 :: Map b a
m1 =
let invAssocs :: [(b, a)]
invAssocs = (a -> (b, a)) -> [a] -> [(b, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\c :: a
c -> (a -> b
f a
c, a
c)) [a]
domain
m2 :: Map b a
m2 = [(b, a)] -> Map b a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(b, a)]
invAssocs
in Map b a
m2 Map b a -> Map b a -> Map b a
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map b a
m1
in ((a -> b) -> Map b a -> Map b a) -> Map b a -> [a -> b] -> Map b a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a -> b) -> Map b a -> Map b a
fromFun Map b a
forall k a. Map k a
M.empty
resetFactions :: FactionDict -> ContentId ModeKind -> Int -> Dice.AbsDepth
-> Roster
-> Rnd FactionDict
resetFactions :: FactionDict
-> ContentId ModeKind
-> Int
-> AbsDepth
-> Roster
-> Rnd FactionDict
resetFactions factionDold :: FactionDict
factionDold gameModeIdOld :: ContentId ModeKind
gameModeIdOld curDiffSerOld :: Int
curDiffSerOld totalDepth :: AbsDepth
totalDepth players :: Roster
players = do
let rawCreate :: (Player, [(Int, Dice, GroupName ItemKind)])
-> StateT StdGen Identity Faction
rawCreate (gplayer :: Player
gplayer@Player{..}, initialActors :: [(Int, Dice, GroupName ItemKind)]
initialActors) = do
let castInitialActors :: (Int, Dice, GroupName ItemKind)
-> StateT StdGen Identity (Int, Int, GroupName ItemKind)
castInitialActors (ln :: Int
ln, d :: Dice
d, actorGroup :: GroupName ItemKind
actorGroup) = do
Int
n <- AbsDepth -> AbsDepth -> Dice -> Rnd Int
castDice (Int -> AbsDepth
Dice.AbsDepth (Int -> AbsDepth) -> Int -> AbsDepth
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Num a => a -> a
abs Int
ln) AbsDepth
totalDepth Dice
d
(Int, Int, GroupName ItemKind)
-> StateT StdGen Identity (Int, Int, GroupName ItemKind)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
ln, Int
n, GroupName ItemKind
actorGroup)
[(Int, Int, GroupName ItemKind)]
ginitial <- ((Int, Dice, GroupName ItemKind)
-> StateT StdGen Identity (Int, Int, GroupName ItemKind))
-> [(Int, Dice, GroupName ItemKind)]
-> StateT StdGen Identity [(Int, Int, GroupName ItemKind)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int, Dice, GroupName ItemKind)
-> StateT StdGen Identity (Int, Int, GroupName ItemKind)
castInitialActors [(Int, Dice, GroupName ItemKind)]
initialActors
let cmap :: Map Text Color
cmap =
[Color] -> [Color -> Text] -> Map Text Color
forall b a. Ord b => [a] -> [a -> b] -> Map b a
mapFromFuns [Color]
Color.legalFgCol
[Color -> Text
colorToTeamName, Color -> Text
colorToPlainName, Color -> Text
colorToFancyName]
colorName :: Text
colorName = Text -> Text
T.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. [a] -> a
head ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words Text
fname
prefix :: Text
prefix = case LeaderMode
fleaderMode of
LeaderNull -> "Loose"
LeaderAI _ -> "Autonomous"
LeaderUI _ -> "Controlled"
gnameNew :: Text
gnameNew = Text
prefix Text -> Text -> Text
<+> if Bool
fhasGender
then [Part] -> Text
makePhrase [Part -> Part
MU.Ws (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text Text
fname]
else Text
fname
gcolor :: Color
gcolor = Color -> Text -> Map Text Color -> Color
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Color
Color.BrWhite Text
colorName Map Text Color
cmap
gvictimsDnew :: EnumMap
(ContentId ModeKind) (IntMap (EnumMap (ContentId ItemKind) Int))
gvictimsDnew = case (Faction -> Bool) -> [Faction] -> Maybe Faction
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\fact :: Faction
fact -> Faction -> Text
gname Faction
fact Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
gnameNew)
([Faction] -> Maybe Faction) -> [Faction] -> Maybe Faction
forall a b. (a -> b) -> a -> b
$ FactionDict -> [Faction]
forall k a. EnumMap k a -> [a]
EM.elems FactionDict
factionDold of
Nothing -> EnumMap
(ContentId ModeKind) (IntMap (EnumMap (ContentId ItemKind) Int))
forall k a. EnumMap k a
EM.empty
Just fact :: Faction
fact ->
let sing :: IntMap (EnumMap (ContentId ItemKind) Int)
sing = Int
-> EnumMap (ContentId ItemKind) Int
-> IntMap (EnumMap (ContentId ItemKind) Int)
forall a. Int -> a -> IntMap a
IM.singleton Int
curDiffSerOld (Faction -> EnumMap (ContentId ItemKind) Int
gvictims Faction
fact)
f :: IntMap (EnumMap k Int)
-> IntMap (EnumMap k Int) -> IntMap (EnumMap k Int)
f = (EnumMap k Int -> EnumMap k Int -> EnumMap k Int)
-> IntMap (EnumMap k Int)
-> IntMap (EnumMap k Int)
-> IntMap (EnumMap k Int)
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IM.unionWith ((Int -> Int -> Int)
-> EnumMap k Int -> EnumMap k Int -> EnumMap k Int
forall a k.
(a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
EM.unionWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+))
in (IntMap (EnumMap (ContentId ItemKind) Int)
-> IntMap (EnumMap (ContentId ItemKind) Int)
-> IntMap (EnumMap (ContentId ItemKind) Int))
-> ContentId ModeKind
-> IntMap (EnumMap (ContentId ItemKind) Int)
-> EnumMap
(ContentId ModeKind) (IntMap (EnumMap (ContentId ItemKind) Int))
-> EnumMap
(ContentId ModeKind) (IntMap (EnumMap (ContentId ItemKind) Int))
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith IntMap (EnumMap (ContentId ItemKind) Int)
-> IntMap (EnumMap (ContentId ItemKind) Int)
-> IntMap (EnumMap (ContentId ItemKind) Int)
forall k.
IntMap (EnumMap k Int)
-> IntMap (EnumMap k Int) -> IntMap (EnumMap k Int)
f ContentId ModeKind
gameModeIdOld IntMap (EnumMap (ContentId ItemKind) Int)
sing (EnumMap
(ContentId ModeKind) (IntMap (EnumMap (ContentId ItemKind) Int))
-> EnumMap
(ContentId ModeKind) (IntMap (EnumMap (ContentId ItemKind) Int)))
-> EnumMap
(ContentId ModeKind) (IntMap (EnumMap (ContentId ItemKind) Int))
-> EnumMap
(ContentId ModeKind) (IntMap (EnumMap (ContentId ItemKind) Int))
forall a b. (a -> b) -> a -> b
$ Faction
-> EnumMap
(ContentId ModeKind) (IntMap (EnumMap (ContentId ItemKind) Int))
gvictimsD Faction
fact
let gname :: Text
gname = Text
gnameNew
gdipl :: EnumMap k a
gdipl = EnumMap k a
forall k a. EnumMap k a
EM.empty
gquit :: Maybe a
gquit = Maybe a
forall a. Maybe a
Nothing
_gleader :: Maybe a
_gleader = Maybe a
forall a. Maybe a
Nothing
gvictims :: EnumMap k a
gvictims = EnumMap k a
forall k a. EnumMap k a
EM.empty
gvictimsD :: EnumMap
(ContentId ModeKind) (IntMap (EnumMap (ContentId ItemKind) Int))
gvictimsD = EnumMap
(ContentId ModeKind) (IntMap (EnumMap (ContentId ItemKind) Int))
gvictimsDnew
gsha :: EnumMap k a
gsha = EnumMap k a
forall k a. EnumMap k a
EM.empty
Faction -> StateT StdGen Identity Faction
forall (m :: * -> *) a. Monad m => a -> m a
return (Faction -> StateT StdGen Identity Faction)
-> Faction -> StateT StdGen Identity Faction
forall a b. (a -> b) -> a -> b
$! $WFaction :: Text
-> Color
-> Player
-> [(Int, Int, GroupName ItemKind)]
-> EnumMap FactionId Diplomacy
-> Maybe Status
-> Maybe ActorId
-> EnumMap ItemId ItemQuant
-> EnumMap (ContentId ItemKind) Int
-> EnumMap
(ContentId ModeKind) (IntMap (EnumMap (ContentId ItemKind) Int))
-> Faction
Faction{..}
[Faction]
lUI <- ((Player, [(Int, Dice, GroupName ItemKind)])
-> StateT StdGen Identity Faction)
-> [(Player, [(Int, Dice, GroupName ItemKind)])]
-> StateT StdGen Identity [Faction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Player, [(Int, Dice, GroupName ItemKind)])
-> StateT StdGen Identity Faction
rawCreate ([(Player, [(Int, Dice, GroupName ItemKind)])]
-> StateT StdGen Identity [Faction])
-> [(Player, [(Int, Dice, GroupName ItemKind)])]
-> StateT StdGen Identity [Faction]
forall a b. (a -> b) -> a -> b
$ ((Player, [(Int, Dice, GroupName ItemKind)]) -> Bool)
-> [(Player, [(Int, Dice, GroupName ItemKind)])]
-> [(Player, [(Int, Dice, GroupName ItemKind)])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Player -> Bool
fhasUI (Player -> Bool)
-> ((Player, [(Int, Dice, GroupName ItemKind)]) -> Player)
-> (Player, [(Int, Dice, GroupName ItemKind)])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Player, [(Int, Dice, GroupName ItemKind)]) -> Player
forall a b. (a, b) -> a
fst) ([(Player, [(Int, Dice, GroupName ItemKind)])]
-> [(Player, [(Int, Dice, GroupName ItemKind)])])
-> [(Player, [(Int, Dice, GroupName ItemKind)])]
-> [(Player, [(Int, Dice, GroupName ItemKind)])]
forall a b. (a -> b) -> a -> b
$ Roster -> [(Player, [(Int, Dice, GroupName ItemKind)])]
rosterList Roster
players
let !_A :: ()
_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert ([Faction] -> Int
forall a. [a] -> Int
length [Faction]
lUI Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 1
Bool -> ([Char], [Faction]) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "currently, at most one faction may have a UI"
[Char] -> [Faction] -> ([Char], [Faction])
forall v. [Char] -> v -> ([Char], v)
`swith` [Faction]
lUI) ()
[Faction]
lnoUI <- ((Player, [(Int, Dice, GroupName ItemKind)])
-> StateT StdGen Identity Faction)
-> [(Player, [(Int, Dice, GroupName ItemKind)])]
-> StateT StdGen Identity [Faction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Player, [(Int, Dice, GroupName ItemKind)])
-> StateT StdGen Identity Faction
rawCreate ([(Player, [(Int, Dice, GroupName ItemKind)])]
-> StateT StdGen Identity [Faction])
-> [(Player, [(Int, Dice, GroupName ItemKind)])]
-> StateT StdGen Identity [Faction]
forall a b. (a -> b) -> a -> b
$ ((Player, [(Int, Dice, GroupName ItemKind)]) -> Bool)
-> [(Player, [(Int, Dice, GroupName ItemKind)])]
-> [(Player, [(Int, Dice, GroupName ItemKind)])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Player, [(Int, Dice, GroupName ItemKind)]) -> Bool)
-> (Player, [(Int, Dice, GroupName ItemKind)])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Player -> Bool
fhasUI (Player -> Bool)
-> ((Player, [(Int, Dice, GroupName ItemKind)]) -> Player)
-> (Player, [(Int, Dice, GroupName ItemKind)])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Player, [(Int, Dice, GroupName ItemKind)]) -> Player
forall a b. (a, b) -> a
fst) ([(Player, [(Int, Dice, GroupName ItemKind)])]
-> [(Player, [(Int, Dice, GroupName ItemKind)])])
-> [(Player, [(Int, Dice, GroupName ItemKind)])]
-> [(Player, [(Int, Dice, GroupName ItemKind)])]
forall a b. (a -> b) -> a -> b
$ Roster -> [(Player, [(Int, Dice, GroupName ItemKind)])]
rosterList Roster
players
let lFs :: [(FactionId, Faction)]
lFs = [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. [a] -> [a]
reverse ([FactionId] -> [Faction] -> [(FactionId, Faction)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int -> FactionId
forall a. Enum a => Int -> a
toEnum (-1), Int -> FactionId
forall a. Enum a => Int -> a
toEnum (-2)..] [Faction]
lnoUI)
[(FactionId, Faction)]
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. [a] -> [a] -> [a]
++ [FactionId] -> [Faction] -> [(FactionId, Faction)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int -> FactionId
forall a. Enum a => Int -> a
toEnum 1..] [Faction]
lUI
swapIx :: [(Text, Text)] -> [(FactionId, FactionId)]
swapIx l :: [(Text, Text)]
l =
let findPlayerName :: Text -> t (a, Faction) -> Maybe (a, Faction)
findPlayerName name :: Text
name = ((a, Faction) -> Bool) -> t (a, Faction) -> Maybe (a, Faction)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==) (Text -> Bool) -> ((a, Faction) -> Text) -> (a, Faction) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Player -> Text
fname (Player -> Text)
-> ((a, Faction) -> Player) -> (a, Faction) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Faction -> Player
gplayer (Faction -> Player)
-> ((a, Faction) -> Faction) -> (a, Faction) -> Player
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Faction) -> Faction
forall a b. (a, b) -> b
snd)
f :: (Text, Text) -> (FactionId, FactionId)
f (name1 :: Text
name1, name2 :: Text
name2) =
case (Text -> [(FactionId, Faction)] -> Maybe (FactionId, Faction)
forall (t :: * -> *) a.
Foldable t =>
Text -> t (a, Faction) -> Maybe (a, Faction)
findPlayerName Text
name1 [(FactionId, Faction)]
lFs, Text -> [(FactionId, Faction)] -> Maybe (FactionId, Faction)
forall (t :: * -> *) a.
Foldable t =>
Text -> t (a, Faction) -> Maybe (a, Faction)
findPlayerName Text
name2 [(FactionId, Faction)]
lFs) of
(Just (ix1 :: FactionId
ix1, _), Just (ix2 :: FactionId
ix2, _)) -> (FactionId
ix1, FactionId
ix2)
_ -> [Char] -> (FactionId, FactionId)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (FactionId, FactionId))
-> [Char] -> (FactionId, FactionId)
forall a b. (a -> b) -> a -> b
$ "unknown faction"
[Char] -> ((Text, Text), [(FactionId, Faction)]) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` ((Text
name1, Text
name2), [(FactionId, Faction)]
lFs)
ixs :: [(FactionId, FactionId)]
ixs = ((Text, Text) -> (FactionId, FactionId))
-> [(Text, Text)] -> [(FactionId, FactionId)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> (FactionId, FactionId)
f [(Text, Text)]
l
in [(FactionId, FactionId)]
ixs [(FactionId, FactionId)]
-> [(FactionId, FactionId)] -> [(FactionId, FactionId)]
forall a. [a] -> [a] -> [a]
++ ((FactionId, FactionId) -> (FactionId, FactionId))
-> [(FactionId, FactionId)] -> [(FactionId, FactionId)]
forall a b. (a -> b) -> [a] -> [b]
map (FactionId, FactionId) -> (FactionId, FactionId)
forall a b. (a, b) -> (b, a)
swap [(FactionId, FactionId)]
ixs
mkDipl :: Diplomacy
-> EnumMap k Faction -> t (k, FactionId) -> EnumMap k Faction
mkDipl diplMode :: Diplomacy
diplMode =
let f :: (k, FactionId) -> EnumMap k Faction -> EnumMap k Faction
f (ix1 :: k
ix1, ix2 :: FactionId
ix2) =
let adj :: Faction -> Faction
adj fact :: Faction
fact = Faction
fact {gdipl :: EnumMap FactionId Diplomacy
gdipl = FactionId
-> Diplomacy
-> EnumMap FactionId Diplomacy
-> EnumMap FactionId Diplomacy
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert FactionId
ix2 Diplomacy
diplMode (Faction -> EnumMap FactionId Diplomacy
gdipl Faction
fact)}
in (Faction -> Faction) -> k -> EnumMap k Faction -> EnumMap k Faction
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust Faction -> Faction
adj k
ix1
in ((k, FactionId) -> EnumMap k Faction -> EnumMap k Faction)
-> EnumMap k Faction -> t (k, FactionId) -> EnumMap k Faction
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (k, FactionId) -> EnumMap k Faction -> EnumMap k Faction
f
rawFs :: FactionDict
rawFs = [(FactionId, Faction)] -> FactionDict
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromDistinctAscList [(FactionId, Faction)]
lFs
allianceFs :: FactionDict
allianceFs = Diplomacy -> FactionDict -> [(FactionId, FactionId)] -> FactionDict
forall k (t :: * -> *).
(Enum k, Foldable t) =>
Diplomacy
-> EnumMap k Faction -> t (k, FactionId) -> EnumMap k Faction
mkDipl Diplomacy
Alliance FactionDict
rawFs ([(Text, Text)] -> [(FactionId, FactionId)]
swapIx (Roster -> [(Text, Text)]
rosterAlly Roster
players))
warFs :: FactionDict
warFs = Diplomacy -> FactionDict -> [(FactionId, FactionId)] -> FactionDict
forall k (t :: * -> *).
(Enum k, Foldable t) =>
Diplomacy
-> EnumMap k Faction -> t (k, FactionId) -> EnumMap k Faction
mkDipl Diplomacy
War FactionDict
allianceFs ([(Text, Text)] -> [(FactionId, FactionId)]
swapIx (Roster -> [(Text, Text)]
rosterEnemy Roster
players))
FactionDict -> Rnd FactionDict
forall (m :: * -> *) a. Monad m => a -> m a
return (FactionDict -> Rnd FactionDict) -> FactionDict -> Rnd FactionDict
forall a b. (a -> b) -> a -> b
$! FactionDict
warFs
gameReset :: MonadServer m
=> ServerOptions -> Maybe (GroupName ModeKind)
-> Maybe R.StdGen -> m State
gameReset :: ServerOptions
-> Maybe (GroupName ModeKind) -> Maybe StdGen -> m State
gameReset serverOptions :: ServerOptions
serverOptions mGameMode :: Maybe (GroupName ModeKind)
mGameMode mrandom :: Maybe StdGen
mrandom = do
cops :: COps
cops@COps{ContentData ModeKind
comode :: COps -> ContentData ModeKind
comode :: ContentData ModeKind
comode} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
StdGen
dungeonSeed <- Maybe StdGen -> m StdGen
forall (m :: * -> *). MonadServer m => Maybe StdGen -> m StdGen
getSetGen (Maybe StdGen -> m StdGen) -> Maybe StdGen -> m StdGen
forall a b. (a -> b) -> a -> b
$ ServerOptions -> Maybe StdGen
sdungeonRng ServerOptions
serverOptions Maybe StdGen -> Maybe StdGen -> Maybe StdGen
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe StdGen
mrandom
StdGen
srandom <- Maybe StdGen -> m StdGen
forall (m :: * -> *). MonadServer m => Maybe StdGen -> m StdGen
getSetGen (Maybe StdGen -> m StdGen) -> Maybe StdGen -> m StdGen
forall a b. (a -> b) -> a -> b
$ ServerOptions -> Maybe StdGen
smainRng ServerOptions
serverOptions Maybe StdGen -> Maybe StdGen -> Maybe StdGen
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe StdGen
mrandom
let srngs :: RNGs
srngs = Maybe StdGen -> Maybe StdGen -> RNGs
RNGs (StdGen -> Maybe StdGen
forall a. a -> Maybe a
Just StdGen
dungeonSeed) (StdGen -> Maybe StdGen
forall a. a -> Maybe a
Just StdGen
srandom)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ServerOptions -> Bool
sdumpInitRngs ServerOptions
serverOptions) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ RNGs -> m ()
forall (m :: * -> *). MonadServer m => RNGs -> m ()
dumpRngs RNGs
srngs
ScoreDict
scoreTable <- COps -> m ScoreDict
forall (m :: * -> *). MonadServer m => COps -> m ScoreDict
restoreScore COps
cops
FactionDict
factionDold <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
ContentId ModeKind
gameModeIdOld <- (State -> ContentId ModeKind) -> m (ContentId ModeKind)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ContentId ModeKind
sgameModeId
Challenge
curChalSer <- (StateServer -> Challenge) -> m Challenge
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> Challenge) -> m Challenge)
-> (StateServer -> Challenge) -> m Challenge
forall a b. (a -> b) -> a -> b
$ ServerOptions -> Challenge
scurChalSer (ServerOptions -> Challenge)
-> (StateServer -> ServerOptions) -> StateServer -> Challenge
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ServerOptions
soptions
let startingModeGroup :: GroupName ModeKind
startingModeGroup = "insert coin"
gameMode :: GroupName ModeKind
gameMode = GroupName ModeKind
-> Maybe (GroupName ModeKind) -> GroupName ModeKind
forall a. a -> Maybe a -> a
fromMaybe GroupName ModeKind
startingModeGroup
(Maybe (GroupName ModeKind) -> GroupName ModeKind)
-> Maybe (GroupName ModeKind) -> GroupName ModeKind
forall a b. (a -> b) -> a -> b
$ Maybe (GroupName ModeKind)
mGameMode Maybe (GroupName ModeKind)
-> Maybe (GroupName ModeKind) -> Maybe (GroupName ModeKind)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` ServerOptions -> Maybe (GroupName ModeKind)
sgameMode ServerOptions
serverOptions
rnd :: Rnd (FactionDict, FlavourMap, DiscoveryKind, DiscoveryKindRev,
DungeonGen.FreshDungeon, ContentId ModeKind)
rnd :: Rnd
(FactionDict, FlavourMap, DiscoveryKind, DiscoveryKindRev,
FreshDungeon, ContentId ModeKind)
rnd = do
ContentId ModeKind
modeKindId <-
ContentId ModeKind
-> Maybe (ContentId ModeKind) -> ContentId ModeKind
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> ContentId ModeKind
forall a. HasCallStack => [Char] -> a
error ([Char] -> ContentId ModeKind) -> [Char] -> ContentId ModeKind
forall a b. (a -> b) -> a -> b
$ "Unknown game mode:" [Char] -> GroupName ModeKind -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` GroupName ModeKind
gameMode)
(Maybe (ContentId ModeKind) -> ContentId ModeKind)
-> StateT StdGen Identity (Maybe (ContentId ModeKind))
-> StateT StdGen Identity (ContentId ModeKind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ContentData ModeKind
-> GroupName ModeKind
-> (ModeKind -> Bool)
-> StateT StdGen Identity (Maybe (ContentId ModeKind))
forall a.
Show a =>
ContentData a
-> GroupName a -> (a -> Bool) -> Rnd (Maybe (ContentId a))
opick ContentData ModeKind
comode GroupName ModeKind
gameMode (Bool -> ModeKind -> Bool
forall a b. a -> b -> a
const Bool
True)
let mode :: ModeKind
mode = ContentData ModeKind -> ContentId ModeKind -> ModeKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ModeKind
comode ContentId ModeKind
modeKindId
automatePS :: Roster -> Roster
automatePS ps :: Roster
ps = Roster
ps {rosterList :: [(Player, [(Int, Dice, GroupName ItemKind)])]
rosterList =
((Player, [(Int, Dice, GroupName ItemKind)])
-> (Player, [(Int, Dice, GroupName ItemKind)]))
-> [(Player, [(Int, Dice, GroupName ItemKind)])]
-> [(Player, [(Int, Dice, GroupName ItemKind)])]
forall a b. (a -> b) -> [a] -> [b]
map ((Player -> Player)
-> (Player, [(Int, Dice, GroupName ItemKind)])
-> (Player, [(Int, Dice, GroupName ItemKind)])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((Player -> Player)
-> (Player, [(Int, Dice, GroupName ItemKind)])
-> (Player, [(Int, Dice, GroupName ItemKind)]))
-> (Player -> Player)
-> (Player, [(Int, Dice, GroupName ItemKind)])
-> (Player, [(Int, Dice, GroupName ItemKind)])
forall a b. (a -> b) -> a -> b
$ Bool -> Player -> Player
automatePlayer Bool
True) ([(Player, [(Int, Dice, GroupName ItemKind)])]
-> [(Player, [(Int, Dice, GroupName ItemKind)])])
-> [(Player, [(Int, Dice, GroupName ItemKind)])]
-> [(Player, [(Int, Dice, GroupName ItemKind)])]
forall a b. (a -> b) -> a -> b
$ Roster -> [(Player, [(Int, Dice, GroupName ItemKind)])]
rosterList Roster
ps}
players :: Roster
players = if ServerOptions -> Bool
sautomateAll ServerOptions
serverOptions
then Roster -> Roster
automatePS (Roster -> Roster) -> Roster -> Roster
forall a b. (a -> b) -> a -> b
$ ModeKind -> Roster
mroster ModeKind
mode
else ModeKind -> Roster
mroster ModeKind
mode
FlavourMap
sflavour <- COps -> Rnd FlavourMap
dungeonFlavourMap COps
cops
(discoKind :: DiscoveryKind
discoKind, sdiscoKindRev :: DiscoveryKindRev
sdiscoKindRev) <- COps -> Rnd (DiscoveryKind, DiscoveryKindRev)
serverDiscos COps
cops
FreshDungeon
freshDng <- COps -> ServerOptions -> Caves -> Rnd FreshDungeon
DungeonGen.dungeonGen COps
cops ServerOptions
serverOptions (Caves -> Rnd FreshDungeon) -> Caves -> Rnd FreshDungeon
forall a b. (a -> b) -> a -> b
$ ModeKind -> Caves
mcaves ModeKind
mode
FactionDict
factionD <- FactionDict
-> ContentId ModeKind
-> Int
-> AbsDepth
-> Roster
-> Rnd FactionDict
resetFactions FactionDict
factionDold ContentId ModeKind
gameModeIdOld
(Challenge -> Int
cdiff Challenge
curChalSer)
(FreshDungeon -> AbsDepth
DungeonGen.freshTotalDepth FreshDungeon
freshDng)
Roster
players
(FactionDict, FlavourMap, DiscoveryKind, DiscoveryKindRev,
FreshDungeon, ContentId ModeKind)
-> Rnd
(FactionDict, FlavourMap, DiscoveryKind, DiscoveryKindRev,
FreshDungeon, ContentId ModeKind)
forall (m :: * -> *) a. Monad m => a -> m a
return ( FactionDict
factionD, FlavourMap
sflavour, DiscoveryKind
discoKind
, DiscoveryKindRev
sdiscoKindRev, FreshDungeon
freshDng, ContentId ModeKind
modeKindId )
let ( factionD :: FactionDict
factionD, sflavour :: FlavourMap
sflavour, discoKind :: DiscoveryKind
discoKind
,sdiscoKindRev :: DiscoveryKindRev
sdiscoKindRev, DungeonGen.FreshDungeon{..}, modeKindId :: ContentId ModeKind
modeKindId ) =
Rnd
(FactionDict, FlavourMap, DiscoveryKind, DiscoveryKindRev,
FreshDungeon, ContentId ModeKind)
-> StdGen
-> (FactionDict, FlavourMap, DiscoveryKind, DiscoveryKindRev,
FreshDungeon, ContentId ModeKind)
forall s a. State s a -> s -> a
St.evalState Rnd
(FactionDict, FlavourMap, DiscoveryKind, DiscoveryKindRev,
FreshDungeon, ContentId ModeKind)
rnd StdGen
dungeonSeed
defState :: State
defState = Dungeon
-> AbsDepth
-> FactionDict
-> COps
-> ScoreDict
-> ContentId ModeKind
-> DiscoveryKind
-> State
defStateGlobal Dungeon
freshDungeon AbsDepth
freshTotalDepth
FactionDict
factionD COps
cops ScoreDict
scoreTable ContentId ModeKind
modeKindId DiscoveryKind
discoKind
defSer :: StateServer
defSer = StateServer
emptyStateServer { StdGen
srandom :: StdGen
srandom :: StdGen
srandom
, RNGs
srngs :: RNGs
srngs :: RNGs
srngs }
StateServer -> m ()
forall (m :: * -> *). MonadServer m => StateServer -> m ()
putServer StateServer
defSer
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser -> StateServer
ser {DiscoveryKindRev
sdiscoKindRev :: DiscoveryKindRev
sdiscoKindRev :: DiscoveryKindRev
sdiscoKindRev, FlavourMap
sflavour :: FlavourMap
sflavour :: FlavourMap
sflavour}
State -> m State
forall (m :: * -> *) a. Monad m => a -> m a
return (State -> m State) -> State -> m State
forall a b. (a -> b) -> a -> b
$! State
defState
populateDungeon :: MonadServerAtomic m => m ()
populateDungeon :: m ()
populateDungeon = do
cops :: COps
cops@COps{TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
Dungeon
dungeon <- (State -> Dungeon) -> m Dungeon
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Dungeon
sdungeon
FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
Challenge
curChalSer <- (StateServer -> Challenge) -> m Challenge
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> Challenge) -> m Challenge)
-> (StateServer -> Challenge) -> m Challenge
forall a b. (a -> b) -> a -> b
$ ServerOptions -> Challenge
scurChalSer (ServerOptions -> Challenge)
-> (StateServer -> ServerOptions) -> StateServer -> Challenge
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ServerOptions
soptions
let ginitialWolf :: Faction -> [(Int, Int, GroupName ItemKind)]
ginitialWolf fact1 :: Faction
fact1 = if Challenge -> Bool
cwolf Challenge
curChalSer Bool -> Bool -> Bool
&& Player -> Bool
fhasUI (Faction -> Player
gplayer Faction
fact1)
then case Faction -> [(Int, Int, GroupName ItemKind)]
ginitial Faction
fact1 of
[] -> []
(ln :: Int
ln, _, grp :: GroupName ItemKind
grp) : _ -> [(Int
ln, 1, GroupName ItemKind
grp)]
else Faction -> [(Int, Int, GroupName ItemKind)]
ginitial Faction
fact1
(minD :: LevelId
minD, maxD :: LevelId
maxD) = Dungeon -> (LevelId, LevelId)
dungeonBounds Dungeon
dungeon
valuePlayer :: Player -> (Bool, Text)
valuePlayer pl :: Player
pl = (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Player -> Bool
fcanEscape Player
pl, Player -> Text
fname Player
pl)
needInitialCrew :: [(FactionId, Faction)]
needInitialCrew = ((FactionId, Faction) -> (Bool, Text))
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Player -> (Bool, Text)
valuePlayer (Player -> (Bool, Text))
-> ((FactionId, Faction) -> Player)
-> (FactionId, Faction)
-> (Bool, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Faction -> Player
gplayer (Faction -> Player)
-> ((FactionId, Faction) -> Faction)
-> (FactionId, Faction)
-> Player
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionId, Faction) -> Faction
forall a b. (a, b) -> b
snd)
([(FactionId, Faction)] -> [(FactionId, Faction)])
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a b. (a -> b) -> a -> b
$ ((FactionId, Faction) -> Bool)
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((FactionId, Faction) -> Bool) -> (FactionId, Faction) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Int, GroupName ItemKind)] -> Bool
forall a. [a] -> Bool
null ([(Int, Int, GroupName ItemKind)] -> Bool)
-> ((FactionId, Faction) -> [(Int, Int, GroupName ItemKind)])
-> (FactionId, Faction)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Faction -> [(Int, Int, GroupName ItemKind)]
ginitialWolf (Faction -> [(Int, Int, GroupName ItemKind)])
-> ((FactionId, Faction) -> Faction)
-> (FactionId, Faction)
-> [(Int, Int, GroupName ItemKind)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionId, Faction) -> Faction
forall a b. (a, b) -> b
snd)
([(FactionId, Faction)] -> [(FactionId, Faction)])
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a b. (a -> b) -> a -> b
$ FactionDict -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs FactionDict
factionD
boundLid :: (Int, Int, GroupName ItemKind) -> LevelId
boundLid (ln :: Int
ln, _, _) = LevelId -> LevelId -> LevelId
forall a. Ord a => a -> a -> a
max LevelId
minD (LevelId -> LevelId) -> (Int -> LevelId) -> Int -> LevelId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LevelId -> LevelId -> LevelId
forall a. Ord a => a -> a -> a
min LevelId
maxD (LevelId -> LevelId) -> (Int -> LevelId) -> Int -> LevelId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> LevelId
forall a. Enum a => Int -> a
toEnum (Int -> LevelId) -> Int -> LevelId
forall a b. (a -> b) -> a -> b
$ Int
ln
getEntryLevels :: (FactionId, Faction) -> [LevelId]
getEntryLevels (_, fact :: Faction
fact) = ((Int, Int, GroupName ItemKind) -> LevelId)
-> [(Int, Int, GroupName ItemKind)] -> [LevelId]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int, GroupName ItemKind) -> LevelId
boundLid ([(Int, Int, GroupName ItemKind)] -> [LevelId])
-> [(Int, Int, GroupName ItemKind)] -> [LevelId]
forall a b. (a -> b) -> a -> b
$ Faction -> [(Int, Int, GroupName ItemKind)]
ginitialWolf Faction
fact
arenas :: [LevelId]
arenas = EnumSet LevelId -> [LevelId]
forall k. Enum k => EnumSet k -> [k]
ES.toList (EnumSet LevelId -> [LevelId]) -> EnumSet LevelId -> [LevelId]
forall a b. (a -> b) -> a -> b
$ [LevelId] -> EnumSet LevelId
forall k. Enum k => [k] -> EnumSet k
ES.fromList
([LevelId] -> EnumSet LevelId) -> [LevelId] -> EnumSet LevelId
forall a b. (a -> b) -> a -> b
$ ((FactionId, Faction) -> [LevelId])
-> [(FactionId, Faction)] -> [LevelId]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (FactionId, Faction) -> [LevelId]
getEntryLevels [(FactionId, Faction)]
needInitialCrew
hasActorsOnArena :: LevelId -> (FactionId, Faction) -> Bool
hasActorsOnArena lid :: LevelId
lid (_, fact :: Faction
fact) =
((Int, Int, GroupName ItemKind) -> Bool)
-> [(Int, Int, GroupName ItemKind)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lid) (LevelId -> Bool)
-> ((Int, Int, GroupName ItemKind) -> LevelId)
-> (Int, Int, GroupName ItemKind)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int, GroupName ItemKind) -> LevelId
boundLid) ([(Int, Int, GroupName ItemKind)] -> Bool)
-> [(Int, Int, GroupName ItemKind)] -> Bool
forall a b. (a -> b) -> a -> b
$ Faction -> [(Int, Int, GroupName ItemKind)]
ginitialWolf Faction
fact
initialActorPositions :: LevelId -> m (LevelId, [((FactionId, Faction), Point)])
initialActorPositions lid :: LevelId
lid = do
Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
let arenaFactions :: [(FactionId, Faction)]
arenaFactions = ((FactionId, Faction) -> Bool)
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. (a -> Bool) -> [a] -> [a]
filter (LevelId -> (FactionId, Faction) -> Bool
hasActorsOnArena LevelId
lid) [(FactionId, Faction)]
needInitialCrew
indexff :: (FactionId, Faction) -> Maybe Int
indexff (fid :: FactionId
fid, _) = ((FactionId, Faction) -> Bool)
-> [(FactionId, Faction)] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
fid) (FactionId -> Bool)
-> ((FactionId, Faction) -> FactionId)
-> (FactionId, Faction)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionId, Faction) -> FactionId
forall a b. (a, b) -> a
fst) [(FactionId, Faction)]
arenaFactions
representsAlliance :: (FactionId, Faction) -> Bool
representsAlliance ff2 :: (FactionId, Faction)
ff2@(fid2 :: FactionId
fid2, fact2 :: Faction
fact2) =
Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ((FactionId, Faction) -> Bool) -> [(FactionId, Faction)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\ff3 :: (FactionId, Faction)
ff3@(fid3 :: FactionId
fid3, _) ->
(FactionId, Faction) -> Maybe Int
indexff (FactionId, Faction)
ff3 Maybe Int -> Maybe Int -> Bool
forall a. Ord a => a -> a -> Bool
< (FactionId, Faction) -> Maybe Int
indexff (FactionId, Faction)
ff2
Bool -> Bool -> Bool
&& FactionId -> Faction -> FactionId -> Bool
isFriend FactionId
fid2 Faction
fact2 FactionId
fid3) [(FactionId, Faction)]
arenaFactions
arenaAlliances :: [(FactionId, Faction)]
arenaAlliances = ((FactionId, Faction) -> Bool)
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. (a -> Bool) -> [a] -> [a]
filter (FactionId, Faction) -> Bool
representsAlliance [(FactionId, Faction)]
arenaFactions
[Point]
entryPoss <- Rnd [Point] -> m [Point]
forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
rndToAction
(Rnd [Point] -> m [Point]) -> Rnd [Point] -> m [Point]
forall a b. (a -> b) -> a -> b
$ COps -> LevelId -> Level -> Int -> Rnd [Point]
findEntryPoss COps
cops LevelId
lid Level
lvl ([(FactionId, Faction)] -> Int
forall a. [a] -> Int
length [(FactionId, Faction)]
arenaAlliances)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Point] -> Int
forall a. [a] -> Int
length [Point]
entryPoss Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [(FactionId, Faction)] -> Int
forall a. [a] -> Int
length [(FactionId, Faction)]
arenaAlliances) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
Text -> m ()
forall (m :: * -> *). MonadServer m => Text -> m ()
debugPossiblyPrint
"Server: populateDungeon: failed to find enough alliance positions"
let usedPoss :: [((FactionId, Faction), Point)]
usedPoss = [(FactionId, Faction)]
-> [Point] -> [((FactionId, Faction), Point)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(FactionId, Faction)]
arenaAlliances [Point]
entryPoss
(LevelId, [((FactionId, Faction), Point)])
-> m (LevelId, [((FactionId, Faction), Point)])
forall (m :: * -> *) a. Monad m => a -> m a
return ((LevelId, [((FactionId, Faction), Point)])
-> m (LevelId, [((FactionId, Faction), Point)]))
-> (LevelId, [((FactionId, Faction), Point)])
-> m (LevelId, [((FactionId, Faction), Point)])
forall a b. (a -> b) -> a -> b
$! (LevelId
lid, [((FactionId, Faction), Point)]
usedPoss)
initialActors :: (LevelId, [((FactionId, Faction), Point)]) -> m ()
initialActors (lid :: LevelId
lid, usedPoss :: [((FactionId, Faction), Point)]
usedPoss) = do
let arenaFactions :: [(FactionId, Faction)]
arenaFactions = ((FactionId, Faction) -> Bool)
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. (a -> Bool) -> [a] -> [a]
filter (LevelId -> (FactionId, Faction) -> Bool
hasActorsOnArena LevelId
lid) [(FactionId, Faction)]
needInitialCrew
placeAlliance :: ((FactionId, Faction), Point) -> m ()
placeAlliance ((fid3 :: FactionId
fid3, _), ppos :: Point
ppos) =
((FactionId, Faction) -> m ()) -> [(FactionId, Faction)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(fid4 :: FactionId
fid4, fact4 :: Faction
fact4) ->
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FactionId -> Faction -> FactionId -> Bool
isFriend FactionId
fid4 Faction
fact4 FactionId
fid3) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
LevelId -> ((FactionId, Faction), Point) -> m ()
placeActors LevelId
lid ((FactionId
fid4, Faction
fact4), Point
ppos))
[(FactionId, Faction)]
arenaFactions
(((FactionId, Faction), Point) -> m ())
-> [((FactionId, Faction), Point)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((FactionId, Faction), Point) -> m ()
placeAlliance [((FactionId, Faction), Point)]
usedPoss
placeActors :: LevelId -> ((FactionId, Faction), Point) -> m ()
placeActors lid :: LevelId
lid ((fid3 :: FactionId
fid3, fact3 :: Faction
fact3), ppos :: Point
ppos) = do
Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
let validTile :: ContentId TileKind -> Bool
validTile t :: ContentId TileKind
t = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TileSpeedup -> ContentId TileKind -> Bool
Tile.isNoActor TileSpeedup
coTileSpeedup ContentId TileKind
t
initActors :: [(Int, Int, GroupName ItemKind)]
initActors = Faction -> [(Int, Int, GroupName ItemKind)]
ginitialWolf Faction
fact3
initGroups :: [GroupName ItemKind]
initGroups = [[GroupName ItemKind]] -> [GroupName ItemKind]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ Int -> GroupName ItemKind -> [GroupName ItemKind]
forall a. Int -> a -> [a]
replicate Int
n GroupName ItemKind
actorGroup
| ln3 :: (Int, Int, GroupName ItemKind)
ln3@(_, n :: Int
n, actorGroup :: GroupName ItemKind
actorGroup) <- [(Int, Int, GroupName ItemKind)]
initActors
, (Int, Int, GroupName ItemKind) -> LevelId
boundLid (Int, Int, GroupName ItemKind)
ln3 LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lid ]
psFree :: [Point]
psFree = COps -> Level -> (ContentId TileKind -> Bool) -> Point -> [Point]
nearbyFreePoints COps
cops Level
lvl ContentId TileKind -> Bool
validTile Point
ppos
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Point] -> Int
forall a. [a] -> Int
length [Point]
psFree Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [GroupName ItemKind] -> Int
forall a. [a] -> Int
length [GroupName ItemKind]
initGroups) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
Text -> m ()
forall (m :: * -> *). MonadServer m => Text -> m ()
debugPossiblyPrint
"Server: populateDungeon: failed to find enough actor positions"
let ps :: [(GroupName ItemKind, Point)]
ps = [GroupName ItemKind] -> [Point] -> [(GroupName ItemKind, Point)]
forall a b. [a] -> [b] -> [(a, b)]
zip [GroupName ItemKind]
initGroups [Point]
psFree
Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime LevelId
lid
[(GroupName ItemKind, Point)]
-> ((GroupName ItemKind, Point) -> m Bool) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(GroupName ItemKind, Point)]
ps (((GroupName ItemKind, Point) -> m Bool) -> m ())
-> ((GroupName ItemKind, Point) -> m Bool) -> m ()
forall a b. (a -> b) -> a -> b
$ \ (actorGroup :: GroupName ItemKind
actorGroup, p :: Point
p) -> do
Int
rndDelay <- Rnd Int -> m Int
forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
rndToAction (Rnd Int -> m Int) -> Rnd Int -> m Int
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Rnd Int
forall a. Random a => (a, a) -> Rnd a
randomR (0, Int
clipsInTurn Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
let delta :: Delta Time
delta = Delta Time -> Int -> Delta Time
timeDeltaScale (Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeClip) Int
rndDelay
rndTime :: Time
rndTime = Time -> Delta Time -> Time
timeShift Time
localTime Delta Time
delta
Maybe ActorId
maid <- GroupName ItemKind
-> FactionId -> Point -> LevelId -> Time -> m (Maybe ActorId)
forall (m :: * -> *).
MonadServerAtomic m =>
GroupName ItemKind
-> FactionId -> Point -> LevelId -> Time -> m (Maybe ActorId)
addActorFromGroup GroupName ItemKind
actorGroup FactionId
fid3 Point
p LevelId
lid Time
rndTime
case Maybe ActorId
maid of
Nothing -> [Char] -> m Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> m Bool) -> [Char] -> m Bool
forall a b. (a -> b) -> a -> b
$ "can't spawn initial actors"
[Char] -> (LevelId, (FactionId, Faction)) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (LevelId
lid, (FactionId
fid3, Faction
fact3))
Just aid :: ActorId
aid -> do
Maybe ActorId
mleader <- (State -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe ActorId) -> m (Maybe ActorId))
-> (State -> Maybe ActorId) -> m (Maybe ActorId)
forall a b. (a -> b) -> a -> b
$ Faction -> Maybe ActorId
gleader (Faction -> Maybe ActorId)
-> (State -> Faction) -> State -> Maybe ActorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid3) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ActorId -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ActorId
mleader) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> ActorId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> ActorId -> m ()
setFreshLeader FactionId
fid3 ActorId
aid
Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
[(LevelId, [((FactionId, Faction), Point)])]
lposs <- (LevelId -> m (LevelId, [((FactionId, Faction), Point)]))
-> [LevelId] -> m [(LevelId, [((FactionId, Faction), Point)])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LevelId -> m (LevelId, [((FactionId, Faction), Point)])
initialActorPositions [LevelId]
arenas
let alliancePositions :: EnumMap LevelId [Point]
alliancePositions = [(LevelId, [Point])] -> EnumMap LevelId [Point]
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromList ([(LevelId, [Point])] -> EnumMap LevelId [Point])
-> [(LevelId, [Point])] -> EnumMap LevelId [Point]
forall a b. (a -> b) -> a -> b
$ ((LevelId, [((FactionId, Faction), Point)]) -> (LevelId, [Point]))
-> [(LevelId, [((FactionId, Faction), Point)])]
-> [(LevelId, [Point])]
forall a b. (a -> b) -> [a] -> [b]
map (([((FactionId, Faction), Point)] -> [Point])
-> (LevelId, [((FactionId, Faction), Point)]) -> (LevelId, [Point])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (([((FactionId, Faction), Point)] -> [Point])
-> (LevelId, [((FactionId, Faction), Point)])
-> (LevelId, [Point]))
-> ([((FactionId, Faction), Point)] -> [Point])
-> (LevelId, [((FactionId, Faction), Point)])
-> (LevelId, [Point])
forall a b. (a -> b) -> a -> b
$ (((FactionId, Faction), Point) -> Point)
-> [((FactionId, Faction), Point)] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map ((FactionId, Faction), Point) -> Point
forall a b. (a, b) -> b
snd) [(LevelId, [((FactionId, Faction), Point)])]
lposs
EnumMap LevelId [Point] -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
EnumMap LevelId [Point] -> m ()
placeItemsInDungeon EnumMap LevelId [Point]
alliancePositions
m ()
forall (m :: * -> *). MonadServerAtomic m => m ()
embedItemsInDungeon
((LevelId, [((FactionId, Faction), Point)]) -> m ())
-> [(LevelId, [((FactionId, Faction), Point)])] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LevelId, [((FactionId, Faction), Point)]) -> m ()
initialActors [(LevelId, [((FactionId, Faction), Point)])]
lposs
findEntryPoss :: COps -> LevelId -> Level -> Int -> Rnd [Point]
findEntryPoss :: COps -> LevelId -> Level -> Int -> Rnd [Point]
findEntryPoss COps{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup}
lid :: LevelId
lid lvl :: Level
lvl@Level{Area
larea :: Level -> Area
larea :: Area
larea, ([Point], [Point])
lstair :: Level -> ([Point], [Point])
lstair :: ([Point], [Point])
lstair, [Point]
lescape :: Level -> [Point]
lescape :: [Point]
lescape} k :: Int
k = do
let (_, xspan :: Int
xspan, yspan :: Int
yspan) = Area -> (Point, Int, Int)
spanArea Area
larea
factionDist :: Int
factionDist = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
xspan Int
yspan Int -> Int -> Int
forall a. Num a => a -> a -> a
- 10
dist :: t Point -> Int -> Point -> p -> Bool
dist !t Point
poss !Int
cmin !Point
l _ = (Point -> Bool) -> t Point -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\ !Point
pos -> Point -> Point -> Int
chessDist Point
l Point
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
cmin) t Point
poss
tryFind :: [Point] -> Int -> Rnd [Point]
tryFind _ 0 = [Point] -> Rnd [Point]
forall (m :: * -> *) a. Monad m => a -> m a
return []
tryFind ![Point]
ps !Int
n = do
let ds :: [Point -> ContentId TileKind -> Bool]
ds = [ [Point] -> Int -> Point -> ContentId TileKind -> Bool
forall (t :: * -> *) p.
Foldable t =>
t Point -> Int -> Point -> p -> Bool
dist [Point]
ps Int
factionDist
, [Point] -> Int -> Point -> ContentId TileKind -> Bool
forall (t :: * -> *) p.
Foldable t =>
t Point -> Int -> Point -> p -> Bool
dist [Point]
ps (Int -> Point -> ContentId TileKind -> Bool)
-> Int -> Point -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
factionDist Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 3
, [Point] -> Int -> Point -> ContentId TileKind -> Bool
forall (t :: * -> *) p.
Foldable t =>
t Point -> Int -> Point -> p -> Bool
dist [Point]
ps (Int -> Point -> ContentId TileKind -> Bool)
-> Int -> Point -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ Int
factionDist Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2
, [Point] -> Int -> Point -> ContentId TileKind -> Bool
forall (t :: * -> *) p.
Foldable t =>
t Point -> Int -> Point -> p -> Bool
dist [Point]
ps (Int -> Point -> ContentId TileKind -> Bool)
-> Int -> Point -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ Int
factionDist Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 3
, [Point] -> Int -> Point -> ContentId TileKind -> Bool
forall (t :: * -> *) p.
Foldable t =>
t Point -> Int -> Point -> p -> Bool
dist [Point]
ps (Int -> Point -> ContentId TileKind -> Bool)
-> Int -> Point -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ Int
factionDist Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 4
, [Point] -> Int -> Point -> ContentId TileKind -> Bool
forall (t :: * -> *) p.
Foldable t =>
t Point -> Int -> Point -> p -> Bool
dist [Point]
ps (Int -> Point -> ContentId TileKind -> Bool)
-> Int -> Point -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ Int
factionDist Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 5
]
Maybe Point
mp <- Int
-> Level
-> (Point -> ContentId TileKind -> Bool)
-> [Point -> ContentId TileKind -> Bool]
-> (Point -> ContentId TileKind -> Bool)
-> [Point -> ContentId TileKind -> Bool]
-> Rnd (Maybe Point)
findPosTry2 500 Level
lvl
(\_ !ContentId TileKind
t -> TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup ContentId TileKind
t
Bool -> Bool -> Bool
&& Bool -> Bool
not (TileSpeedup -> ContentId TileKind -> Bool
Tile.isNoActor TileSpeedup
coTileSpeedup ContentId TileKind
t))
(Int
-> [Point -> ContentId TileKind -> Bool]
-> [Point -> ContentId TileKind -> Bool]
forall a. Int -> [a] -> [a]
take 2 [Point -> ContentId TileKind -> Bool]
ds)
(\_ !ContentId TileKind
t -> TileSpeedup -> ContentId TileKind -> Bool
Tile.isOftenActor TileSpeedup
coTileSpeedup ContentId TileKind
t)
[Point -> ContentId TileKind -> Bool]
ds
case Maybe Point
mp of
Just np :: Point
np -> do
[Point]
nps <- [Point] -> Int -> Rnd [Point]
tryFind (Point
np Point -> [Point] -> [Point]
forall a. a -> [a] -> [a]
: [Point]
ps) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
[Point] -> Rnd [Point]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Point] -> Rnd [Point]) -> [Point] -> Rnd [Point]
forall a b. (a -> b) -> a -> b
$! Point
np Point -> [Point] -> [Point]
forall a. a -> [a] -> [a]
: [Point]
nps
Nothing -> [Point] -> Rnd [Point]
forall (m :: * -> *) a. Monad m => a -> m a
return []
deeperStairs :: [Point]
deeperStairs = (if LevelId -> Int
forall a. Enum a => a -> Int
fromEnum LevelId
lid Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then ([Point], [Point]) -> [Point]
forall a b. (a, b) -> a
fst else ([Point], [Point]) -> [Point]
forall a b. (a, b) -> b
snd) ([Point], [Point])
lstair
let !_A :: ()
_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& Int
factionDist Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) ()
onStairs :: [Point]
onStairs = [Point] -> [Point]
forall a. [a] -> [a]
reverse ([Point] -> [Point]) -> [Point] -> [Point]
forall a b. (a -> b) -> a -> b
$ Int -> [Point] -> [Point]
forall a. Int -> [a] -> [a]
take Int
k ([Point] -> [Point]) -> [Point] -> [Point]
forall a b. (a -> b) -> a -> b
$ [Point]
lescape [Point] -> [Point] -> [Point]
forall a. [a] -> [a] -> [a]
++ [Point]
deeperStairs
nk :: Int
nk = Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Point] -> Int
forall a. [a] -> Int
length [Point]
onStairs
[Point]
found <- [Point] -> Int -> Rnd [Point]
tryFind (Area -> Point
middlePoint Area
larea Point -> [Point] -> [Point]
forall a. a -> [a] -> [a]
: [Point]
onStairs) Int
nk
[Point] -> Rnd [Point]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Point] -> Rnd [Point]) -> [Point] -> Rnd [Point]
forall a b. (a -> b) -> a -> b
$! [Point]
found [Point] -> [Point] -> [Point]
forall a. [a] -> [a] -> [a]
++ [Point]
onStairs
applyDebug :: MonadServer m => m ()
applyDebug :: m ()
applyDebug = do
ServerOptions{..} <- (StateServer -> ServerOptions) -> m ServerOptions
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> ServerOptions
soptionsNxt
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser ->
StateServer
ser {soptions :: ServerOptions
soptions = (StateServer -> ServerOptions
soptions StateServer
ser) { Bool
sniff :: Bool
sniff :: Bool
sniff
, Bool
sallClear :: Bool
sallClear :: Bool
sallClear
, Bool
sdbgMsgSer :: Bool
sdbgMsgSer :: Bool
sdbgMsgSer
, Bool
snewGameSer :: Bool
snewGameSer :: Bool
snewGameSer
, Bool
sdumpInitRngs :: Bool
sdumpInitRngs :: Bool
sdumpInitRngs
, ClientOptions
sclientOptions :: ClientOptions
sclientOptions :: ClientOptions
sclientOptions }}