sv_send.pas

雷神之锤2(Quake2)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
  g_local,
  Server,
  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,
  Common,
  CModel,
  CPas,
  sv_main,
  sv_init,
  sv_ents,
  sv_user,
  GameUnit,
  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
      SZ_Write (client.netchan.message, sv.multicast.data, sv.multicast.cursize)
    else