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 as R
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.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.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 StdGen
sdungeonRng :: ServerOptions -> Maybe StdGen
sdungeonRng :: Maybe StdGen
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 0 (X -> IO ()) -> X -> IO ()
forall a b. (a -> b) -> a -> b
$
RuleContent -> X
RK.rXmax 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
StdGen
initialGen <- IO StdGen -> (StdGen -> IO StdGen) -> Maybe StdGen -> IO StdGen
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO StdGen
R.getStdGen StdGen -> IO StdGen
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe StdGen
sdungeonRng
let soptionsNxt :: ServerOptions
soptionsNxt = ServerOptions
options {sdungeonRng :: Maybe StdGen
sdungeonRng = StdGen -> Maybe StdGen
forall a. a -> Maybe a
Just StdGen
initialGen}
boostedItems :: [ItemKind]
boostedItems = StdGen -> [ItemKind] -> [ItemKind]
IK.boostItemKindList StdGen
initialGen [ItemKind]
Content.ItemKind.items
coitem :: ContentData ItemKind
coitem = [ItemKind] -> ContentData ItemKind
IK.makeData ([ItemKind] -> ContentData ItemKind)
-> [ItemKind] -> ContentData ItemKind
forall a b. (a -> b) -> a -> b
$
if Bool
sboostRandomItem
then [ItemKind]
boostedItems [ItemKind] -> [ItemKind] -> [ItemKind]
forall a. [a] -> [a] -> [a]
++ [ItemKind]
Content.ItemKind.otherItemContent
else [ItemKind]
Content.ItemKind.content
coItemSpeedup :: ItemSpeedup
coItemSpeedup = ContentData ItemKind -> ItemSpeedup
speedupItem ContentData ItemKind
coitem
cotile :: ContentData TileKind
cotile = ContentData ItemKind -> [TileKind] -> ContentData TileKind
TK.makeData ContentData ItemKind
coitem [TileKind]
Content.TileKind.content
coTileSpeedup :: TileSpeedup
coTileSpeedup = Bool -> ContentData TileKind -> TileSpeedup
Tile.speedupTile Bool
sallClear ContentData TileKind
cotile
coplace :: ContentData PlaceKind
coplace = ContentData TileKind -> [PlaceKind] -> ContentData PlaceKind
PK.makeData ContentData TileKind
cotile [PlaceKind]
Content.PlaceKind.content
cocave :: ContentData CaveKind
cocave = ContentData ItemKind
-> ContentData PlaceKind
-> ContentData TileKind
-> [CaveKind]
-> ContentData CaveKind
CK.makeData ContentData ItemKind
coitem ContentData PlaceKind
coplace ContentData TileKind
cotile [CaveKind]
Content.CaveKind.content
copsRaw :: COps
copsRaw = $WCOps :: ContentData CaveKind
-> ContentData ItemKind
-> ContentData ModeKind
-> ContentData PlaceKind
-> RuleContent
-> ContentData TileKind
-> ItemSpeedup
-> TileSpeedup
-> COps
COps
{ ContentData CaveKind
cocave :: ContentData CaveKind
cocave :: ContentData CaveKind
cocave
, ContentData ItemKind
coitem :: ContentData ItemKind
coitem :: ContentData ItemKind
coitem
, comode :: ContentData ModeKind
comode = ContentData CaveKind
-> ContentData ItemKind -> [ModeKind] -> ContentData ModeKind
MK.makeData ContentData CaveKind
cocave ContentData ItemKind
coitem [ModeKind]
Content.ModeKind.content
, ContentData PlaceKind
coplace :: ContentData PlaceKind
coplace :: ContentData PlaceKind
coplace
, corule :: RuleContent
corule = RuleContent -> RuleContent
RK.makeData RuleContent
Content.RuleKind.standardRules
, ContentData TileKind
cotile :: ContentData TileKind
cotile :: ContentData TileKind
cotile
, ItemSpeedup
coItemSpeedup :: ItemSpeedup
coItemSpeedup :: ItemSpeedup
coItemSpeedup
, TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup
}
benchmark :: Bool
benchmark = ClientOptions -> Bool
sbenchmark (ClientOptions -> Bool) -> ClientOptions -> Bool
forall a b. (a -> b) -> a -> b
$ ServerOptions -> ClientOptions
sclientOptions ServerOptions
soptionsNxt
#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 <- COps -> Bool -> IO UIOptions
mkUIOptions COps
cops Bool
benchmark
let !ccui :: CCUI
ccui = $WCCUI :: InputContent -> ScreenContent -> CCUI
CCUI
{ coinput :: InputContent
coinput = UIOptions -> InputContentRaw -> InputContent
IC.makeData UIOptions
sUIOptions InputContentRaw
Content.Input.standardKeysAndMouse
, coscreen :: ScreenContent
coscreen = ScreenContent -> ScreenContent
SC.makeData 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
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 ()
workaround <- MVar (IO ()) -> IO (IO ())
forall a. MVar a -> IO a
takeMVar MVar (IO ())
workaroundOnMainThreadMVar
IO ()
workaround
Async () -> IO ()
forall a. Async a -> IO a
wait Async ()
a
#endif