program server;

{$APPTYPE CONSOLE}

uses
   SysUtils,
   dll39;

var
   port : Word = 12345; {порт сервера}
   sock, newusersock, newmes, xx, yy, shoot_x, shoot_y :  Double; {Сокет сервера, сокет нового игрока, идентификатор нового сообщения, координаты}
   users : Byte = 0; {кол-во игроков на серве}
   users_list, x_list, y_list : array[0..16] of Double; {массив сокетов}{массивы координат}
   logins_list : array[0..16] of ShortString; {массив логинов}
   newuserid, mestype, mesuserid: Byte; {ИД нового игрока, первый (кейсовый) байт сообщения, ИД игрока отославшего сообщение}
   i : Integer; {переменная для циклов for и прочей билеберды}
   angle, hp : Byte; {угол поворота, ХП}

function NewId(): Byte; {геним ИД}
var i : Byte;
begin
   for i := 0 to 16 do
     begin
       if users_list[i] = 0 then Result := i;
     end;
end;

procedure SendToAll (m : Byte); {процедура отсылки ВСЕМ игрокам, кроме m}
var i : Byte;
begin
   for i := 0 to 16 do
   begin
     if not(users_list[i] = 0) and not(m=i) then
      begin
        MessageSend(users_list[i], 0, 0, 0);
      end;
   end;
end;

begin

   Writeln('Test Delphi Server v 0.1');
   Writeln('Created by AgentX001');
   sock := TcpListen(port, 16, 1); {открываем сокет}

   if sock < 1 then
     begin
       Writeln('Error to listen port ',port);
       Exit;
     end;

   Writeln('Port ', port, ' listening!');

   while (true) do
     begin
       newusersock := TcpAccept(sock, 1); {новенький...}
       if newusersock > 0 then
         begin
           if users < 16 then
             begin
               users := users + 1;
               newuserid := NewId();
               users_list[newuserid] := newusersock;
               Writeln('New user, ID=',newuserid);
               ClearBuffer(0);
               WriteByte(newuserid, 0);
               WriteByte(users-1,0);
               for i:=0 to 16 do if not(users_list[i] = 0) and not(i=newuserid) then
                 begin
                   WriteByte(i,0);
                   Writebyte(x_list[i], 0);
                   Writebyte(y_list[i], 0);
                 end;
               MessageSend(newusersock,0,0,0);
               ClearBuffer(0); {шлём всем ИД новенького}
               WriteByte(0,0);
               WriteByte(newuserid,0);
               SendToAll(newuserid);
             end
           else Writeln('Users is max!');
         end;

         for mesuserid := 0 to 16 do if not(users_list[mesuserid] = 0) then
         begin
           newmes := MessageRecieve(users_list[mesuserid],0,0);
           if newmes > 0 then
             begin
               mestype := Round(ReadByte(0));
               case mestype of
                 0 : {кто-то отрубился... Вот козёл:)}
                 begin
                   users_list[mesuserid] := 0;
                   Writeln('User ',mesuserid,' disconnected!');
                   ClearBuffer(0);
                   WriteByte(1,0);
                   WriteByte(mesuserid,0);
                   SendToAll(17);
                   users_list[mesuserid]:=0;
                   users := users - 1;
                 end;

                 1: {чьи-то координаты}
                 begin
                   xx := Readbyte(0);
                   yy := Readbyte(0);
                   ClearBuffer(0);
                   WriteByte(2,0);
                   WriteByte(mesuserid,0);
                   Writebyte(xx,0);
                   Writebyte(yy,0);
                   SendToAll(mesuserid);
                   x_list[mesuserid] := xx;
                   y_list[mesuserid] := yy;
                 end;

                 2: {чейто угол и ХП}
                 begin
                   angle := Round(ReadByte(0));
                   hp := Round(ReadByte(0));
                   ClearBuffer(0);
                   WriteByte(3, 0);
                   WriteByte(mesuserid,0);
                   WriteByte(angle, 0);
                   WriteByte(hp,0);
                   SendToAll(mesuserid);;
                 end;

                 3: {кто-то шмальнул}
                 begin
                   xx := ReaduShort(0);
                   yy := ReaduShort(0);
                   shoot_x := ReaduShort(0);
                   shoot_y := ReaduShort(0);
                   ClearBuffer(0);
                   WriteByte(4,0);
                   WriteByte(mesuserid,0);
                   WriteuShort(xx,0);
                   WriteuShort(yy,0);
                   WriteuShort(shoot_x,0);
                   WriteuShort(shoot_y,0);
                   SendToAll(mesuserid);
                 end;   
             end;
         end;
     end;
   end
end.

program server;

{$APPTYPE CONSOLE}

uses
   SysUtils,
   dll39;

type
   ar = array [0..256] of double;

var
   dist, dir, x, y, angle, tmpid, socket, messag, listen, bytes, bytes2 : double;
   port, id : word;
   len : byte;
   str : ansistring;
   i, k : integer;
   userlist, idlist : ar;

function listfind(a: ar; b: double) : smallint;
var k, i: smallint;
begin
   i := 0;
   for k := 0 to 258 do
   begin
     if not(a[i] = b) then
       i := i + 1
     else
       result := i;
   end;
end;

function listdel(a: ar; b: byte) : ar;
var i, size: word;
begin
   size := listfind(a, 0);
   for i := b to size do
     a[i] := a[i + 1];
   size := size - 1;
   result := a;
end;

function listadd(a: ar; b: integer) : ar;
var i, size: word;
begin
   size := listfind(a, 0);
   for i := 0 to size do
   begin
     if (a[i] = 0) then
     begin
       a[i] := b;
       size := size + 1;
       result := a;
     end;
     if (a[i] = b) then
       break;
   end;
end;

procedure sendstring(a: ansistring; b : double); // Процедура отправки строки (sendstring('Ваш текст', socket))
var i: byte;
begin
   clearbuffer(0);
   str := a;
   len := length(str);
   writebyte(len, 0);
   for i := 1 to len do
     writebyte(ord(str[i]), 0);
   messagesend(b, '', 0, 0);
end;

begin
   id := 1;
   write('by Fil. 39dll.ru'#10#13'Welcome to the server (v002a)! xD'#10#13#10#13'enter the port... ');
   read(port);
   listen := tcplisten(port, 256, 1);
   if (listen = 0) then
     writeln('listen port... fail!')
   else
     writeln('listen port... success!'#10#13);
   while(true) do
   begin
     socket := tcpaccept(listen, 1);
     if not(socket < 0) then
     begin
       messag := messagerecieve(socket, 0, 0);
       if (messag > 0) then
       begin
         bytes := readbyte(0);
         if (bytes = 0) then
           writeln('admin connected! ', round(socket));
           {Тут потом будет поддрежка админ-функций}
         if (bytes = 1) then
         begin
           writeln('client connected! ', round(socket));
           clearbuffer(0);
           writebyte(1, 0);
           writebyte(id, 0);
           messagesend(socket, '', 0, 0);
           idlist := listadd(idlist, id);
           {Отправка id всех остальных игроков новому игроку}
           if not(userlist[0] = 0) then
           begin
             {Отправка новому игроку id всех игроков}
             clearbuffer(0);
             writebyte(2, 0);
             writebyte(listfind(userlist, 0), 0);
             for i := 0 to listfind(userlist, 0) - 1 do
               writebyte(round(idlist[i]), 0);
             messagesend(socket, '', 0, 0);
             {Отправка всем id нового игрока}
             clearbuffer(0) ;
             writebyte(3, 0);
             writebyte(id, 0);
             for i := 0 to listfind(userlist, 0) - 1 do
               messagesend(userlist[i], '', 0, 0);
           end;
           userlist := listadd(userlist, round(socket)); // Добавляем socket игрока в массив
           id := id + 1;
         end;
       end;
     end;
     for i := 0 to listfind(userlist, 0) do
     begin
       messag := messagerecieve(userlist[i], 0, 0);
       if (messag > 0) then
       begin
         writeln('received ', round(messag), ' bytes');
         bytes := round(readbyte(0));
         if (bytes = 0) then // Пришло сообщение от контролера
         begin
           bytes2 := round(readbyte(0));
           if (bytes2 = 0) then // Выключить сервер
             exit;
           if (bytes2 = 1) then // Запрос количества игроков
           begin
             clearbuffer(0);
             writebyte(0, 0);
             writebyte(listfind(userlist, 0), 0);
             messagesend(userlist[i], '', 0, 0);
           end;
         end;
         if (bytes = 1) then // Игрок ушел с сервера
         begin
           writeln('client left the server! ', round(userlist[i]));
           userlist := listdel(userlist, i); // Удаляем id игрока из массива
           clearbuffer(0);
           writebyte(5, 0);
           writebyte(idlist[i], 0);
           for k := 0 to listfind(userlist, 0) - 1 do
             messagesend(userlist[k], '', 0, 0);
           idlist := listdel(idlist, i);
         end;
         if (bytes = 2) then // Отправка данных о игроке (id, x, y) всем остальным игрокам
         begin
           tmpid := round(readbyte(0));
           x := round(readshort(0));
           y := round(readshort(0));
           clearbuffer(0);
           writebyte(4, 0);
           writebyte(tmpid, 0);
           writeshort(x, 0);
           writeshort(y, 0);
           for k := 0 to listfind(userlist, 0) - 1 do
           begin
             if not(userlist[i] = userlist[k]) then
               messagesend(userlist[k], '', 0, 0);
           end;
         end;
         if (bytes = 3) then // Отправка всем игрокам image_angle игрока
         begin
           tmpid := round(readbyte(0));
           angle := round(readbyte(0));
           clearbuffer(0);
           writebyte(6, 0);
           writebyte(tmpid, 0);
           writebyte(angle, 0);
           for k := 0 to listfind(userlist, 0) - 1 do
             if not(userlist[i] = userlist[k]) then
               messagesend(userlist[k], '', 0, 0);
         end;
         if (bytes = 4) then // Пуля задела игрока
         begin
           tmpid := round(readbyte(0));
           clearbuffer(0);
           writebyte(7, 0);
           messagesend(userlist[listfind(idlist, tmpid)], '', 0, 0);
         end;
         if (bytes = 5) then // Какой-то игрок стреляет (нужно просто для отображения эффекта)
         begin
           tmpid := round(readbyte(0));
           dir := round(readbyte(0));
           dist := round(readbyte(0));
           clearbuffer(0);
           writebyte(8, 0);
           writebyte(tmpid, 0);
           writebyte(dir, 0);
           writebyte(dist, 0);
           for k := 0 to listfind(userlist, 0) - 1 do
             if not(userlist[i] = userlist[k]) then
               messagesend(userlist[k], '', 0, 0);
         end;
       end;
     end;
   end;
end.