1 (*

     2  * Hedgewars, a worms-like game

     3  * Copyright (c) 2004, 2005 Andrey Korotaev <unC0Rr@gmail.com>

     4  *

     5  * Distributed under the terms of the BSD-modified licence:

     6  *

     7  * Permission is hereby granted, free of charge, to any person obtaining a copy

     8  * of this software and associated documentation files (the "Software"), to deal

     9  * with the Software without restriction, including without limitation the

    10  * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or

    11  * sell copies of the Software, and to permit persons to whom the Software is

    12  * furnished to do so, subject to the following conditions:

    13  *

    14  * 1. Redistributions of source code must retain the above copyright notice,

    15  *    this list of conditions and the following disclaimer.

    16  * 2. Redistributions in binary form must reproduce the above copyright notice,

    17  *    this list of conditions and the following disclaimer in the documentation

    18  *    and/or other materials provided with the distribution.

    19  * 3. The name of the author may not be used to endorse or promote products

    20  *    derived from this software without specific prior written permission.

    21  *

    22  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED

    23  * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF

    24  * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO

    25  * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,

    26  * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,

    27  * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;

    28  * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,

    29  * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR

    30  * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF

    31  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

    32  *)

    33 

    34 unit uPlayers;

    35 interface

    36 uses windows, WinSock;

    37 type PPlayer = ^TPlayer;

    38      PTeam = ^TTeam;

    39      TTeam = record

    40              hhs: array[0..7] of TPoint;

    41              hhCount: LongWord;

    42              end;

    43      TPlayer = record

    44                socket: TSocket;

    45                NextPlayer, PrevPlayer: PPlayer;

    46                Name: string[31];

    47                inbuf: string;

    48                isme: boolean;

    49                CurrTeam: LongWord;

    50                TeamCount: LongWord;

    51                Teams: array[0..3] of TTeam

    52                end;

    53 

    54 function AddPlayer(sock: TSocket): PPlayer;

    55 procedure DeletePlayer(Player: PPlayer);

    56 function FindPlayerbySock(sock: TSocket): PPlayer;

    57 procedure SendAll(s: shortstring);

    58 procedure SendAllButOne(Player: PPlayer; s: shortstring);

    59 procedure SelectFirstCFGTeam;

    60 procedure SelectNextCFGTeam;

    61 function GetTeamCount: Longword;

    62 procedure ConfCurrTeam(s: shortstring);

    63 procedure SendConfig(player: PPlayer);

    64 

    65 var CurrCFGPlayer: PPlayer;

    66 

    67 implementation

    68 uses uServerMisc, uNet, SysUtils;

    69 var PlayersList: PPlayer = nil;

    70 

    71 function AddPlayer(sock: TSocket): PPlayer;

    72 begin

    73 New(Result);

    74 TryDo(Result <> nil, 'Error adding player!');

    75 FillChar(Result^, sizeof(TPlayer), 0);

    76 Result.socket:= sock;

    77 Result.TeamCount:= 2;

    78 if PlayersList = nil then begin PlayersList:= Result; result.isme:= true end

    79                      else begin

    80                      PlayersList.PrevPlayer:= Result;

    81                      Result.NextPlayer:= PlayersList;

    82                      PlayersList:= Result

    83                      end

    84 end;

    85 

    86 procedure DeletePlayer(Player: PPlayer);

    87 begin

    88 if Player = nil then OutError('Trying remove nil player!', false);

    89 if Player.NextPlayer <> nil then Player.NextPlayer.PrevPlayer:= Player.PrevPlayer;

    90 if Player.PrevPlayer <> nil then Player.PrevPlayer.NextPlayer:= Player.NextPlayer

    91                         else begin

    92                         PlayersList:= Player^.NextPlayer;

    93                         if PlayersList <> nil then PlayersList.PrevPlayer:= nil

    94                         end;

    95 Dispose(Player)

    96 end;

    97 

    98 function FindPlayerbySock(sock: TSocket): PPlayer;

    99 begin

   100 Result:= PlayersList;

   101 while (Result<>nil)and(Result.socket<>sock) do

   102       Result:= Result.NextPlayer

   103 end;

   104 

   105 procedure SendAll(s: shortstring);

   106 var p: PPlayer;

   107 begin

   108 p:= PlayersList;

   109 while p <> nil do

   110       begin

   111       SendSock(p.socket, s);

   112       p:= p.NextPlayer

   113       end;

   114 end;

   115 

   116 procedure SendAllButOne(Player: PPlayer; s: shortstring);

   117 var p: PPlayer;

   118 begin

   119 p:= Player.NextPlayer;

   120 while p <> nil do

   121       begin

   122       SendSock(p.socket, s);

   123       p:= p.NextPlayer

   124       end;

   125 p:= PlayersList;

   126 while p <> Player do

   127       begin

   128       SendSock(p.socket, s);

   129       p:= p.NextPlayer

   130       end;

   131 end;

   132 

   133 function GetTeamCount: Longword;

   134 var p: PPlayer;

   135 begin

   136 p:= PlayersList;

   137 Result:= 0;

   138 while p <> nil do

   139       begin

   140       inc(Result, p.TeamCount);

   141       p:= p.NextPlayer

   142       end;

   143 end;

   144 

   145 procedure SelectFirstCFGTeam;

   146 begin

   147 CurrCFGPlayer:= PlayersList

   148 end;

   149 

   150 procedure SelectNextCFGTeam;

   151 begin

   152 if CurrCFGPlayer = nil then OutError('Trying select next on nil current', true);

   153 if Succ(CurrCFGPlayer.CurrTeam) < CurrCFGPlayer.TeamCount then inc(CurrCFGPlayer.CurrTeam)

   154                                                           else CurrCFGPlayer:= CurrCFGPlayer.NextPlayer

   155 end;

   156 

   157 procedure ConfCurrTeam(s: shortstring);

   158 begin

   159 if CurrCFGPlayer = nil then OutError('Trying select next on nil current', true);

   160 case s[1] of

   161      'h': with CurrCFGPlayer.Teams[CurrCFGPlayer.CurrTeam] do

   162                begin

   163                hhs[hhCount].X:= PLongWord(@s[2])^;

   164                hhs[hhCount].Y:= PLongWord(@s[6])^;

   165                inc(hhCount);

   166                end;

   167      end;

   168 end;

   169 

   170 procedure SendConfig(player: PPlayer);

   171 var p: PPlayer;

   172     i, t: integer;

   173 begin

   174 p:= PlayersList;

   175 while p <> nil do

   176       begin

   177       for t:= 0 to Pred(player.TeamCount) do

   178           begin

   179           SendSock(player.socket, 'eaddteam');

   180           if p = player then SendSock(player.socket, '@')

   181                         else SendSock(player.socket, 'erdriven');

   182           for i:= 0 to Pred(player.Teams[t].hhCount) do

   183               SendSock(player.socket, Format('eadd hh%d %d %d %d',[i, p.Teams[t].hhs[i].X, p.Teams[t].hhs[i].Y, 0]));

   184           Sendsock(player.socket, Format('ecolor %d',[random($A0A0A0)+$5F5F5F]))

   185           end;

   186       p:= p.NextPlayer

   187       end

   188 end;

   189 

   190 

   191 end.