(*

 * 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.