diff -r ffe4ad26a64c -r bcbd7adb4e4b hedgewars/uPlayers.pas --- a/hedgewars/uPlayers.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/uPlayers.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,191 +1,191 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit uPlayers; -interface -uses windows, WinSock; -type PPlayer = ^TPlayer; - PTeam = ^TTeam; - TTeam = record - hhs: array[0..7] of TPoint; - hhCount: LongWord; - end; - TPlayer = record - socket: TSocket; - NextPlayer, PrevPlayer: PPlayer; - Name: string[31]; - inbuf: string; - isme: boolean; - CurrTeam: LongWord; - TeamCount: LongWord; - Teams: array[0..3] of TTeam - end; - -function AddPlayer(sock: TSocket): PPlayer; -procedure DeletePlayer(Player: PPlayer); -function FindPlayerbySock(sock: TSocket): PPlayer; -procedure SendAll(s: shortstring); -procedure SendAllButOne(Player: PPlayer; s: shortstring); -procedure SelectFirstCFGTeam; -procedure SelectNextCFGTeam; -function GetTeamCount: Longword; -procedure ConfCurrTeam(s: shortstring); -procedure SendConfig(player: PPlayer); - -var CurrCFGPlayer: PPlayer; - -implementation -uses uServerMisc, uNet, SysUtils; -var PlayersList: PPlayer = nil; - -function AddPlayer(sock: TSocket): PPlayer; -begin -New(Result); -TryDo(Result <> nil, 'Error adding player!'); -FillChar(Result^, sizeof(TPlayer), 0); -Result.socket:= sock; -Result.TeamCount:= 2; -if PlayersList = nil then begin PlayersList:= Result; result.isme:= true end - else begin - PlayersList.PrevPlayer:= Result; - Result.NextPlayer:= PlayersList; - PlayersList:= Result - end -end; - -procedure DeletePlayer(Player: PPlayer); -begin -if Player = nil then OutError('Trying remove nil player!', false); -if Player.NextPlayer <> nil then Player.NextPlayer.PrevPlayer:= Player.PrevPlayer; -if Player.PrevPlayer <> nil then Player.PrevPlayer.NextPlayer:= Player.NextPlayer - else begin - PlayersList:= Player^.NextPlayer; - if PlayersList <> nil then PlayersList.PrevPlayer:= nil - end; -Dispose(Player) -end; - -function FindPlayerbySock(sock: TSocket): PPlayer; -begin -Result:= PlayersList; -while (Result<>nil)and(Result.socket<>sock) do - Result:= Result.NextPlayer -end; - -procedure SendAll(s: shortstring); -var p: PPlayer; -begin -p:= PlayersList; -while p <> nil do - begin - SendSock(p.socket, s); - p:= p.NextPlayer - end; -end; - -procedure SendAllButOne(Player: PPlayer; s: shortstring); -var p: PPlayer; -begin -p:= Player.NextPlayer; -while p <> nil do - begin - SendSock(p.socket, s); - p:= p.NextPlayer - end; -p:= PlayersList; -while p <> Player do - begin - SendSock(p.socket, s); - p:= p.NextPlayer - end; -end; - -function GetTeamCount: Longword; -var p: PPlayer; -begin -p:= PlayersList; -Result:= 0; -while p <> nil do - begin - inc(Result, p.TeamCount); - p:= p.NextPlayer - end; -end; - -procedure SelectFirstCFGTeam; -begin -CurrCFGPlayer:= PlayersList -end; - -procedure SelectNextCFGTeam; -begin -if CurrCFGPlayer = nil then OutError('Trying select next on nil current', true); -if Succ(CurrCFGPlayer.CurrTeam) < CurrCFGPlayer.TeamCount then inc(CurrCFGPlayer.CurrTeam) - else CurrCFGPlayer:= CurrCFGPlayer.NextPlayer -end; - -procedure ConfCurrTeam(s: shortstring); -begin -if CurrCFGPlayer = nil then OutError('Trying select next on nil current', true); -case s[1] of - 'h': with CurrCFGPlayer.Teams[CurrCFGPlayer.CurrTeam] do - begin - hhs[hhCount].X:= PLongWord(@s[2])^; - hhs[hhCount].Y:= PLongWord(@s[6])^; - inc(hhCount); - end; - end; -end; - -procedure SendConfig(player: PPlayer); -var p: PPlayer; - i, t: integer; -begin -p:= PlayersList; -while p <> nil do - begin - for t:= 0 to Pred(player.TeamCount) do - begin - SendSock(player.socket, 'eaddteam'); - if p = player then SendSock(player.socket, '@') - else SendSock(player.socket, 'erdriven'); - for i:= 0 to Pred(player.Teams[t].hhCount) do - SendSock(player.socket, Format('eadd hh%d %d %d %d',[i, p.Teams[t].hhs[i].X, p.Teams[t].hhs[i].Y, 0])); - Sendsock(player.socket, Format('ecolor %d',[random($A0A0A0)+$5F5F5F])) - end; - p:= p.NextPlayer - end -end; - - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * Distributed under the terms of the BSD-modified licence: + * + * Permission is hereby granted, free of charge, to any person obtaining a copy + * of this software and associated documentation files (the "Software"), to deal + * with the Software without restriction, including without limitation the + * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or + * sell copies of the Software, and to permit persons to whom the Software is + * furnished to do so, subject to the following conditions: + * + * 1. Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * 3. The name of the author may not be used to endorse or promote products + * derived from this software without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED + * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO + * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, + * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, + * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; + * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, + * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR + * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF + * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + *) + +unit uPlayers; +interface +uses windows, WinSock; +type PPlayer = ^TPlayer; + PTeam = ^TTeam; + TTeam = record + hhs: array[0..7] of TPoint; + hhCount: LongWord; + end; + TPlayer = record + socket: TSocket; + NextPlayer, PrevPlayer: PPlayer; + Name: string[31]; + inbuf: string; + isme: boolean; + CurrTeam: LongWord; + TeamCount: LongWord; + Teams: array[0..3] of TTeam + end; + +function AddPlayer(sock: TSocket): PPlayer; +procedure DeletePlayer(Player: PPlayer); +function FindPlayerbySock(sock: TSocket): PPlayer; +procedure SendAll(s: shortstring); +procedure SendAllButOne(Player: PPlayer; s: shortstring); +procedure SelectFirstCFGTeam; +procedure SelectNextCFGTeam; +function GetTeamCount: Longword; +procedure ConfCurrTeam(s: shortstring); +procedure SendConfig(player: PPlayer); + +var CurrCFGPlayer: PPlayer; + +implementation +uses uServerMisc, uNet, SysUtils; +var PlayersList: PPlayer = nil; + +function AddPlayer(sock: TSocket): PPlayer; +begin +New(Result); +TryDo(Result <> nil, 'Error adding player!'); +FillChar(Result^, sizeof(TPlayer), 0); +Result.socket:= sock; +Result.TeamCount:= 2; +if PlayersList = nil then begin PlayersList:= Result; result.isme:= true end + else begin + PlayersList.PrevPlayer:= Result; + Result.NextPlayer:= PlayersList; + PlayersList:= Result + end +end; + +procedure DeletePlayer(Player: PPlayer); +begin +if Player = nil then OutError('Trying remove nil player!', false); +if Player.NextPlayer <> nil then Player.NextPlayer.PrevPlayer:= Player.PrevPlayer; +if Player.PrevPlayer <> nil then Player.PrevPlayer.NextPlayer:= Player.NextPlayer + else begin + PlayersList:= Player^.NextPlayer; + if PlayersList <> nil then PlayersList.PrevPlayer:= nil + end; +Dispose(Player) +end; + +function FindPlayerbySock(sock: TSocket): PPlayer; +begin +Result:= PlayersList; +while (Result<>nil)and(Result.socket<>sock) do + Result:= Result.NextPlayer +end; + +procedure SendAll(s: shortstring); +var p: PPlayer; +begin +p:= PlayersList; +while p <> nil do + begin + SendSock(p.socket, s); + p:= p.NextPlayer + end; +end; + +procedure SendAllButOne(Player: PPlayer; s: shortstring); +var p: PPlayer; +begin +p:= Player.NextPlayer; +while p <> nil do + begin + SendSock(p.socket, s); + p:= p.NextPlayer + end; +p:= PlayersList; +while p <> Player do + begin + SendSock(p.socket, s); + p:= p.NextPlayer + end; +end; + +function GetTeamCount: Longword; +var p: PPlayer; +begin +p:= PlayersList; +Result:= 0; +while p <> nil do + begin + inc(Result, p.TeamCount); + p:= p.NextPlayer + end; +end; + +procedure SelectFirstCFGTeam; +begin +CurrCFGPlayer:= PlayersList +end; + +procedure SelectNextCFGTeam; +begin +if CurrCFGPlayer = nil then OutError('Trying select next on nil current', true); +if Succ(CurrCFGPlayer.CurrTeam) < CurrCFGPlayer.TeamCount then inc(CurrCFGPlayer.CurrTeam) + else CurrCFGPlayer:= CurrCFGPlayer.NextPlayer +end; + +procedure ConfCurrTeam(s: shortstring); +begin +if CurrCFGPlayer = nil then OutError('Trying select next on nil current', true); +case s[1] of + 'h': with CurrCFGPlayer.Teams[CurrCFGPlayer.CurrTeam] do + begin + hhs[hhCount].X:= PLongWord(@s[2])^; + hhs[hhCount].Y:= PLongWord(@s[6])^; + inc(hhCount); + end; + end; +end; + +procedure SendConfig(player: PPlayer); +var p: PPlayer; + i, t: integer; +begin +p:= PlayersList; +while p <> nil do + begin + for t:= 0 to Pred(player.TeamCount) do + begin + SendSock(player.socket, 'eaddteam'); + if p = player then SendSock(player.socket, '@') + else SendSock(player.socket, 'erdriven'); + for i:= 0 to Pred(player.Teams[t].hhCount) do + SendSock(player.socket, Format('eadd hh%d %d %d %d',[i, p.Teams[t].hhs[i].X, p.Teams[t].hhs[i].Y, 0])); + Sendsock(player.socket, Format('ecolor %d',[random($A0A0A0)+$5F5F5F])) + end; + p:= p.NextPlayer + end +end; + + +end.