diff --git a/.paket/Paket.Restore.targets b/.paket/Paket.Restore.targets index 55292f3..e12083c 100644 --- a/.paket/Paket.Restore.targets +++ b/.paket/Paket.Restore.targets @@ -71,7 +71,10 @@ false true - + + + true + @@ -132,11 +135,11 @@ - + - + $([System.String]::Copy('%(PaketReferencesFileLines.Identity)').Split(',')[0]) $([System.String]::Copy('%(PaketReferencesFileLines.Identity)').Split(',')[1]) diff --git a/src/s2client-dotnet.sln b/src/s2client-dotnet.sln index 612472c..19d3216 100644 --- a/src/s2client-dotnet.sln +++ b/src/s2client-dotnet.sln @@ -1,15 +1,14 @@ - Microsoft Visual Studio Solution File, Format Version 12.00 # Visual Studio 15 VisualStudioVersion = 15.0.26124.0 MinimumVisualStudioVersion = 15.0.26124.0 -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "s2client-fsharp", "s2client-fsharp\s2client-fsharp.fsproj", "{1C9FB686-318F-49BA-BB2F-297863EB8745}" +Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "s2client-fsharp", "s2client-fsharp\s2client-fsharp.fsproj", "{1C9FB686-318F-49BA-BB2F-297863EB8745}" EndProject -Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "s2client-proto", "s2client-proto\s2client-proto.csproj", "{A353213F-13F2-40AE-BEAF-832AD0255223}" +Project("{9A19103F-16F7-4668-BE54-9A1E7A4F7556}") = "s2client-proto", "s2client-proto\s2client-proto.csproj", "{A353213F-13F2-40AE-BEAF-832AD0255223}" EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "s2client-test", "s2client-test\s2client-test.fsproj", "{60932B3D-F9A5-40FD-AD17-F3BF2540D67D}" +Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "s2client-test", "s2client-test\s2client-test.fsproj", "{60932B3D-F9A5-40FD-AD17-F3BF2540D67D}" EndProject -Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "s2client-testCSharp", "s2client-testCSharp\s2client-testCSharp.csproj", "{22359A31-BC1E-4F75-860B-3A1773969F19}" +Project("{9A19103F-16F7-4668-BE54-9A1E7A4F7556}") = "s2client-testCSharp", "s2client-testCSharp\s2client-testCSharp.csproj", "{22359A31-BC1E-4F75-860B-3A1773969F19}" EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution @@ -20,57 +19,60 @@ Global Release|x64 = Release|x64 Release|x86 = Release|x86 EndGlobalSection - GlobalSection(SolutionProperties) = preSolution - HideSolutionNode = FALSE - EndGlobalSection GlobalSection(ProjectConfigurationPlatforms) = postSolution {1C9FB686-318F-49BA-BB2F-297863EB8745}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {1C9FB686-318F-49BA-BB2F-297863EB8745}.Debug|Any CPU.Build.0 = Debug|Any CPU - {1C9FB686-318F-49BA-BB2F-297863EB8745}.Debug|x64.ActiveCfg = Debug|x64 - {1C9FB686-318F-49BA-BB2F-297863EB8745}.Debug|x64.Build.0 = Debug|x64 - {1C9FB686-318F-49BA-BB2F-297863EB8745}.Debug|x86.ActiveCfg = Debug|x86 - {1C9FB686-318F-49BA-BB2F-297863EB8745}.Debug|x86.Build.0 = Debug|x86 + {1C9FB686-318F-49BA-BB2F-297863EB8745}.Debug|x64.ActiveCfg = Debug|Any CPU + {1C9FB686-318F-49BA-BB2F-297863EB8745}.Debug|x64.Build.0 = Debug|Any CPU + {1C9FB686-318F-49BA-BB2F-297863EB8745}.Debug|x86.ActiveCfg = Debug|Any CPU + {1C9FB686-318F-49BA-BB2F-297863EB8745}.Debug|x86.Build.0 = Debug|Any CPU {1C9FB686-318F-49BA-BB2F-297863EB8745}.Release|Any CPU.ActiveCfg = Release|Any CPU {1C9FB686-318F-49BA-BB2F-297863EB8745}.Release|Any CPU.Build.0 = Release|Any CPU - {1C9FB686-318F-49BA-BB2F-297863EB8745}.Release|x64.ActiveCfg = Release|x64 - {1C9FB686-318F-49BA-BB2F-297863EB8745}.Release|x64.Build.0 = Release|x64 - {1C9FB686-318F-49BA-BB2F-297863EB8745}.Release|x86.ActiveCfg = Release|x86 - {1C9FB686-318F-49BA-BB2F-297863EB8745}.Release|x86.Build.0 = Release|x86 + {1C9FB686-318F-49BA-BB2F-297863EB8745}.Release|x64.ActiveCfg = Release|Any CPU + {1C9FB686-318F-49BA-BB2F-297863EB8745}.Release|x64.Build.0 = Release|Any CPU + {1C9FB686-318F-49BA-BB2F-297863EB8745}.Release|x86.ActiveCfg = Release|Any CPU + {1C9FB686-318F-49BA-BB2F-297863EB8745}.Release|x86.Build.0 = Release|Any CPU {A353213F-13F2-40AE-BEAF-832AD0255223}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {A353213F-13F2-40AE-BEAF-832AD0255223}.Debug|Any CPU.Build.0 = Debug|Any CPU - {A353213F-13F2-40AE-BEAF-832AD0255223}.Debug|x64.ActiveCfg = Debug|x64 - {A353213F-13F2-40AE-BEAF-832AD0255223}.Debug|x64.Build.0 = Debug|x64 - {A353213F-13F2-40AE-BEAF-832AD0255223}.Debug|x86.ActiveCfg = Debug|x86 - {A353213F-13F2-40AE-BEAF-832AD0255223}.Debug|x86.Build.0 = Debug|x86 + {A353213F-13F2-40AE-BEAF-832AD0255223}.Debug|x64.ActiveCfg = Debug|Any CPU + {A353213F-13F2-40AE-BEAF-832AD0255223}.Debug|x64.Build.0 = Debug|Any CPU + {A353213F-13F2-40AE-BEAF-832AD0255223}.Debug|x86.ActiveCfg = Debug|Any CPU + {A353213F-13F2-40AE-BEAF-832AD0255223}.Debug|x86.Build.0 = Debug|Any CPU {A353213F-13F2-40AE-BEAF-832AD0255223}.Release|Any CPU.ActiveCfg = Release|Any CPU {A353213F-13F2-40AE-BEAF-832AD0255223}.Release|Any CPU.Build.0 = Release|Any CPU - {A353213F-13F2-40AE-BEAF-832AD0255223}.Release|x64.ActiveCfg = Release|x64 - {A353213F-13F2-40AE-BEAF-832AD0255223}.Release|x64.Build.0 = Release|x64 - {A353213F-13F2-40AE-BEAF-832AD0255223}.Release|x86.ActiveCfg = Release|x86 - {A353213F-13F2-40AE-BEAF-832AD0255223}.Release|x86.Build.0 = Release|x86 + {A353213F-13F2-40AE-BEAF-832AD0255223}.Release|x64.ActiveCfg = Release|Any CPU + {A353213F-13F2-40AE-BEAF-832AD0255223}.Release|x64.Build.0 = Release|Any CPU + {A353213F-13F2-40AE-BEAF-832AD0255223}.Release|x86.ActiveCfg = Release|Any CPU + {A353213F-13F2-40AE-BEAF-832AD0255223}.Release|x86.Build.0 = Release|Any CPU {60932B3D-F9A5-40FD-AD17-F3BF2540D67D}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {60932B3D-F9A5-40FD-AD17-F3BF2540D67D}.Debug|Any CPU.Build.0 = Debug|Any CPU - {60932B3D-F9A5-40FD-AD17-F3BF2540D67D}.Debug|x64.ActiveCfg = Debug|x64 - {60932B3D-F9A5-40FD-AD17-F3BF2540D67D}.Debug|x64.Build.0 = Debug|x64 - {60932B3D-F9A5-40FD-AD17-F3BF2540D67D}.Debug|x86.ActiveCfg = Debug|x86 - {60932B3D-F9A5-40FD-AD17-F3BF2540D67D}.Debug|x86.Build.0 = Debug|x86 + {60932B3D-F9A5-40FD-AD17-F3BF2540D67D}.Debug|x64.ActiveCfg = Debug|Any CPU + {60932B3D-F9A5-40FD-AD17-F3BF2540D67D}.Debug|x64.Build.0 = Debug|Any CPU + {60932B3D-F9A5-40FD-AD17-F3BF2540D67D}.Debug|x86.ActiveCfg = Debug|Any CPU + {60932B3D-F9A5-40FD-AD17-F3BF2540D67D}.Debug|x86.Build.0 = Debug|Any CPU {60932B3D-F9A5-40FD-AD17-F3BF2540D67D}.Release|Any CPU.ActiveCfg = Release|Any CPU {60932B3D-F9A5-40FD-AD17-F3BF2540D67D}.Release|Any CPU.Build.0 = Release|Any CPU - {60932B3D-F9A5-40FD-AD17-F3BF2540D67D}.Release|x64.ActiveCfg = Release|x64 - {60932B3D-F9A5-40FD-AD17-F3BF2540D67D}.Release|x64.Build.0 = Release|x64 - {60932B3D-F9A5-40FD-AD17-F3BF2540D67D}.Release|x86.ActiveCfg = Release|x86 - {60932B3D-F9A5-40FD-AD17-F3BF2540D67D}.Release|x86.Build.0 = Release|x86 + {60932B3D-F9A5-40FD-AD17-F3BF2540D67D}.Release|x64.ActiveCfg = Release|Any CPU + {60932B3D-F9A5-40FD-AD17-F3BF2540D67D}.Release|x64.Build.0 = Release|Any CPU + {60932B3D-F9A5-40FD-AD17-F3BF2540D67D}.Release|x86.ActiveCfg = Release|Any CPU + {60932B3D-F9A5-40FD-AD17-F3BF2540D67D}.Release|x86.Build.0 = Release|Any CPU {22359A31-BC1E-4F75-860B-3A1773969F19}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {22359A31-BC1E-4F75-860B-3A1773969F19}.Debug|Any CPU.Build.0 = Debug|Any CPU - {22359A31-BC1E-4F75-860B-3A1773969F19}.Debug|x64.ActiveCfg = Debug|x64 - {22359A31-BC1E-4F75-860B-3A1773969F19}.Debug|x64.Build.0 = Debug|x64 - {22359A31-BC1E-4F75-860B-3A1773969F19}.Debug|x86.ActiveCfg = Debug|x86 - {22359A31-BC1E-4F75-860B-3A1773969F19}.Debug|x86.Build.0 = Debug|x86 + {22359A31-BC1E-4F75-860B-3A1773969F19}.Debug|x64.ActiveCfg = Debug|Any CPU + {22359A31-BC1E-4F75-860B-3A1773969F19}.Debug|x64.Build.0 = Debug|Any CPU + {22359A31-BC1E-4F75-860B-3A1773969F19}.Debug|x86.ActiveCfg = Debug|Any CPU + {22359A31-BC1E-4F75-860B-3A1773969F19}.Debug|x86.Build.0 = Debug|Any CPU {22359A31-BC1E-4F75-860B-3A1773969F19}.Release|Any CPU.ActiveCfg = Release|Any CPU {22359A31-BC1E-4F75-860B-3A1773969F19}.Release|Any CPU.Build.0 = Release|Any CPU - {22359A31-BC1E-4F75-860B-3A1773969F19}.Release|x64.ActiveCfg = Release|x64 - {22359A31-BC1E-4F75-860B-3A1773969F19}.Release|x64.Build.0 = Release|x64 - {22359A31-BC1E-4F75-860B-3A1773969F19}.Release|x86.ActiveCfg = Release|x86 - {22359A31-BC1E-4F75-860B-3A1773969F19}.Release|x86.Build.0 = Release|x86 + {22359A31-BC1E-4F75-860B-3A1773969F19}.Release|x64.ActiveCfg = Release|Any CPU + {22359A31-BC1E-4F75-860B-3A1773969F19}.Release|x64.Build.0 = Release|Any CPU + {22359A31-BC1E-4F75-860B-3A1773969F19}.Release|x86.ActiveCfg = Release|Any CPU + {22359A31-BC1E-4F75-860B-3A1773969F19}.Release|x86.Build.0 = Release|Any CPU + EndGlobalSection + GlobalSection(SolutionProperties) = preSolution + HideSolutionNode = FALSE + EndGlobalSection + GlobalSection(ExtensibilityGlobals) = postSolution + SolutionGuid = {D4C1D667-89AE-4C6A-BAAA-7DCF34A72516} EndGlobalSection EndGlobal diff --git a/src/s2client-fsharp/Async.fs b/src/s2client-fsharp/Async.fs deleted file mode 100644 index c3e924b..0000000 --- a/src/s2client-fsharp/Async.fs +++ /dev/null @@ -1,60 +0,0 @@ -namespace Starcraft2 - - -/// Extensions for async workflows. -[] -module AsyncExtensions = - open System - open System.Threading.Tasks - open System.Threading - open System.Runtime.ExceptionServices - - // This uses a trick to get the underlying OperationCanceledException - let inline getCancelledException (completedTask:Task) (waitWithAwaiter) = - let fallback = new TaskCanceledException(completedTask) :> OperationCanceledException - // sadly there is no other public api to retrieve it, but to call .GetAwaiter().GetResult(). - try waitWithAwaiter() - // should not happen, but just in case... - fallback - with - | :? OperationCanceledException as o -> o - | other -> - // shouldn't happen, but just in case... - new TaskCanceledException(fallback.Message, other) :> OperationCanceledException - type Microsoft.FSharp.Control.Async with - static member AwaitTaskWithoutAggregate (task:Task<'T>) : Async<'T> = - Async.FromContinuations(fun (cont, econt, ccont) -> - let continuation (completedTask : Task<_>) = - if completedTask.IsCanceled then - let cancelledException = - getCancelledException completedTask (fun () -> completedTask.GetAwaiter().GetResult() |> ignore) - econt (cancelledException) - elif completedTask.IsFaulted then - if completedTask.Exception.InnerExceptions.Count = 1 then - econt completedTask.Exception.InnerExceptions.[0] - else - econt completedTask.Exception - else - cont completedTask.Result - task.ContinueWith(Action>(continuation)) |> ignore) - static member AwaitTaskWithoutAggregate (task:Task) : Async = - Async.FromContinuations(fun (cont, econt, ccont) -> - let continuation (completedTask : Task) = - if completedTask.IsCanceled then - let cancelledException = - getCancelledException completedTask (fun () -> completedTask.GetAwaiter().GetResult() |> ignore) - econt (cancelledException) - elif completedTask.IsFaulted then - if completedTask.Exception.InnerExceptions.Count = 1 then - econt completedTask.Exception.InnerExceptions.[0] - else - econt completedTask.Exception - else - cont () - task.ContinueWith(Action(continuation)) |> ignore) - -module Runner = - let run a = - a |> Async.RunSynchronously - let runTask a = - a |> Async.StartAsTask \ No newline at end of file diff --git a/src/s2client-fsharp/ErrorDefs.fs b/src/s2client-fsharp/ErrorDefs.fs new file mode 100644 index 0000000..6993fab --- /dev/null +++ b/src/s2client-fsharp/ErrorDefs.fs @@ -0,0 +1,16 @@ +namespace Starcraft2 + +type ApplicationError = + |FailedToEstablishConnection of exn + |SendMessageBufferTooSmall + |ExpectedBinaryResponse + |FailedToSendMessage of exn + |FailedToReceiveMessage of exn + |NullResultWithNoError + |NullResultWithError of string seq + |ExecutableNotFound of string + |ConfigError of string + |GameNotStarted + |GameNotJoined + |NotInGame + |BotError \ No newline at end of file diff --git a/src/s2client-fsharp/Instance.fs b/src/s2client-fsharp/Instance.fs index da85b6f..56a6fdb 100644 --- a/src/s2client-fsharp/Instance.fs +++ b/src/s2client-fsharp/Instance.fs @@ -4,13 +4,15 @@ open SC2APIProtocol // manage a starcraft instance module Instance = + let private checkStatus expectedStatus errorType (x, status) = + if status = expectedStatus then + Ok x + else + Error errorType type Sc2Instance = - { Connection : ProtbufConnection.Sc2Connection; Process : System.Diagnostics.Process } - member x.Disconnect (exitInstance:bool) = - x.Connection.Disconnect(exitInstance) - if (not(x.Process.WaitForExit(1000))) then - x.Process.Kill() + {Connection:ProtobufConnection.Sc2Connection; Process:System.Diagnostics.Process} + let internal getFreePort () = let l = new System.Net.Sockets.TcpListener(System.Net.IPAddress.Loopback, 0) l.Start() @@ -45,41 +47,43 @@ module Instance = | None -> getFreePort() let address = "127.0.0.1" let timeout = defaultArg settings.Timeout (System.TimeSpan.FromMinutes 1.0) - let executable = + let execResult = match settings.Executable with - | Some exec -> exec + | Some exec -> exec |> Ok | None -> match userSettings.Value.Executable with - | Some exec -> exec - | None -> failwithf "No executable specified." - if not (System.IO.File.Exists executable) then - failwithf "Executable '%s' doesn't exist, please try to specify the executable by hand via StartSettings or UserSettings." executable - let sc2Dir = executable |> System.IO.Path.GetDirectoryName |> System.IO.Path.GetDirectoryName |> System.IO.Path.GetDirectoryName - let supportDir = System.IO.Path.Combine(sc2Dir, "Support64") - let proc = System.Diagnostics.ProcessStartInfo(executable) - // -dataVersion - // -windowwidth - // -windowheight - // -windowx - // -windowy - proc.Arguments <- sprintf "-listen %s -port %d -displayMode 0" address port - proc.WorkingDirectory <- supportDir - printfn "Starting SC2 ... (%s %s)" executable proc.Arguments - let processInstance = System.Diagnostics.Process.Start(proc) - - let watch = System.Diagnostics.Stopwatch.StartNew() - let mutable connection = None - let mutable lastError = null - while connection.IsNone && watch.Elapsed < timeout do - try - let! con = ProtbufConnection.connect address port timeout tok.Token - connection <- Some con - with :? System.Net.WebSockets.WebSocketException as err -> - lastError <- err - match connection with - | None -> return raise <| System.TimeoutException("Could not connect within the specified time", lastError) - | Some connection -> - return { Connection = connection; Process = processInstance } } + | Some exec -> exec |> Ok + | None -> "No executable specified." |> ConfigError |> Error + + let checkExecExists s = + if not (System.IO.File.Exists s) then + s |> ExecutableNotFound |> Error + else + s |> Ok + + let getInstance executable = async { + let sc2Dir = executable |> System.IO.Path.GetDirectoryName |> System.IO.Path.GetDirectoryName |> System.IO.Path.GetDirectoryName + let supportDir = System.IO.Path.Combine(sc2Dir, "Support64") + let proc = System.Diagnostics.ProcessStartInfo(executable) + // -dataVersion + // -windowwidth + // -windowheight + // -windowx + // -windowy + proc.Arguments <- sprintf "-listen %s -port %d -displayMode 0" address port + proc.WorkingDirectory <- supportDir + printfn "Starting SC2 ... (%s %s)" executable proc.Arguments + let processInstance = System.Diagnostics.Process.Start(proc) + + let! connection = ProtobufConnection.connect address port timeout tok.Token + return {Connection = connection; Process = processInstance} |> Ok + } + + return! + execResult + |> Result.bind checkExecExists + |> Result.bindAsyncBinder getInstance + } type Participant = | Participant of Race @@ -93,7 +97,8 @@ module Instance = let createGame (instance:Sc2Instance) mapName (participants:Participant list) realTime = async { let req = new RequestCreateGame() - for player in participants do + + for player in participants do let playerSetup = new PlayerSetup() playerSetup.Type <- player.PlayerType match player with @@ -104,6 +109,7 @@ module Instance = playerSetup.Difficulty <- difficulty | Observer -> () req.PlayerSetup.Add(playerSetup) + req.Realtime <- realTime // map @@ -125,9 +131,7 @@ module Instance = req.LocalMap <- localmap // create the game - let! status = ProtbufConnection.createGame req instance.Connection - assert (status = Status.InitGame) - return () + return! ProtobufConnection.createGame req instance.Connection |> Result.bindAsyncInput (checkStatus Status.InitGame GameNotStarted) } type ClientPort = @@ -152,11 +156,14 @@ module Instance = let server_ports = new PortSet() server_ports.GamePort <- ports.ServerPorts.GamePort server_ports.BasePort <- ports.ServerPorts.BasePort - for clientPorts in ports.ClientPorts do + ports.ClientPorts + |> + List.iter (fun clientPorts -> let cl = new PortSet() cl.BasePort <- clientPorts.BasePort cl.GamePort <- clientPorts.GamePort req.ClientPorts.Add(cl) + ) ) // interface @@ -170,31 +177,24 @@ module Instance = req.Options <- interfaceOpts // Do the join command - let! playerId, status = ProtbufConnection.joinGame req instance.Connection - assert (status = Status.InGame) - - return playerId + return! ProtobufConnection.joinGame req instance.Connection |> Result.bindAsyncInput (checkStatus Status.InGame GameNotJoined) } let getGameInfo (instance:Sc2Instance) = async { // Do the join command - let! gameInfo, status = ProtbufConnection.getGameInfo instance.Connection - assert (status = Status.InGame) - return gameInfo } + return! ProtobufConnection.getGameInfo instance.Connection |> Result.bindAsyncInput (checkStatus Status.InGame GameNotJoined) + } let getObservation disableFog (instance:Sc2Instance) = async { // Do the join command - let! responseObs, status = ProtbufConnection.getObservation disableFog instance.Connection - assert (status = Status.InGame) - return responseObs } + return! ProtobufConnection.getObservation disableFog instance.Connection |> Result.bindAsyncInput (checkStatus Status.InGame NotInGame) + } let doStep stepSize (instance:Sc2Instance) = async { // Do the join command - let! status = ProtbufConnection.doStep stepSize instance.Connection - assert (status = Status.InGame) - return () } + return! ProtobufConnection.doStep stepSize instance.Connection |> Result.bindAsyncInput (checkStatus Status.InGame NotInGame) + } let doActions actions (instance:Sc2Instance) = async { // Send Actions - let! result, status = ProtbufConnection.doActions actions instance.Connection - assert (status = Status.InGame) - return result } \ No newline at end of file + return!ProtobufConnection.doActions actions instance.Connection |> Result.bindAsyncInput (checkStatus Status.InGame NotInGame) + } \ No newline at end of file diff --git a/src/s2client-fsharp/ProtobufConnection.fs b/src/s2client-fsharp/ProtobufConnection.fs index de9e8be..c858fc4 100644 --- a/src/s2client-fsharp/ProtobufConnection.fs +++ b/src/s2client-fsharp/ProtobufConnection.fs @@ -1,256 +1,168 @@ namespace Starcraft2 +open System +//open SC2APIProtocol -open SC2APIProtocol -open System.Net.WebSockets - -type Agent<'T> = MailboxProcessor<'T> - - -/// Exception for invalid expression types -[] -type ClientDisconnectedException = - inherit System.Exception - new (msg:string, inner:exn) = { - inherit System.Exception(msg, inner) } - new (info:System.Runtime.Serialization.SerializationInfo, context:System.Runtime.Serialization.StreamingContext) = { - inherit System.Exception(info, context) } - - -/// Exception for invalid expression types -[] -type ResponseErrorException = - static member FormatError (msgs:string seq) = - System.String.Join(", ", msgs) - val private errors : string list - - inherit System.Exception - new (msg:string, inner:exn) = { - inherit System.Exception(msg, inner) - errors = [msg] } - new (errors:string seq) = { - inherit System.Exception(ResponseErrorException.FormatError(errors), null) - errors = errors |> Seq.toList } - new (info:System.Runtime.Serialization.SerializationInfo, context:System.Runtime.Serialization.StreamingContext) = { - inherit System.Exception(info, context) - errors = [] - } - member x.Errors with get () = x.errors - -/// Exception for invalid expression types -[] -type TypedResponseErrorException<'T when 'T : enum> = - static member FormatError (error:'T, detail:string) = - let name = System.Enum.GetName(typeof<'T>, error) - sprintf "%s - %s (%d): %s" (typeof<'T>.Name) name (error :> obj :?> int) detail - val private error : 'T - val private detail : string - - inherit ResponseErrorException - new (msg:string, inner:exn) = { - inherit ResponseErrorException(msg, inner) - error = Unchecked.defaultof<'T> - detail = "" } - new (error:'T, detail : string) = { - inherit ResponseErrorException(TypedResponseErrorException.FormatError(error, detail), null) - error = error - detail = detail } - new (info:System.Runtime.Serialization.SerializationInfo, context:System.Runtime.Serialization.StreamingContext) = { - inherit ResponseErrorException(info, context) - error = Unchecked.defaultof<'T> - detail = "" } - member x.Error with get () = x.error - member x.Detail with get () = x.detail - -type PlayerId = uint32 - -// Handle connection via protobuf/websockets -module ProtbufConnection = - type private ClientResponse<'T> = - | Success of 'T - | Error of System.Runtime.ExceptionServices.ExceptionDispatchInfo +module ProtobufConnection = + open System.Net.WebSockets type private ClientRequest = - | SendRequest of SC2APIProtocol.Request * AsyncReplyChannel> - | Disconnect of bool * AsyncReplyChannel - - type Sc2Connection = - private { Client : Agent; _Address : string; _Port : int; _Timeout : System.TimeSpan } - interface System.IDisposable with - member x.Dispose () = - x.Client.PostAndAsyncReply(fun reply -> Disconnect (false, reply)) - |> Async.RunSynchronously - |> ignore - member x.Disconnect (quitInstance: bool) = - x.Client.PostAndAsyncReply(fun reply -> Disconnect(quitInstance, reply)) - |> Async.RunSynchronously - |> ignore - - member x.Address = x._Address - member x.Port = x._Port - member x.Timeout = x._Timeout - - let private sendRequest (cl:Sc2Connection) request = async { - let! response = cl.Client.PostAndAsyncReply(fun reply -> SendRequest (request, reply)) - match response with - | Success res -> return res - | Error dispatch -> dispatch.Throw(); return failwithf "Should not happen." } - - let private checkNullAndWarnings (response:Response) field = - if isNull field then - if isNull response.Error then - failwithf "Unexpected result and no error information!" - raise <| ResponseErrorException response.Error - else - if not (isNull response.Error) then - for error in response.Error do - eprintf "Response warning: %s" error + |SendRequest of SC2APIProtocol.Request * AsyncReplyChannel> - let ping (cl : Sc2Connection) = async { - let request = new SC2APIProtocol.Request() - request.Ping <- RequestPing() - let! response = sendRequest cl request - let pingResponse = response.Ping - checkNullAndWarnings response pingResponse - return pingResponse, response.Status } - - let connect address port timeout tok = async { - let mailbox = - Agent.Start(fun mailbox -> async { - let mutable recover = ignore + type Sc2Connection(address:string, port:int, timeout:TimeSpan, tok) = + let connectedSocket = + let watch = System.Diagnostics.Stopwatch.StartNew() + let rec getConnectedSocket() = try - use cl = new ClientWebSocket() + let clientSock = new ClientWebSocket() let fullAddress = System.Uri (sprintf "ws://%s:%d/sc2api" address port) - let! connected = cl.ConnectAsync(fullAddress, tok) |> Async.AwaitTaskWithoutAggregate - let mutable stayConnected = true - let receiveBuf = System.ArraySegment(Array.zeroCreate (1024*1024)) - let sendBuf = System.ArraySegment(Array.zeroCreate (1024*1024)) - - let writeMessage (req:Request) = async { - use co = new Google.Protobuf.CodedOutputStream(sendBuf.Array) - req.WriteTo(co) - let written = int co.Position - let send = System.ArraySegment(sendBuf.Array, 0, written) - do! cl.SendAsync(send, WebSocketMessageType.Binary, true, tok) |> Async.AwaitTaskWithoutAggregate } - let readMessage () = async { - let mutable finished = false - let mutable curPos = 0 - while not finished do - let left = sendBuf.Array.Length - curPos - if left <= 0 then - failwithf "Our buffer wasn't large enough for the current message!" - let segment = System.ArraySegment(receiveBuf.Array, curPos, left) - let! result = cl.ReceiveAsync(segment, tok) |> Async.AwaitTaskWithoutAggregate - match result.MessageType with - | WebSocketMessageType.Binary -> - curPos <- curPos + result.Count - finished <- result.EndOfMessage - | _ -> - failwithf "Expected a binary response!" - - - let response = Response.Parser.ParseFrom(new System.IO.MemoryStream(receiveBuf.Array, 0, curPos)) - return response } - - - while stayConnected do - let! request = mailbox.Receive() - match request with - | SendRequest (req, reply) -> - recover <- Error >> reply.Reply - do! writeMessage req - let! resp = readMessage() - recover <- ignore - reply.Reply(Success resp) - | Disconnect (sendQuit, reply) -> - recover <- Some >> reply.Reply - stayConnected <- false - if sendQuit then - // Cleanup - let quit = new Request() - quit.Quit <- new RequestQuit() - do! writeMessage quit - recover <- ignore - reply.Reply(None) - - with e -> - // "recover" from a failed request - let catch = System.Runtime.ExceptionServices.ExceptionDispatchInfo.Capture(e) - recover catch - - // respond to future requests - while true do - let! request = mailbox.Receive() - match request with - | SendRequest (req, reply) -> reply.Reply(ClientResponse.Error catch) - | Disconnect (_, reply) -> reply.Reply(Some catch) - - // Notify everyone that we are disconnected. - let catch = System.Runtime.ExceptionServices.ExceptionDispatchInfo.Capture(new ClientDisconnectedException("Client was already disconnected", null)) - while true do - let! request = mailbox.Receive() - match request with - | SendRequest (req, reply) -> reply.Reply(ClientResponse.Error catch) - | Disconnect (_, reply) -> reply.Reply(None) - }) - - let con = { Client = mailbox; _Address = address; _Port = port; _Timeout = timeout } - let! _ = ping con - return con } - - let inline checkError (error:'T when 'T : enum) (errorDetails:string) = - if error :> obj :?> int <> 0 then - raise <| TypedResponseErrorException<'T>(error, errorDetails) - - let createGame (createGame: RequestCreateGame) (cl : Sc2Connection) : Async = async { - let request = new SC2APIProtocol.Request() - request.CreateGame <- createGame - let! response = sendRequest cl request - let createGameResponse = response.CreateGame - checkNullAndWarnings response createGameResponse - checkError createGameResponse.Error createGameResponse.ErrorDetails - return response.Status } - - let joinGame (joinGame: RequestJoinGame) (cl : Sc2Connection) : Async = async { - let request = new SC2APIProtocol.Request() - request.JoinGame <- joinGame - let! response = sendRequest cl request - let joinGameResponse = response.JoinGame - checkNullAndWarnings response joinGameResponse - checkError joinGameResponse.Error joinGameResponse.ErrorDetails - return joinGameResponse.PlayerId, response.Status } - - let getGameInfo (cl : Sc2Connection) = async { - let request = new SC2APIProtocol.Request() - request.GameInfo <- new RequestGameInfo() - let! response = sendRequest cl request - let gameInfoResponse = response.GameInfo - checkNullAndWarnings response gameInfoResponse - return gameInfoResponse, response.Status } - - let getObservation disableFog (cl : Sc2Connection) = async { - let request = new SC2APIProtocol.Request() - request.Observation <- new RequestObservation() - request.Observation.DisableFog <- disableFog - let! response = sendRequest cl request - let observationResponse = response.Observation - checkNullAndWarnings response observationResponse - return observationResponse, response.Status } - - let doStep stepSize (cl : Sc2Connection) = async { - let request = new SC2APIProtocol.Request() - request.Step <- new RequestStep() - request.Step.Count <- stepSize - let! response = sendRequest cl request - let stepResponse = response.Step - checkNullAndWarnings response stepResponse - return response.Status } + clientSock.ConnectAsync(fullAddress, tok) |> Async.AwaitTask |> Async.RunSynchronously + clientSock |> Ok + with + |_ when watch.Elapsed < timeout -> + getConnectedSocket() + |ex -> ex |> FailedToEstablishConnection |> Error + getConnectedSocket() + + let receiveBuf = System.ArraySegment(Array.zeroCreate (1024*1024)) + let sendBuf = System.ArraySegment(Array.zeroCreate (1024*1024)) + + let writeMessage (client:ClientWebSocket) (req:SC2APIProtocol.Request) = async { + try + use co = new Google.Protobuf.CodedOutputStream(sendBuf.Array) + req.WriteTo(co) + let written = int co.Position + let send = System.ArraySegment(sendBuf.Array, 0, written) + do! client.SendAsync(send, WebSocketMessageType.Binary, true, tok) |> Async.AwaitTask + return Ok () + with + |ex -> return ex |> FailedToSendMessage |> Error + } + + let readMessage (client:ClientWebSocket) = async { + let rec innerLoop curPos = async { + let left = sendBuf.Array.Length - curPos + if left <= 0 then + return Error SendMessageBufferTooSmall + else + try + let segment = System.ArraySegment(receiveBuf.Array, curPos, left) + let! result = client.ReceiveAsync(segment, tok) |> Async.AwaitTask + match result.MessageType, result.EndOfMessage with + |WebSocketMessageType.Binary, false -> + return! innerLoop (curPos + result.Count) + |WebSocketMessageType.Binary, true -> return Ok (curPos + result.Count) + |_ -> return Error ExpectedBinaryResponse + with + |ex -> return ex |> FailedToReceiveMessage |> Error + } + + let parseFrom finalPos = + SC2APIProtocol.Response.Parser.ParseFrom(new System.IO.MemoryStream(receiveBuf.Array, 0, finalPos)) + + return! + innerLoop 0 + |> Result.mapAsyncInput parseFrom + } + + let getAgent client = + let getResponse() = + readMessage client + MailboxProcessor.Start (fun inbox -> + let rec messageLoop() = async{ + let! msg = inbox.Receive() + + match msg with + |SendRequest (req, replyChannel) -> + let! resp = + writeMessage client req + |> Result.bindAsync getResponse + + replyChannel.Reply resp + + return! messageLoop() + } + messageLoop() + ) + + let agent = connectedSocket |> Result.map getAgent + + let postSendRequest req (agent:MailboxProcessor) = + agent.PostAndAsyncReply (fun reply -> SendRequest (req, reply)) + + let sendRequest req = async{ + return! + agent + |> Result.bindAsyncBinder (postSendRequest req) + } + + member this.SendRequest = sendRequest + + let connect address port timeout tok = async{ + return Sc2Connection(address, port, timeout, tok) + } - let doActions actions (cl : Sc2Connection) = async { - let request = new SC2APIProtocol.Request() - request.Action <- new RequestAction() - for action in actions do - request.Action.Actions.Add(action:Action) - let! response = sendRequest cl request - let actionResponse = response.Action - checkNullAndWarnings response actionResponse - return actionResponse.Result, response.Status } \ No newline at end of file + let private applyFieldCheckAndReturnFunction fieldCheck returnFunc (response:SC2APIProtocol.Response) = + match fieldCheck response, response.Error with + |null, null -> + Error NullResultWithNoError + |null, _ -> + Error (NullResultWithError response.Error) + |_, sq when not (isNull sq) -> + sq |> Seq.iter (fun s -> eprintfn "Response warning: %s" s) + response |> returnFunc |> Ok + |_, _ -> + response |> returnFunc |> Ok + + //let inline checkError (error:'T when 'T : enum) (errorDetails:string) = + // if error :> obj :?> int <> 0 then + // raise <| TypedResponseErrorException<'T>(error, errorDetails) + + let private genericInteractionFunction applyRequestField getResponseField getResult (client:Sc2Connection) = async { + let request = SC2APIProtocol.Request() |> applyRequestField + let! responseResult = client.SendRequest request + return + responseResult + |> Result.bind (applyFieldCheckAndReturnFunction getResponseField getResult) + } + + let createGame createGameReq client = + genericInteractionFunction + (fun (req:SC2APIProtocol.Request) -> req.CreateGame <- createGameReq; req) + (fun (resp:SC2APIProtocol.Response) -> resp.CreateGame) + (fun (resp:SC2APIProtocol.Response) -> (), resp.Status) + client + + let joinGame joinGameReq client = + genericInteractionFunction + (fun (req:SC2APIProtocol.Request) -> req.JoinGame <- joinGameReq; req) + (fun (resp:SC2APIProtocol.Response) -> resp.JoinGame) + (fun (resp:SC2APIProtocol.Response) -> resp.JoinGame.PlayerId, resp.Status) + client + + let getGameInfo client = + genericInteractionFunction + (fun (req:SC2APIProtocol.Request) -> req.GameInfo <- SC2APIProtocol.RequestGameInfo(); req) + (fun (resp:SC2APIProtocol.Response) -> resp.GameInfo) + (fun (resp:SC2APIProtocol.Response) -> resp.GameInfo, resp.Status) + client + + let getObservation disableFog client = + genericInteractionFunction + (fun (req:SC2APIProtocol.Request) -> req.Observation <- SC2APIProtocol.RequestObservation(); req.Observation.DisableFog <- disableFog; req) + (fun (resp:SC2APIProtocol.Response) -> resp.Observation) + (fun (resp:SC2APIProtocol.Response) -> resp.Observation, resp.Status) + client + + let doStep stepSize client = + genericInteractionFunction + (fun (req:SC2APIProtocol.Request) -> req.Step <- SC2APIProtocol.RequestStep(); req.Step.Count <- stepSize; req) + (fun (resp:SC2APIProtocol.Response) -> resp.Observation) + (fun (resp:SC2APIProtocol.Response) -> (), resp.Status) + client + + let doActions (actions:SC2APIProtocol.Action seq) client = + genericInteractionFunction + (fun (req:SC2APIProtocol.Request) -> req.Action <- SC2APIProtocol.RequestAction(); actions |> Seq.iter (fun action -> req.Action.Actions.Add(action)); req) + (fun (resp:SC2APIProtocol.Response) -> resp.Action) + (fun (resp:SC2APIProtocol.Response) -> resp.Action.Result, resp.Status) + client \ No newline at end of file diff --git a/src/s2client-fsharp/Railway.fs b/src/s2client-fsharp/Railway.fs new file mode 100644 index 0000000..22022d0 --- /dev/null +++ b/src/s2client-fsharp/Railway.fs @@ -0,0 +1,102 @@ +namespace Starcraft2 + +[] +module internal Result = + + // apply either a success function or failure function + let either successFunc failureFunc twoTrackInput = + match twoTrackInput with + | Ok s -> successFunc s + | Error f -> failureFunc f + + // convert a switch function into a two-track function + //let bind f = + // either f fail + + // convert a one-track function into a switch + let switch f = + f >> Ok + + // convert a one-track function into a two-track function + //let map f = + // either (f >> succeed) fail + + // convert a dead-end function into a one-track function + let tee f x = + f x; x + + // convert a one-track function into a switch with exception handling + let tryCatch f exnHandler x = + try + f x |> Ok + with + | ex -> exnHandler ex |> Error + + // convert two one-track functions into a two-track function + let doubleMap successFunc failureFunc = + either (successFunc >> Ok) (failureFunc >> Error) + + // add two switches in parallel + let plus addSuccess addFailure switch1 switch2 x = + match (switch1 x),(switch2 x) with + | Ok s1, Ok s2 -> Ok (addSuccess s1 s2) + | Error f1, Ok _ -> Error f1 + | Ok _ , Error f2 -> Error f2 + | Error f1, Error f2 -> Error (addFailure f1 f2) + + let bindAsyncInput binder asyncInput = async{ + let! input = asyncInput + return Result.bind binder input + } + + let eitherAsync successFunc failureFunc asyncInput = async{ + let! input = asyncInput + return either successFunc failureFunc input + } + + + let bindAsyncBinder asyncBinder input = async{ + match input with + |Error er -> return Error er + |Ok inp -> return! asyncBinder inp + } + + let bindAsync asyncBinder asyncInput = async { + let! input = asyncInput + return! bindAsyncBinder asyncBinder input + } + + let mapAsyncInput f asyncInput = async { + let! input = asyncInput + return Result.map f input + } + + let mapAsyncMapper asyncMapper input = async { + match input with + |Error er -> return Error er + |Ok inp -> return! asyncMapper inp + } + + let mapAsync asyncMapper asyncInput = async { + let! input = asyncInput + return! mapAsyncMapper asyncMapper input + } + + let listFold resultList = + resultList + |> List.fold (fun resultState resultElem -> + match resultState, resultElem with + |Ok state, Ok elem -> elem::state |> Ok + |Error er, _ -> Error er + |_, Error er -> Error er + ) (Ok []) + +[] +module RailOps = + // pipe a two-track value into a switch function + let (>>=) x f = + Result.bind f x + + // compose two switches into another switch + let (>=>) s1 s2 = + s1 >> Result.bind s2 \ No newline at end of file diff --git a/src/s2client-fsharp/Sc2Game.fs b/src/s2client-fsharp/Sc2Game.fs index 2448aa0..8e84f23 100644 --- a/src/s2client-fsharp/Sc2Game.fs +++ b/src/s2client-fsharp/Sc2Game.fs @@ -2,26 +2,36 @@ namespace Starcraft2 open SC2APIProtocol - type GameState = - { LastObservation : SC2APIProtocol.ResponseObservation option - LastActions : SC2APIProtocol.Action list - NewObservation : SC2APIProtocol.ResponseObservation - // more global state - PlayerId : PlayerId - GameInfo : SC2APIProtocol.ResponseGameInfo - } - static member Empty playerId = - { LastObservation = None - LastActions = [] - NewObservation = null - PlayerId = playerId - GameInfo = null } + { + LastObservation : SC2APIProtocol.ResponseObservation option + LastActions : SC2APIProtocol.Action list + NewObservation : SC2APIProtocol.ResponseObservation + PlayerId : uint32 + GameInfo : SC2APIProtocol.ResponseGameInfo + } + + static member InitialState playerId observation gameInfo = + { + LastObservation = None + LastActions = [] + NewObservation = observation + PlayerId = playerId + GameInfo = gameInfo + } + + member this.NextGameState lastActions observation = + {this with + LastObservation = this.NewObservation |> Some + LastActions = lastActions + NewObservation = observation + } type Sc2Bot = GameState -> SC2APIProtocol.Action list type Sc2Observer = GameState -> unit module Sc2Game = + open Instance type Participant = | Participant of Instance.Sc2Instance * Race * Sc2Bot @@ -64,24 +74,26 @@ module Sc2Game = let private setupAndConnect (gameSettings:GameSettings) (participants: Participant list) = async { // Create game with first client - let firstInstance = - participants - |> Seq.tryPick (function - | Participant(instance,_,_) -> Some instance - | Observer(instance,_) -> Some instance - | _ -> None) - let firstInstance = + let validateParticipants() = + let firstInstance = + participants + |> Seq.tryPick (function + | Participant(instance,_,_) -> Some instance + | Observer(instance,_) -> Some instance + | _ -> None) + match firstInstance with - | None -> failwithf "At least one non-computer participant needs to be added!" - | Some s -> s - - + | None -> "At least one non-computer participant needs to be added!" |> ConfigError |> Error + | Some s -> s |> Ok + let simpleParticipants = participants |> List.map (fun p -> p.Simple) - do! Instance.createGame firstInstance gameSettings.Map simpleParticipants gameSettings.Realtime - // Join other instances - let agents = participants |> Seq.sumBy (function Computer _ -> 0 | _ -> 1) - let ports = + let createGame firstInstance = + Instance.createGame firstInstance gameSettings.Map simpleParticipants gameSettings.Realtime + + let joinOtherInstances _ = + let agents = participants |> Seq.sumBy (function Computer _ -> 0 | _ -> 1) + if agents > 1 then let clientPortsRequired = // one is the server @@ -91,86 +103,114 @@ module Sc2Game = let clients = List.init clientPortsRequired (fun _ -> { Instance.ClientPort.BasePort = Instance.getFreePort(); Instance.ClientPort.GamePort = Instance.getFreePort() } ) - { Instance.SharedPort = shared - Instance.ServerPorts = server - Instance.ClientPorts = clients } + { + Instance.SharedPort = shared + Instance.ServerPorts = server + Instance.ClientPorts = clients + } |> Some - else None + else None - let playerIdTasks = + let getPlayerIds ports = participants |> List.map (fun part -> + let attachPart x = part, x match part with - | Participant (instance, _, _) - | Observer (instance, _) -> - Instance.joinGame instance gameSettings.UseFeatureLayers gameSettings.UseRender part.Simple ports - |> Async.StartAsTask - |> Some - | _ -> None) - for playerIdTask in playerIdTasks do - match playerIdTask with - | Some t -> do! t |> Async.AwaitTask |> Async.Ignore - | None -> () - - let playerIds = - playerIdTasks |> List.map (Option.map (fun pit -> pit.Result)) - - return playerIds + |Participant (instance, _, _) + |Observer (instance, _) -> + async{ + let! playerId = Instance.joinGame instance gameSettings.UseFeatureLayers gameSettings.UseRender part.Simple ports + return playerId |> Result.map Some |> Result.map attachPart + } + |_ -> async {return None |> attachPart |> Ok} + ) |> Async.Parallel |> Async.RunSynchronously |> List.ofArray |> Result.listFold + + return! + validateParticipants() + |> Result.bindAsyncBinder createGame + |> Result.bindAsyncInput (joinOtherInstances >> Ok) + |> Result.bindAsyncInput getPlayerIds } + type private PlayerData = + { + PlayerId:uint32 + Instance:Sc2Instance + Bot:Sc2Bot + } + static member Create playerId instance bot = + { + PlayerId = playerId + Instance = instance + Bot = bot + } let runGame (gameSettings:GameSettings) (participants: Participant seq) = async { - let participants = participants |> Seq.toList - let! playerIds = setupAndConnect gameSettings participants - - let merged = - List.zip participants playerIds - let state = System.Collections.Concurrent.ConcurrentDictionary<_,GameState>() - let getState playerId = - state.GetOrAdd(playerId, fun _ -> GameState.Empty playerId) - let updateState playerId newState = - state.AddOrUpdate(playerId, newState, (fun _ _ -> newState)) - |> ignore - - let relevantPlayers = - merged - |> List.choose (fun (part, playerId) -> + let getRelevantPlayers players = + players + |> List.choose (fun (part, playerId) -> match part, playerId with - | Participant (instance, _, bot), Some playerId -> - Some (playerId, instance, bot) - | Observer (instance, bot), Some playerId -> - Some (playerId, instance, (fun data -> bot data; [])) - | Computer _, _ -> None - | _ -> failwithf "Expected playerId when participant or observer but not when computer. %A" (part,playerId) - ) + |Participant (instance, _, bot), Some playerId -> + PlayerData.Create playerId instance bot |> Ok |> Some + //(playerId, instance, bot) :: state + |Observer (instance, bot), Some playerId -> + PlayerData.Create playerId instance (fun data -> bot data; []) |> Ok |> Some + |Computer _, _ -> None + | _ -> sprintf "Expected playerId when participant or observer but not when computer. %A" (part,playerId) |> ConfigError |> Error |> Some + ) |> Result.listFold // Get the static gameInfo - for (playerId, instance, bot) in relevantPlayers do - let! gameInfo = Instance.getGameInfo instance - let state = getState playerId - updateState playerId { state with GameInfo = gameInfo } - - // Game loop - while true do - for (playerId, instance, bot) in relevantPlayers do - let! obs = Instance.getObservation false instance - // TODO: Higher level support, GetUnits -> Self -> StartLocation - let lastState = getState playerId - let state = - { lastState with - NewObservation = obs - LastObservation = - if not (isNull lastState.NewObservation) then Some lastState.NewObservation - else None } - - let actions = bot state - if not gameSettings.Realtime then - do! Instance.doStep gameSettings.StepSize instance - - updateState playerId { state with LastActions = actions } - - // Execute actions - for (playerId, instance, bot) in relevantPlayers do - let lastState = getState playerId - do! Instance.doActions lastState.LastActions instance |> Async.Ignore - } \ No newline at end of file + let getStaticGameInfo = + List.map (fun (player:PlayerData) -> + Instance.getGameInfo player.Instance + |> Result.mapAsyncInput (fun gi -> player, gi) + ) >> Async.Parallel >> Async.RunSynchronously >> List.ofArray >> Result.listFold + + let getInitialGameState = + List.map (fun (player:PlayerData, gameInfo:ResponseGameInfo) -> + Instance.getObservation false player.Instance + |> Result.mapAsyncInput (fun obs -> player, GameState.InitialState player.PlayerId obs gameInfo) + ) >> Async.Parallel >> Async.RunSynchronously >> List.ofArray >> Result.listFold + + let rec gameLoop playersResult = + match playersResult with + |Ok players -> + players + |> List.map (fun (player:PlayerData, gameState:GameState) -> + let getActions = Result.tryCatch player.Bot (fun _ -> BotError) + + let executeActions actions = + Instance.doActions actions player.Instance //Travis: would this information (ActionResult) ever be useful to a bot? I see no reason against providing it as part of the game state + |> Result.mapAsyncInput (fun x -> actions) + + + let doStep actions = async{ + if not gameSettings.Realtime then + return! + Instance.doStep gameSettings.StepSize player.Instance + |> Result.mapAsyncInput (fun _ -> actions) + else + return Ok actions + } + + let getNextGameState actions = + Instance.getObservation false player.Instance + |> Result.mapAsyncInput (fun obs -> player, gameState.NextGameState actions obs) + + gameState + |> getActions + |> Result.mapAsyncMapper executeActions + |> Result.mapAsync doStep + |> Result.mapAsync getNextGameState + ) |> Async.Parallel |> Async.RunSynchronously |> List.ofArray |> Result.listFold |> gameLoop + |Error er -> Error er + + let! gameLoopInputs = + participants |> List.ofSeq + |> setupAndConnect gameSettings + |> Result.bindAsyncInput getRelevantPlayers + |> Result.bindAsyncInput getStaticGameInfo + |> Result.bindAsyncInput getInitialGameState + + return gameLoopInputs |> gameLoop + } \ No newline at end of file diff --git a/src/s2client-fsharp/s2client-fsharp.fsproj b/src/s2client-fsharp/s2client-fsharp.fsproj index 247ba2c..87a4995 100644 --- a/src/s2client-fsharp/s2client-fsharp.fsproj +++ b/src/s2client-fsharp/s2client-fsharp.fsproj @@ -6,7 +6,8 @@ s2client-dotnet - + + diff --git a/src/s2client-test/Program.fs b/src/s2client-test/Program.fs index 46d6f9b..044adfb 100644 --- a/src/s2client-test/Program.fs +++ b/src/s2client-test/Program.fs @@ -2,26 +2,26 @@ open System -open Starcraft2 +//open Starcraft2 open SC2APIProtocol [] let main argv = - let userSettings = Sc2SettingsFile.settingsFromUserDir() + //let userSettings = Sc2SettingsFile.settingsFromUserDir() - let instanceSettings = Instance.StartSettings.OfUserSettings userSettings + //let instanceSettings = Instance.StartSettings.OfUserSettings userSettings - let instance() = Instance.start(instanceSettings) |> Async.RunSynchronously + //let instance() = Instance.start(instanceSettings) |> Async.RunSynchronously - let participants = - [ Sc2Game.Participant(instance(), Race.Terran, (fun _ -> [])) - Sc2Game.Computer(Race.Terran, Difficulty.Hard) ] + //let participants = + // [ Sc2Game.Participant(instance(), Race.Terran, (fun _ -> [])) + // Sc2Game.Computer(Race.Terran, Difficulty.Hard) ] - let settings = - { Sc2Game.GameSettings.OfUserSettings userSettings with - Map = @"Ladder2017Season1\AbyssalReefLE.SC2Map" - Realtime = true } - Sc2Game.runGame settings participants |> Async.RunSynchronously + //let settings = + // { Sc2Game.GameSettings.OfUserSettings userSettings with + // Map = @"Ladder2017Season1\AbyssalReefLE.SC2Map" + // Realtime = true } + //Sc2Game.runGame settings participants |> Async.RunSynchronously 0 // return an integer exit code diff --git a/src/s2client-testCSharp/Program.cs b/src/s2client-testCSharp/Program.cs index cec22d6..32588dd 100644 --- a/src/s2client-testCSharp/Program.cs +++ b/src/s2client-testCSharp/Program.cs @@ -9,28 +9,28 @@ class Program { static void Main(string[] args) { - var userSettings = Sc2SettingsFile.settingsFromUserDir(); + //var userSettings = Sc2SettingsFile.settingsFromUserDir(); - var instanceSettings = Instance.StartSettings.OfUserSettings(userSettings); + //var instanceSettings = Instance.StartSettings.OfUserSettings(userSettings); - Func createInstance = - () => Runner.run(Instance.start(instanceSettings)); + //Func createInstance = + // () => Runner.run(Instance.start(instanceSettings)); - var participants = new Sc2Game.Participant[] { - Sc2Game.Participant.CreateParticipant( - createInstance(), - Race.Terran, - (state => (IEnumerable)new SC2APIProtocol.Action[] {})), - Sc2Game.Participant.CreateComputer(Race.Terran, Difficulty.Hard) - }; + //var participants = new Sc2Game.Participant[] { + // Sc2Game.Participant.CreateParticipant( + // createInstance(), + // Race.Terran, + // (state => (IEnumerable)new SC2APIProtocol.Action[] {})), + // Sc2Game.Participant.CreateComputer(Race.Terran, Difficulty.Hard) + //}; - var gameSettings = - Sc2Game.GameSettings.OfUserSettings(userSettings) - .WithMap(@"Ladder2017Season1\AbyssalReefLE.SC2Map") - .WithRealtime(true); + //var gameSettings = + // Sc2Game.GameSettings.OfUserSettings(userSettings) + // .WithMap(@"Ladder2017Season1\AbyssalReefLE.SC2Map") + // .WithRealtime(true); // Runs the game to the end with the given bots / map and configuration - Runner.run(Sc2Game.runGame(gameSettings, participants)); + //Runner.run(Sc2Game.runGame(gameSettings, participants)); } } }