author | unc0rr |
Wed, 28 Jun 2006 18:27:42 +0000 | |
changeset 71 | 5f56c6979496 |
parent 4 | bcbd7adb4e4b |
permissions | -rw-r--r-- |
(* * Hedgewars, a worms-like game * Copyright (c) 2004, 2005 Andrey Korotaev <unC0Rr@gmail.com> * * 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.