home *** CD-ROM | disk | FTP | other *** search
Attribute VB_Name = "MainTron" ' ' Xceed Winsock Library Sample: Tron Sample ' Copyright (c) 2000 Xceed Software Inc. ' ' [Main code module] ' ' This sample application for the Xceed Winsock Library demonstrates ' service advertising and service lookup using the SAP protocol, as ' well as connectionless asynchronous byte transfers using the IPX ' protocol. All transfer events are handled via the "Implements" ' statement. To successfully create a game, you must have the SAP ' protocol installed on your system. Otherwise, you can only list ' and join games. ' ' This file is part of the Xceed Winsock Library Samples. ' The source code in this file is only intended as a supplement ' to Xceed Winsock Library's documentation, and is provided "as is", ' without warranty of any kind, either expressed or implied. ' Option Explicit ' The game interface form itself Public GameForm As FrmTron ' Variables that determine the main game modes Public HostMode As HostModes Public GameMode As GameModes ' Game data variables for hosting a game Public Game As GameData ' Master game parameters Public Players(1 To 8) As Player ' Server: all player data here, Client: local player only ' Local player information Public LocalPlayer As Integer ' Index of local player in the Players array Public LocalIteration As Long ' The latest iteration info our client has received Public Colors As New Collection ' The colors for each player, 1:1 with Players array Public LastLocalPlayerDirection As Directions ' Updated as soon as an arrow key is hit Public LastLocalPlayerIsBoosting As Integer ' Updated when nitro boost key state changes Public LastLocalPlayerIsBraking As Integer ' Updated when brake key state changes ' General gameplay constants Public Const MaxNitro = 16 ' Amount of nitro boost at start of each round Public Const MaxBrakes = 30 ' Amount of braking power at start of each round Public Const MaxLifeSavers = 3 ' Amount of Life Savers at start of each round ' Networking constants Public Const GameGuid = "{600D69E1-E89D-11d3-BF75-00600807163F}" ' Guid for advertising the game service ' Variables for listing and joining available games Public GameAddresses() As Address ' Addresses of the game servers found Public GameNames() As String ' Names of players hosting the games Public GamesFound As Integer ' Number of game servers found Public JoinGameSubmenuMaxIndex As Integer ' Number of "Join game" submenu items already created ' ================================================== ' Main application loop ' ================================================== Public Sub Main() HostMode = hmIdle ' not hosting, not joined. GameMode = gmIdle ' not playing, not paused. Call InitColors ' Initialise player colors ' Instantiate and load the game interface form Set GameForm = New FrmTron Load GameForm Call GameForm.Display Call GameForm.SetState(isNoGameHostedOrJoined) Do DoEvents Loop Until HostMode = hmQuitting End Sub ' Unload and free the game interface form ' Public Sub CloseAll() Unload GameForm Set GameForm = Nothing End Sub ' Set up player colors ' Private Sub InitColors() Colors.Add vbBlue Colors.Add vbRed Colors.Add vbGreen Colors.Add &HAAAAAA ' grey Colors.Add vbBlack Colors.Add vbMagenta Colors.Add vbCyan Colors.Add &HC74993 ' Purple End Sub ' Wait a specified amount of time, in milliseconds ' Sub Wait(N As Integer) Dim T As Double T = Timer Do DoEvents Loop Until ((Timer - T) * 1000) > N End Sub ' This game server procedure handles the activity before and after ' a round is played. ' Public Sub StartRound() Dim Winner As Integer ' The player that won the round Dim RoundData As String ' The starting information of a round Dim Pnum As Integer Dim T As Double Call InitialiseRound ' Set up initial positions of the players ' Prepare the information about the round to send to the clients RoundData = "<round roundid=" & CStr(Game.CurrentRound) & " status=starting>" & vbCrLf For Pnum = 1 To 8 If Players(Pnum).IsAssigned Then RoundData = RoundData & " <player playerid=" & CStr(Pnum) & " name=" & Chr$(34) & Players(Pnum).Name & Chr$(34) & " >" & vbCrLf RoundData = RoundData & " <pos x=" & CStr(Players(Pnum).X) & " y=" & CStr(Players(Pnum).Y) & " />" & vbCrLf RoundData = RoundData & " </player>" & vbCrLf End If Next Pnum RoundData = RoundData & "</round>" & vbCrLf ' Send the round information to all the clients Call SendGameSignal(sRoundStarting, RoundData, DP_All) ' Wait 1 second or until all players have confirmed they are ' ready to start the round! T = Timer Do DoEvents Loop Until AllPlayersReadyToStart() Or ((Timer - T) > 0.99) ' If any player's haven't confirmed, remove them from the round. For Pnum = 1 To 8 If Players(Pnum).IsReadyToStart = False Then Players(Pnum).IsAlive = False Call SendGameSignal(sDroppedFromRound, "", Pnum) End If Players(Pnum).IterationsLagging = 0 Next Pnum ' Play the actual round! Winner = PlayRound() ' Send information to clients about the round's winner, and scores information If Winner = 0 Then Call SendGameSignal(sRoundCompleted, "None", DP_All) Else Players(Winner).Wins = Players(Winner).Wins + 1 Call SendGameSignal(sRoundCompleted, Players(Winner).Name, DP_All) For Pnum = 1 To 8 If Players(Pnum).IsAssigned Then Call SendGameSignal(sScoresInfo, Players(Pnum).Name & " has " & CStr(Players(Pnum).Wins) & " wins, " & CStr(Players(Pnum).Crashes) & " crashes.", DP_All) End If Next Pnum End If Game.CurrentRound = Game.CurrentRound + 1 GameMode = gmIdle End Sub ' This procedure pauses a round (if we are a game server) or requests to ' pause a round (if we are a client) ' Public Sub PauseRound() ' Todo End Sub ' This function executes a game round and returns the player number that ' won the round. Returns 0 if there was no winner. ' Private Function PlayRound() As Integer Dim Pnum As Integer Dim Winner As Integer ' The player that won the round Dim PlayersAlive As Integer Dim Iteration As Long ' Count the number of players that are alive (that will play in this round) PlayersAlive = 0 For Pnum = 1 To 8 If Players(Pnum).IsAlive Then PlayersAlive = PlayersAlive + 1 Next Pnum ' Main loop Iteration = 0 Do ' Move the players according to their directions, nitro and brakes PlayersAlive = PlayersAlive - MovePlayers(Iteration) ' Wait a specified amount of time so the game doesn't go too fast! Call Wait(25) ' in milliseconds ' For each player that's lagging, wait a tiny amount of extra time For Pnum = 1 To 8 Call Wait(10 * Players(Pnum).IterationsLagging) Next Pnum ' Update the directions players are going according to the last ' communicated player control information signal. Call GetPlayerInputs ' Update the iteration number Iteration = Iteration + 1 Loop Until PlayersAlive < 2 Or HostMode = hmQuitting ' Check if there's anybody left alive... Winner = 0 For Pnum = 1 To 8 If Players(Pnum).IsAlive Then Winner = Pnum End If Next Pnum ' Return the results PlayRound = Winner End Function ' Set up initial players positions ' Private Sub InitialiseRound() Dim I As Integer Do For I = 1 To 8 If Players(I).IsAssigned Then Players(I).X = (Rnd * (Game.SizeX - 10)) + 5 Players(I).Y = (Rnd * (Game.SizeY - 10)) + 5 Players(I).Direction = Int(Rnd * 4) + 1 Players(I).IsAlive = True Players(I).IsReadyToStart = (Players(I).Name = "Computer") Or (I = LocalPlayer) ' Computer players and game server local player are always ready to start! Players(I).Nitro = MaxNitro Players(I).Brakes = MaxBrakes Players(I).LifeSavers = MaxLifeSavers Else Players(I).IsAlive = False End If Next I Loop Until PlayersFarEnough() End Sub ' Adds a new player and returns the player's color ' Private Function AddNewPlayer(Name As String, PlayerAddress As Address) As Integer Dim Slot As Integer For Slot = 1 To 8 If Players(Slot).IsAssigned = False Then Players(Slot).Name = Name Players(Slot).Color = Val(Colors.Item(Slot)) Players(Slot).Crashes = 0 Players(Slot).Wins = 0 If IsNull(PlayerAddress) Then Set Players(Slot).Addr = PlayerAddress Else Set Players(Slot).Addr = Nothing End If Players(Slot).IsAssigned = True Exit For End If Next Slot AddNewPlayer = Slot End Function ' Call this procedure to attempt to join a game that has been listed. ' GameNumber indexing starts at 1. ' Public Sub JoinGame(GameNumber As Integer) ' Set up PlayerTag, which is sent to server with every communication in order ' for the server to quickly and surely identify which player's signal it has received. PlayerTag = CStr(Timer * 100) ' Now use Xceed Winsock Library to set up our client socket ' and, if successful, we connect to game server. If SetUpClientSocket() Then Call ConnectToGameServer(GameNumber) End If End Sub ' This procedure sets up a game, runs the setup for the game server socket and ' then runs the game advertising function so that clients can find the game on the ' network. ' Public Sub CreateGame() HostMode = hmHosting ' Set up master game data Game.CurrentRound = 1 Game.SizeX = GameForm.picGameArea.ScaleWidth Game.SizeY = GameForm.picGameArea.ScaleHeight ' Set up the game interface Call GameForm.PrintInfo("Creating game...", False, vbRed) Call GameForm.SetState(isStartBusy) DoEvents ' Add local player to players list LocalPlayer = AddNewPlayer(GameForm.GetLocalName, Nothing) ' Call AddNewPlayer("Computer", Nothing) to add computer playrs (not good players!) Call GameForm.SetPlayerColor(Players(LocalPlayer).Color) ' Continue setting up game. If SetUpServerSocket() = True Then ' Set up server socket. Continue if success. If AdvertiseGame() = True Then ' Advertise game with SAP. Continue if success. Call GameForm.PrintInfo(GameForm.GetLocalName & "'s game created.", True, vbRed) Call GameForm.SetState(isGameHosted) Else HostMode = hmIdle End If Else HostMode = hmIdle End If End Sub ' This function unjoins a game, cleans up opened ressources ' If called with the ServerForced parameter set to True, it means ' that the server forced the unjoin and therefore we should not ' notify the server we have unjoined the game. ' Public Sub UnjoinGame(ServerForced As Boolean) If HostMode = hmJoined Then If Not ServerForced Then Call SendClientSignal(sUnjoining, "", True) ' True: make sure data is sent before client socket is destroyed. End If Call ShutdownClientSocket HostMode = hmIdle GameMode = gmIdle LocalPlayer = 0 End If End Sub ' This function unjoins a game, cleans up opened ressources ' Public Sub AbortGame() Dim Pnum As Integer Call SendGameSignal(sGameAborted, "", DP_All) ' Wait a bit to ensure signals have been sent out to clients before we ' proceed to close our server socket. Of course, it would be better to ' simply send the signals with the blocking "SendBytesTo" call as opposed ' to using "AsyncSendBytesTo" and waiting, but the SendGameSignal ' procedure has 3 such calls and we wanted to keep it simple. But don't ' worry, we use the proper technique in the NetClient.bas module when ' closing the client socket. Call Wait(250) ' in milliseconds Call ShutdownServerSocket HostMode = hmIdle For Pnum = 1 To 8 Players(Pnum).IsAssigned = False Next Pnum End Sub ' Move each player on the board based on their set directions, brakes and nitro, ' saving hem before crashing if they have lifesavers left. This function creates ' an XML-style string containing the new positions of all players and sends it ' to all the game's client players. ' Private Function MovePlayers(Iteration As Long) As Integer Dim Pnum As Integer Dim Deaths As Integer Dim AddX As Integer Dim AddY As Integer Dim PlayerDied As Boolean Dim NitroUpdate As Boolean Dim BrakesUpdate As Boolean Dim Speed As Long Dim IterationData As String ' Build the IterationData string which will be sent to the clients ' during a round update signal (sIteration) IterationData = "<iteration no=" & CStr(Iteration) & ">" & vbCrLf For Pnum = 1 To 8 If Players(Pnum).IsAlive Then NitroUpdate = False BrakesUpdate = False PlayerDied = False ' Check if player is not lagging 3 or more iterations behind. ' If not, then calculate player's speed. If yes, then freeze player. If (Iteration - LastPlayerReceivedIteration(Pnum)) < 3 Then Players(Pnum).IterationsLagging = 0 ' Check if player is nitro boosting or braking If Players(Pnum).IsBoosting And Players(Pnum).Nitro > 0 Then Speed = 2 + (Players(Pnum).Nitro Mod 8) Players(Pnum).Nitro = Players(Pnum).Nitro - 1 NitroUpdate = True ElseIf Players(Pnum).IsBraking And Players(Pnum).Brakes > 0 Then If (Players(Pnum).Brakes Mod 2) Then Speed = 0 Else Speed = 2 Players(Pnum).Brakes = Players(Pnum).Brakes - 1 BrakesUpdate = True Else Speed = 2 End If Else ' Lagging Players(Pnum).IterationsLagging = Players(Pnum).IterationsLagging + 1 Speed = 0 End If ' If the player is moving this iteration, perform necessary checks If Speed > 0 Then Select Case Players(Pnum).Direction Case dNorth AddX = 0 AddY = -Speed Case dSouth AddX = 0 AddY = Speed Case dEast AddX = Speed AddY = 0 Case dWest AddX = -Speed AddY = 0 End Select If GameForm.picGameArea.Point(Players(Pnum).X + AddX, Players(Pnum).Y + AddY) <> &HFFFFFF Then If Players(Pnum).LifeSavers > 0 Then ' Try to save player's life Players(Pnum).LifeSavers = Players(Pnum).LifeSavers - 1 Select Case Players(Pnum).Direction Case dNorth, dSouth ' we'll turn east or west to save life AddY = 0 If Rnd > 0.5 Then LastPlayerDirection(Pnum) = dEast Players(Pnum).Direction = dEast AddX = Speed Else LastPlayerDirection(Pnum) = dWest Players(Pnum).Direction = dWest AddX = -Speed End If Case dEast, dWest ' we'll turn north of south to save life AddX = 0 If Rnd > 0.5 Then LastPlayerDirection(Pnum) = dSouth Players(Pnum).Direction = dSouth AddY = Speed Else LastPlayerDirection(Pnum) = dNorth Players(Pnum).Direction = dNorth AddY = -Speed End If End Select PlayerDied = GameForm.picGameArea.Point(Players(Pnum).X + AddX, Players(Pnum).Y + AddY) <> &HFFFFFF Else PlayerDied = True End If If PlayerDied Then Players(Pnum).IsAlive = False Players(Pnum).Crashes = Players(Pnum).Crashes + 1 Deaths = Deaths + 1 End If Else Players(Pnum).X = Players(Pnum).X + AddX Players(Pnum).Y = Players(Pnum).Y + AddY End If End If ' Add the player's new position, or position of death to the ' iteration data to send for this move. IterationData also ' tells clients whether or not to update their brake and nitro gauges. IterationData = IterationData & " <player playerid=" & CStr(Pnum) & ">" & vbCrLf IterationData = IterationData & " <pos x=" & CStr(Players(Pnum).X) & " y=" & CStr(Players(Pnum).Y) & " />" & vbCrLf If PlayerDied Then IterationData = IterationData & " <status alive=FALSE " Else IterationData = IterationData & " <status alive=TRUE " End If If BrakesUpdate Then IterationData = IterationData & "updbrakes=" & CStr(Players(Pnum).Brakes) & " " End If If NitroUpdate Then IterationData = IterationData & "updnitro=" & CStr(Players(Pnum).Nitro) & " " End If IterationData = IterationData & "/>" & vbCrLf & " </player>" & vbCrLf End If Next Pnum IterationData = IterationData & "</iteration>" Call SendGameSignal(sIteration, IterationData, DP_All) MovePlayers = Deaths End Function ' This function indicates if two or more players are too close together ' in order to start a round. ' Public Function PlayersFarEnough() As Boolean Dim CurrentPlayer As Integer Dim CheckPlayer As Integer Dim DistX As Long Dim DistY As Long ' For each player, we check if there is at least 20 pixels distance between ' that player and the rest of the players in line to be checked. For CurrentPlayer = 1 To 7 ' Do not do outer loop on last player. If Players(CurrentPlayer).IsAlive Then For CheckPlayer = CurrentPlayer + 1 To 8 ' Check remaining players DistX = Players(CurrentPlayer).X - Players(CheckPlayer).X DistY = Players(CurrentPlayer).Y - Players(CheckPlayer).Y ' Use pythagoras theorem to calculate distance If ((DistX * DistX + DistY * DistY)) < 400 Then PlayersFarEnough = False Exit Function End If Next CheckPlayer End If Next CurrentPlayer PlayersFarEnough = True End Function ' This procedure handles game signals received from the server or from the ' client. ' ' Parameter Description ' =============== ================================================================ ' SignalPnum Indicates which player (in the Players array) the signal is for ' GS The game signal code ' Data XML-style data that accompanies the signal ' Public Sub ExecuteGameSignal(SignalPnum As Integer, GS As Signals, Data As String) Dim Pnum As Integer Select Case GS Case sIteration ' From server: An iteration of a game-time round has been received. Dim Player As PlayerUpdate LocalIteration = Val(Mid$(Data, InStr(Data, "no=") + 3)) For Pnum = 1 To 8 Player = ParsePlayerData(Data, Pnum) If Player.Found = True Then If Player.IsAlive Then GameForm.picGameArea.PSet (Player.X, Player.Y), Colors(Pnum) Else GameForm.picGameArea.Circle (Player.X, Player.Y), 2 End If If Pnum = LocalPlayer Then If Player.UpdateBrakes > 0 Then Call GameForm.SetBrakeGauge(Player.UpdateBrakes) End If If Player.UpdateNitro > 0 Then Call GameForm.SetNitroGauge(Player.UpdateNitro) End If End If End If Next Pnum ' Inform game server of local player's latest desired move If HostMode = hmJoined Then Call SendClientSignal(sPlayerControlUpdate, GetPlayerControlData(), False) ElseIf HostMode = hmHosting Then Call ExecuteGameSignal(LocalPlayer, sPlayerControlUpdate, GetPlayerControlData()) End If Case sPlayerControlUpdate ' From client: A player's latest desired move Dim Pos3 As Integer LastPlayerReceivedIteration(SignalPnum) = Val(Mid$(Data, InStr(Data, "iteration=") + 10)) Pos3 = InStr(Data, "<direction d=") LastPlayerDirection(SignalPnum) = Val(Mid$(Data, Pos3 + 13)) LastPlayerIsBoosting(SignalPnum) = InStr(Data, "isboosting") > 0 LastPlayerIsBraking(SignalPnum) = InStr(Data, "isbraking") > 0 Case sRoundStarting ' From server: A round is starting! Dim PlayerPos(8) As PlayerUpdate Dim Blinks As Integer Dim I As Integer Dim DW As Integer ' Clear and setup game field and interface GameMode = gmPlaying Call GameForm.SetState(isRoundStarted) Call GameForm.PrintInfo("Starting round " & CStr(Val(Mid$(Data, InStr(Data, "roundid=") + 8))) & "!", True, vbRed) Call GameForm.ClearDisplay Call GameForm.SetNitroGauge(MaxNitro) Call GameForm.SetBrakeGauge(MaxBrakes) ' Decode data sent from server For Pnum = 1 To 8 PlayerPos(Pnum) = ParsePlayerData(Data, Pnum) Next Pnum ' Display the starting player positions DW = GameForm.picGameArea.DrawWidth GameForm.picGameArea.DrawWidth = 10 For Blinks = 1 To 5 For Pnum = 1 To 8 If PlayerPos(Pnum).Found = True Then GameForm.picGameArea.PSet (PlayerPos(Pnum).X, PlayerPos(Pnum).Y), Colors(Pnum) End If Next Pnum Call Wait(300) ' in milliseconds For Pnum = 1 To 8 If PlayerPos(Pnum).Found = True Then GameForm.picGameArea.PSet (PlayerPos(Pnum).X, PlayerPos(Pnum).Y), vbWhite End If Next Pnum Call Wait(200) ' in milliseconds Next Blinks GameForm.picGameArea.DrawWidth = DW ' Notify the server that we are now ready to start receiving round iterations If HostMode = hmJoined Then Call SendClientSignal(sReadyToStart, "", True) End If Case sReadyToStart ' From client: Client is ready to start the round now. Players(SignalPnum).IsReadyToStart = True Case sDroppedFromRound ' From server: We missed this round due to slow acknowledgement Call GameForm.PrintInfo("Dropped from this game round...", True, vbRed) Case sRoundCompleted ' From server: The round is over! If Data = "None" Then Call GameForm.PrintInfo("Round over: no clear winner.", True, vbRed) Else Call GameForm.PrintInfo(Data & " wins the round!", True, vbRed) End If Call GameForm.SetState(isRoundFinished) GameMode = gmIdle Case sRoundPaused ' From server: The round has been paused. Call GameForm.SetState(isRoundPaused) Case sRoundUnpaused ' From server: The round has been unpaused. Call GameForm.SetState(isRoundStarted) Case sRequestRoundStart ' From client: A player has requested the start of a round! If GameMode = gmIdle Then StartRound End If Case sRequestJoinGame ' From client: A player wishes to join the game Dim SlotFound As Boolean Dim Pos As Integer Dim Pos2 As Integer ' Check if there are any free slots in the Players array For Pnum = 1 To 8 If Players(Pnum).IsAssigned = False Then Players(Pnum).IsAssigned = True Set Players(Pnum).Addr = NewPlayerAddress Pos = InStr(Data, "name=" & Chr$(34)) Pos2 = InStr(Pos + 6, Data, Chr$(34)) Players(Pnum).Name = Mid$(Data, Pos + 6, Pos2 - Pos - 6) Pos = InStr(Data, "tag=") Players(Pnum).Tag = NewPlayerTag SlotFound = True Exit For End If Next Pnum ' Inform the client whether they can join in or not If SlotFound Then Call SendGameSignal(sWelcome, "<player playerid=" & CStr(Pnum) & "></player>", Pnum) Call SendGameSignal(sServerPrintInfo, Players(Pnum).Name & " has joined the game.", DP_All) Else Call SendGameSignal(sGameFull, "", DP_Last) End If Case sWelcome ' From server: Player has succesfully joined the game LocalPlayer = Val(Mid$(Data, InStr(Data, "playerid=") + 9)) Call GameForm.SetState(isGameJoined) Call GameForm.ClearDisplay Call GameForm.SetPlayerColor(Colors(LocalPlayer)) HostMode = hmJoined Case sGameFull ' From server: Player could not join the game Call GameForm.PrintInfo("That game is full! Not joined.", True, vbRed) Case sGameAborted ' From server: The game has been aborted, player no longer in game. Call GameForm.PrintInfo("The game has been aborted.", True, vbRed) Call GameForm.SetState(isNoGameHostedOrJoined) Call UnjoinGame(True) Case sClientChat ' From client: Request to say a chat phrase Call SendGameSignal(sChatPhrase, Players(SignalPnum).Name & "> " & Data, DP_All) Case sChatPhrase ' From server: A chat phrase to display on the game interface Call GameForm.PrintInfo(Data, False, vbBlack) Case sServerPrintInfo ' From server: An important message to display on the game interface Call GameForm.PrintInfo(Data, True, vbRed) Case sScoresInfo ' From server: Scoring information to print out Call GameForm.PrintInfo(Data, False, vbBlue) Case sUnjoining ' From client: A notification that the player is leaving the game Players(SignalPnum).IsAssigned = False Call SendGameSignal(sServerPrintInfo, Players(SignalPnum).Name & " left the game.", DP_All) End Select End Sub ' Final preparations in order to make a clean exit of the application ' Public Sub QuitApplication() If HostMode = hmHosting Then Call AbortGame ElseIf HostMode = hmJoined Then Call UnjoinGame(False) End If HostMode = hmQuitting End Sub ' This procedure returns a string containing the last known direction the ' player has tried to go to. The string is to be sent to the game server. Public Function GetPlayerControlData() As String Dim Data As String Data = "<controls iteration=" & CStr(LocalIteration) & ">" Data = Data & " <direction d=" & CStr(LastLocalPlayerDirection) & " />" If LastLocalPlayerIsBoosting Then Data = Data & " <isboosting />" If LastLocalPlayerIsBraking Then Data = Data & " <isbraking />" Data = Data & "</controls>" GetPlayerControlData = Data End Function ' This function checks if all the players that are assigned to the game ' have confirmed they are ready to start the round the server just told ' them is starting. ' Function AllPlayersReadyToStart() As Boolean Dim AllReady As Boolean Dim Pnum As Integer AllReady = True For Pnum = 1 To 8 If Players(Pnum).IsAssigned = True And Players(Pnum).IsReadyToStart = False Then AllReady = False End If Next Pnum End Function 
