sv_send.pas

delphi编的不错的贪吃蛇

{----------------------------------------------------------------------------}
{                                                                            }
{ File(s):  server\sv_send.c                                                 }
{                                                                            }
{ Initial conversion by : Hierro ([e-mail])                        }
{ Initial conversion on : 09-Jan-2002                                        }
{                                                                            }
{ This File contains part of convertion of Quake2 source to ObjectPascal.    }
{ More information about this project can be found at:                       }
{ http://www.sulaco.co.za/quake2/                                            }
{                                                                            }
{ Copyright (C) 1997-2001 Id Software, Inc.                                  }
{                                                                            }
{ This program is free software; you can redistribute it and/or              }
{ modify it under the terms of the GNU General Public License                }
{ as published by the Free Software Foundation; either version 2             }
{ of the License, or (at your option) any later version.                     }
{                                                                            }
{ This program is distributed in the hope that it will be useful,            }
{ but WITHOUT ANY WARRANTY; without even the implied warranty of             }
{ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                       }
{                                                                            }
{ See the GNU General Public License for more details.                       }
{                                                                            }
{----------------------------------------------------------------------------}
{ Updated on :                                                               }
{ Updated by :                                                               }
{                                                                            }
{----------------------------------------------------------------------------}
{ * Still dependent (to compile correctly) on:                               }
{ 1) server.pas                                                              }
{----------------------------------------------------------------------------}
{ * TODO:                                                                    }
{ 1) check for the constant argument array parameter                         }
{----------------------------------------------------------------------------}
// 25.07.2002 Juha: Proof-readed this unit

unit sv_send;

interface

uses
  Server,
  GameUnit,
  q_shared_add,
  q_shared;

procedure SV_Multicast(origin: vec3_p; to_: multicast_t); cdecl;
procedure SV_ClientPrintf(cl: client_p; level: integer; fmt: PChar; args: array of const);
procedure SV_BroadcastCommand(fmt: PChar; args: array of const);
procedure SV_SendClientMessages; cdecl;
procedure SV_StartSound(origin: vec3_p; entity: edict_p; channel: integer;
  soundindex: integer; volume: single;
  attenuation: single; timeofs: single); cdecl;
procedure SV_FlushRedirect(sv_redirected: integer; outputbuf: PChar);

procedure SV_BroadcastPrintf(level: integer; fmt: PChar; args: array of const);

var
  sv_outputbuf: array[0..SV_OUTPUTBUF_LENGTH - 1] of char;

implementation

uses
  SysUtils,
  game_add,
  Common,
  CModel,
  CPas,
  {$IFDEF WIN32}
  q_shwin,
  {$ELSE}
  q_shlinux,
  {$ENDIF}
  sv_main,
  sv_init,
  sv_ents,
  sv_user,
  net_chan;

(*
=============================================================================

Com_Printf redirection

=============================================================================
*)

procedure SV_FlushRedirect(sv_redirected: integer; outputbuf: PChar);
begin
  if (redirect_t(sv_redirected) = RD_PACKET) then
    Netchan_OutOfBandPrint(NS_SERVER, net_from, 'print'#10'%s', [outputbuf])
  else if (redirect_t(sv_redirected) = RD_CLIENT) then
  begin
    MSG_WriteByte(sv_client.netchan.message, Integer(svc_print));
    MSG_WriteByte(sv_client.netchan.message, PRINT_HIGH);
    MSG_WriteString(sv_client.netchan.message, outputbuf);
  end;
end;

(*
=============================================================================

EVENT MESSAGES

=============================================================================
*)

(*
=================
SV_ClientPrintf

Sends text across to be displayed if the level passes
=================
*)

procedure SV_ClientPrintf(cl: client_p; level: integer; fmt: PChar; args: array of const);
var
  msg: array[0..1023] of char;
begin
  if (level < cl.messagelevel) then
    exit;

  DelphiStrFmt(msg, fmt, args);

  MSG_WriteByte(cl.netchan.message, Integer(svc_print));
  MSG_WriteByte(cl.netchan.message, level);
  MSG_WriteString(cl.netchan.message, msg);
end;

(*
=================
SV_BroadcastPrintf

Sends text to all active clients
=================
*)

procedure SV_BroadcastPrintf(level: integer; fmt: PChar; args: array of const);
var
  string_: array[0..2048 - 1] of char;
  copy: array[0..1024 - 1] of char;
  cl: client_p;
  i: integer;
begin
  DelphiStrFmt(string_, fmt, args);

  // echo to console
  if (dedicated.value <> 0) then
  begin
    // mask off high bits
    i := 0;
    while (i < 1023) and (string_[i] <> #0) do
    begin
      copy[i] := Char(Byte(string_[i]) and 127);
      Inc(i);
    end;
    copy[i] := #0;
    Com_Printf('%s', [copy]);
  end;

  i := 0;
  cl := client_p(svs.clients);
  while i < maxclients^.value do
  begin
    if (level < cl^.messagelevel) then
    begin
      Inc(cl);
      Inc(i);
      Continue;
    end;
    if (cl^.state <> cs_spawned) then
    begin
      Inc(cl);
      Inc(i);
      Continue;
    end;
    MSG_WriteByte(cl^.netchan.message, Integer(svc_print));
    MSG_WriteByte(cl^.netchan.message, level);
    MSG_WriteString(cl^.netchan.message, string_);

    Inc(i);
    Inc(cl);
  end;
end;

(*
=================
SV_BroadcastCommand

Sends text to all active clients
=================
*)

procedure SV_BroadcastCommand(fmt: PChar; args: array of const);
var
  string_: array[0..1024 - 1] of char;
begin
  if (Integer(sv.state) = 0) then
    exit;

  DelphiStrFmt(string_, fmt, args);

  MSG_WriteByte(sv.multicast, Integer(svc_stufftext));
  MSG_WriteString(sv.multicast, string_);
  SV_Multicast(nil, MULTICAST_ALL_R);
end;

(*
=================
SV_Multicast

Sends the contents of sv.multicast to a subset of the clients,
then clears sv.multicast.

MULTICAST_ALL	same as broadcast (origin can be NULL)
MULTICAST_PVS	send to clients potentially visible from org
MULTICAST_PHS	send to clients potentially hearable from org
=================
*)

procedure SV_Multicast(origin: vec3_p; to_: multicast_t);
var
  client: client_p;
  mask: PByteArray;
  leafnum, cluster: integer;
  j: integer;
  reliable: boolean;
  area1, area2: integer;
begin
  reliable := False;

  if (to_ <> MULTICAST_ALL_R) and (to_ <> MULTICAST_ALL) then
  begin
    leafnum := CM_PointLeafnum(origin^);
    area1 := CM_LeafArea(leafnum);
  end
  else
  begin
    { Sly 12-Jul-2002 Not needed. Value assigned to 'leafnum' never used }
    //    leafnum := 0;	// just to avoid compiler warnings
    area1 := 0;
  end;

  // if doing a serverrecord, store everything
  if (svs.demofile > 0) then
    SZ_Write(svs.demo_multicast, sv.multicast.data, sv.multicast.cursize);

  case to_ of
    MULTICAST_ALL_R:
      begin
        reliable := true;               // intentional fallthrough
        { Sly 12-Jul-2002 Since Pascal does not allow fall-through, we must
          duplicate the code }
  { Sly 12-Jul-2002 Not needed. Value assigned to 'leafnum' never used }
  //      leafnum := 0;
        mask := nil;
      end;
    MULTICAST_ALL:
      begin
        { Sly 12-Jul-2002 Not needed. Value assigned to 'leafnum' never used }
        //      leafnum := 0;
        mask := nil;
      end;

    MULTICAST_PHS_R:
      begin
        reliable := true;               // intentional fallthrough
        { Sly 12-Jul-2002 Since Pascal does not allow fall-through, we must
          duplicate the code }
        leafnum := CM_PointLeafnum(origin^);
        cluster := CM_LeafCluster(leafnum);
        mask := PByteArray(CM_ClusterPHS(cluster));
      end;
    MULTICAST_PHS:
      begin
        leafnum := CM_PointLeafnum(origin^);
        cluster := CM_LeafCluster(leafnum);
        mask := PByteArray(CM_ClusterPHS(cluster));
      end;

    MULTICAST_PVS_R:
      begin
        reliable := true;               // intentional fallthrough
        { Sly 12-Jul-2002 Since Pascal does not allow fall-through, we must
          duplicate the code }
        leafnum := CM_PointLeafnum(origin^);
        cluster := CM_LeafCluster(leafnum);
        mask := PByteArray(CM_ClusterPVS(cluster));
      end;
    MULTICAST_PVS:
      begin
        leafnum := CM_PointLeafnum(origin^);
        cluster := CM_LeafCluster(leafnum);
        mask := PByteArray(CM_ClusterPVS(cluster));
      end;

  else
    begin
      mask := nil;
      Com_Error(ERR_FATAL, 'SV_Multicast: bad to:%i', [Integer(to_)]);
    end;
  end;

  // send the data to all relevent clients
  client := client_p(svs.clients);
  for j := 0 to Round(maxclients.value) - 1 do
  begin
    if (client.state = cs_free) or (client.state = cs_zombie) then
    begin
      inc(client);
      continue;
    end;
    if (client.state <> cs_spawned) and (not reliable) then
    begin
      inc(client);
      continue;
    end;

    if (mask <> nil) then
    begin
      leafnum := CM_PointLeafnum(client^.edict^.s.origin);
      cluster := CM_LeafCluster(leafnum);
      area2 := CM_LeafArea(leafnum);
      if (not CM_AreasConnected(area1, area2)) then
      begin
        inc(client);
        continue;
      end;
      if (mask <> nil) and (not (mask[cluster shr 3] and (1 shl (cluster and 7)) <> 0)) then
      begin
        inc(client);
        continue;
      end;
    end;

    if (reliable) then