module TieKnot
( tieKnotForAsync, tieKnot
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import Control.Concurrent
import Control.Concurrent.Async
import qualified Control.Exception as Ex
import qualified Data.Primitive.PrimArray as PA
import GHC.Compact
import qualified System.Random.SplitMix32 as SM
import Game.LambdaHack.Client
import qualified Game.LambdaHack.Client.UI.Content.Input as IC
import qualified Game.LambdaHack.Client.UI.Content.Screen as SC
import Game.LambdaHack.Client.UI.ContentClientUI
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.Point (speedupHackXSize)
import qualified Game.LambdaHack.Common.Tile as Tile
import qualified Game.LambdaHack.Content.CaveKind as CK
import qualified Game.LambdaHack.Content.FactionKind as FK
import qualified Game.LambdaHack.Content.ItemKind as IK
import qualified Game.LambdaHack.Content.ModeKind as MK
import qualified Game.LambdaHack.Content.PlaceKind as PK
import qualified Game.LambdaHack.Content.RuleKind as RK
import qualified Game.LambdaHack.Content.TileKind as TK
import Game.LambdaHack.Server
import qualified Client.UI.Content.Input as Content.Input
import qualified Client.UI.Content.Screen as Content.Screen
import qualified Content.CaveKind
import qualified Content.FactionKind
import qualified Content.ItemKind
import qualified Content.ModeKind
import qualified Content.PlaceKind
import qualified Content.RuleKind
import qualified Content.TileKind
import Implementation.MonadServerImplementation (executorSer)
tieKnotForAsync :: ServerOptions -> IO ()
tieKnotForAsync :: ServerOptions -> IO ()
tieKnotForAsync options :: ServerOptions
options@ServerOptions{ Bool
sallClear :: ServerOptions -> Bool
sallClear :: Bool
sallClear
, Bool
sboostRandomItem :: ServerOptions -> Bool
sboostRandomItem :: Bool
sboostRandomItem
, Maybe SMGen
sdungeonRng :: ServerOptions -> Maybe SMGen
sdungeonRng :: Maybe SMGen
sdungeonRng } = do
MutablePrimArray RealWorld X
speedupHackXSizeThawed <- PrimArray X -> IO (MutablePrimArray (PrimState IO) X)
forall (m :: * -> *) a.
PrimMonad m =>
PrimArray a -> m (MutablePrimArray (PrimState m) a)
PA.unsafeThawPrimArray PrimArray X
speedupHackXSize
MutablePrimArray (PrimState IO) X -> X -> X -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> X -> a -> m ()
PA.writePrimArray MutablePrimArray RealWorld X
MutablePrimArray (PrimState IO) X
speedupHackXSizeThawed X
0 (X -> IO ()) -> X -> IO ()
forall a b. (a -> b) -> a -> b
$
RuleContent -> X
RK.rWidthMax RuleContent
Content.RuleKind.standardRules
IO (PrimArray X) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (PrimArray X) -> IO ()) -> IO (PrimArray X) -> IO ()
forall a b. (a -> b) -> a -> b
$ MutablePrimArray (PrimState IO) X -> IO (PrimArray X)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
PA.unsafeFreezePrimArray MutablePrimArray RealWorld X
MutablePrimArray (PrimState IO) X
speedupHackXSizeThawed
SMGen
initialGen <- IO SMGen -> (SMGen -> IO SMGen) -> Maybe SMGen -> IO SMGen
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO SMGen
SM.newSMGen SMGen -> IO SMGen
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SMGen
sdungeonRng
let soptionsNxt :: ServerOptions
soptionsNxt = ServerOptions
options {sdungeonRng :: Maybe SMGen
sdungeonRng = SMGen -> Maybe SMGen
forall a. a -> Maybe a
Just SMGen
initialGen}
corule :: RuleContent
corule = RuleContent -> RuleContent
RK.makeData RuleContent
Content.RuleKind.standardRules
boostedItems :: [ItemKind]
boostedItems = SMGen -> [ItemKind] -> [ItemKind]
IK.boostItemKindList SMGen
initialGen [ItemKind]
Content.ItemKind.items
itemContent :: [ItemKind]
itemContent =
if Bool
sboostRandomItem
then [ItemKind]
boostedItems [ItemKind] -> [ItemKind] -> [ItemKind]
forall a. [a] -> [a] -> [a]
++ [ItemKind]
Content.ItemKind.otherItemContent
else [ItemKind]
Content.ItemKind.content
coitem :: ContentData ItemKind
coitem = ItemSymbolsUsedInEngine
-> [ItemKind]
-> [GroupName ItemKind]
-> [GroupName ItemKind]
-> ContentData ItemKind
IK.makeData (RuleContent -> ItemSymbolsUsedInEngine
RK.ritemSymbols RuleContent
corule)
[ItemKind]
itemContent
[GroupName ItemKind]
Content.ItemKind.groupNamesSingleton
[GroupName ItemKind]
Content.ItemKind.groupNames
cotile :: ContentData TileKind
cotile = [TileKind]
-> [GroupName TileKind]
-> [GroupName TileKind]
-> ContentData TileKind
TK.makeData [TileKind]
Content.TileKind.content
[GroupName TileKind]
Content.TileKind.groupNamesSingleton
[GroupName TileKind]
Content.TileKind.groupNames
cofact :: ContentData FactionKind
cofact = [FactionKind]
-> [GroupName FactionKind]
-> [GroupName FactionKind]
-> ContentData FactionKind
FK.makeData [FactionKind]
Content.FactionKind.content
[GroupName FactionKind]
Content.FactionKind.groupNamesSingleton
[GroupName FactionKind]
Content.FactionKind.groupNames
copsRaw :: COps
copsRaw = COps :: ContentData CaveKind
-> ContentData FactionKind
-> ContentData ItemKind
-> ContentData ModeKind
-> ContentData PlaceKind
-> RuleContent
-> ContentData TileKind
-> ItemSpeedup
-> TileSpeedup
-> COps
COps
{ cocave :: ContentData CaveKind
cocave = RuleContent
-> [CaveKind]
-> [GroupName CaveKind]
-> [GroupName CaveKind]
-> ContentData CaveKind
CK.makeData RuleContent
corule
[CaveKind]
Content.CaveKind.content
[GroupName CaveKind]
Content.CaveKind.groupNamesSingleton
[GroupName CaveKind]
Content.CaveKind.groupNames
, ContentData FactionKind
cofact :: ContentData FactionKind
cofact :: ContentData FactionKind
cofact
, ContentData ItemKind
coitem :: ContentData ItemKind
coitem :: ContentData ItemKind
coitem
, comode :: ContentData ModeKind
comode = ContentData FactionKind
-> [ModeKind]
-> [GroupName ModeKind]
-> [GroupName ModeKind]
-> ContentData ModeKind
MK.makeData ContentData FactionKind
cofact
[ModeKind]
Content.ModeKind.content
[GroupName ModeKind]
Content.ModeKind.groupNamesSingleton
[GroupName ModeKind]
Content.ModeKind.groupNames
, coplace :: ContentData PlaceKind
coplace = ContentData TileKind
-> [PlaceKind]
-> [GroupName PlaceKind]
-> [GroupName PlaceKind]
-> ContentData PlaceKind
PK.makeData ContentData TileKind
cotile
[PlaceKind]
Content.PlaceKind.content
[GroupName PlaceKind]
Content.PlaceKind.groupNamesSingleton
[GroupName PlaceKind]
Content.PlaceKind.groupNames
, RuleContent
corule :: RuleContent
corule :: RuleContent
corule
, ContentData TileKind
cotile :: ContentData TileKind
cotile :: ContentData TileKind
cotile
, coItemSpeedup :: ItemSpeedup
coItemSpeedup = ContentData ItemKind -> ItemSpeedup
speedupItem ContentData ItemKind
coitem
, coTileSpeedup :: TileSpeedup
coTileSpeedup = Bool -> ContentData TileKind -> TileSpeedup
Tile.speedupTile Bool
sallClear ContentData TileKind
cotile
}
#ifdef USE_JSFILE
let cops = copsRaw
#else
COps
cops <- Compact COps -> COps
forall a. Compact a -> a
getCompact (Compact COps -> COps) -> IO (Compact COps) -> IO COps
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> COps -> IO (Compact COps)
forall a. a -> IO (Compact a)
compact COps
copsRaw
#endif
UIOptions
sUIOptions <- RuleContent -> ClientOptions -> IO UIOptions
mkUIOptions RuleContent
corule (ServerOptions -> ClientOptions
sclientOptions ServerOptions
soptionsNxt)
let !ccui :: CCUI
ccui = CCUI :: InputContent -> ScreenContent -> CCUI
CCUI
{ coinput :: InputContent
coinput = Maybe UIOptions -> InputContentRaw -> InputContent
IC.makeData (UIOptions -> Maybe UIOptions
forall a. a -> Maybe a
Just UIOptions
sUIOptions)
InputContentRaw
Content.Input.standardKeysAndMouse
, coscreen :: ScreenContent
coscreen = RuleContent -> ScreenContent -> ScreenContent
SC.makeData RuleContent
corule ScreenContent
Content.Screen.standardLayoutAndFeatures
}
COps -> CCUI -> ServerOptions -> UIOptions -> IO ()
executorSer COps
cops CCUI
ccui ServerOptions
soptionsNxt UIOptions
sUIOptions
tieKnot :: ServerOptions -> IO ()
tieKnot :: ServerOptions -> IO ()
tieKnot ServerOptions
serverOptions = do
#ifdef USE_JSFILE
let serverOptionsJS = serverOptions {sdumpInitRngs = True}
a <- async $ tieKnotForAsync serverOptionsJS
wait a
#else
let fillWorkaround :: IO ()
fillWorkaround =
IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ MVar (IO ()) -> IO () -> IO Bool
forall a. MVar a -> a -> IO Bool
tryPutMVar MVar (IO ())
workaroundOnMainThreadMVar (IO () -> IO Bool) -> IO () -> IO Bool
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Async ()
a <- IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ ServerOptions -> IO ()
tieKnotForAsync ServerOptions
serverOptions
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`Ex.finally` IO ()
fillWorkaround
Async () -> IO ()
forall a. Async a -> IO ()
link Async ()
a
IO (IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (MVar (IO ()) -> IO (IO ())
forall a. MVar a -> IO a
takeMVar MVar (IO ())
workaroundOnMainThreadMVar)
Async () -> IO ()
forall a. Async a -> IO a
wait Async ()
a
IO (Maybe (IO ())) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe (IO ())) -> IO ()) -> IO (Maybe (IO ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ MVar (IO ()) -> IO (Maybe (IO ()))
forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar (IO ())
workaroundOnMainThreadMVar
#endif