g_target.pas

delphi编的不错的贪吃蛇

{----------------------------------------------------------------------------}
{                                                                            }
{ File(s): g_target.pas                                                      }
{                                                                            }
{ Initial conversion by : Jose M. Navarro ([e-mail])              }
{ Initial conversion on : 10-Jul-2002                                        }
{                                                                            }
{ NOTE: This file (Game\g_target.pas) is compatible with same name file in   } 
{ CTF directory (CTF\g_target.pas)                                           } 
{                                                                            }
{ 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 puC:\Documents and Settings\PCDELPHI4.PC-DELPHI4\Escritorio\g_target.c
blished 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 :                                                               }
{                                                                            }
unit g_target;

interface

uses
  g_local,
  GameUnit,
  q_shared;

{$Include ..\JEDI.inc}

//==========================================================
procedure Use_Target_Tent(ent: edict_p; other: edict_p; activator: edict_p); cdecl;
procedure SP_target_temp_entity(ent: edict_p); cdecl;

//==========================================================
// QUAKED target_speaker
procedure Use_Target_Speaker(ent: edict_p; other: edict_p; activator: edict_p); cdecl;
procedure SP_target_speaker(ent: edict_p); cdecl;

//==========================================================
// QUAKED target_help
procedure Use_Target_Help(ent: edict_p; other: edict_p; activator: edict_p); cdecl;
procedure SP_target_help(ent: edict_p); cdecl;

//==========================================================
// QUAKED target_secret
procedure use_target_secret(ent: edict_p; other: edict_p; activator: edict_p); cdecl;
procedure SP_target_secret(ent: edict_p); cdecl;

//==========================================================
// QUAKED target_goal
procedure use_target_goal(ent: edict_p; other: edict_p; activator: edict_p); cdecl;
procedure SP_target_goal(ent: edict_p); cdecl;

//==========================================================
// QUAKED target_explosion
procedure target_explosion_explode(self: edict_p); cdecl;
procedure use_target_explosion(self: edict_p; other: edict_p; activator: edict_p); cdecl;
procedure SP_target_explosion(ent: edict_p); cdecl;


//==========================================================
// QUAKED target_changelevel
procedure use_target_changelevel(self: edict_p; other: edict_p; activator: edict_p); cdecl;
procedure SP_target_changelevel(ent: edict_p); cdecl;

//==========================================================
// QUAKED target_splash
procedure use_target_splash(self: edict_p; other: edict_p; activator: edict_p); cdecl;
procedure SP_target_splash(self: edict_p); cdecl;

//==========================================================
// QUAKED target_spawner
procedure use_target_spawner(self: edict_p; other: edict_p; activator: edict_p); cdecl;
procedure SP_target_spawner(self: edict_p); cdecl;

//==========================================================
// QUAKED target_blaster
procedure use_target_blaster(self: edict_p; other: edict_p; activator: edict_p); cdecl;
procedure SP_target_blaster(self: edict_p); cdecl;

//==========================================================
// QUAKED target_crosslevel_trigger
procedure trigger_crosslevel_trigger_use(self: edict_p; other: edict_p; activator: edict_p); cdecl;
procedure SP_target_crosslevel_trigger(self: edict_p); cdecl;

//==========================================================
// QUAKED target_crosslevel_target
procedure target_crosslevel_target_think(self: edict_p); cdecl;
procedure SP_target_crosslevel_target(self: edict_p); cdecl;

//==========================================================
// QUAKED target_laser
procedure target_laser_think(self: edict_p); cdecl;
procedure target_laser_on(self: edict_p); cdecl;
procedure target_laser_off(self: edict_p); cdecl;
procedure target_laser_use(self: edict_p; other: edict_p; activator: edict_p); cdecl;
procedure target_laser_start(self: edict_p); cdecl;
procedure SP_target_laser(self: edict_p); cdecl;

//==========================================================
// QUAKED target_lightramp
procedure target_lightramp_think(self: edict_p); cdecl;
procedure target_lightramp_use(self: edict_p; other: edict_p; activator: edict_p); cdecl;
procedure SP_target_lightramp(self: edict_p); cdecl;

//==========================================================
// QUAKED target_earthquake
procedure target_earthquake_think(self: edict_p); cdecl;
procedure target_earthquake_use(self: edict_p; other: edict_p; activator: edict_p); cdecl;
procedure SP_target_earthquake(self: edict_p); cdecl;

implementation

uses
  SysUtils,
  g_utils,
  g_combat,
  p_hud,
  p_weapon,
  g_save,
  q_shared_add,
  g_main,
  g_weapon,
  g_local_add,
  game_add, CPas, g_spawn;

//==========================================================
{QUAKED target_temp_entity (1 0 0) (-8 -8 -8) (8 8 8)
Fire an origin based temp entity event to the clients.
"style"		type byte
}
procedure Use_Target_Tent(ent: edict_p; other: edict_p; activator: edict_p);
begin
  gi.WriteByte(svc_temp_entity);
  gi.WriteByte(ent^.style);
  gi.WritePosition(ent^.s.origin);
  gi.multicast(@ent^.s.origin, MULTICAST_PVS);
end;

procedure SP_target_temp_entity(ent: edict_p);
begin
  ent^.use := Use_Target_Tent;
end;


//==========================================================
{ QUAKED target_speaker (1 0 0) (-8 -8 -8) (8 8 8) looped-on looped-off reliable
"noise"		wav file to play
"attenuation"
-1 = none, send to whole level
1 = normal fighting sounds
2 = idle sound level
3 = ambient sound level
"volume"	0.0 to 1.0

Normal sounds play each time the target is used.  The reliable flag can be set for crucial voiceovers.

Looped sounds are allways atten 3 / vol 1, and the use function toggles it on/off.
Multiple identical looping sounds will just increase volume without any speed cost.
}
procedure Use_Target_Speaker(ent: edict_p; other: edict_p; activator: edict_p);
var
  chan: integer;
begin
  if (ent^.spawnflags and 3) <> 0 then
  begin  // looping sound toggles
    if ent^.s.sound <> 0 then
      ent^.s.sound := 0	// turn it off
    else
      ent^.s.sound := ent^.noise_index;	// start it
  end
  else
  begin  // normal sound
    if (ent^.spawnflags and 4) <> 0 then
      chan := CHAN_VOICE or CHAN_RELIABLE
    else
      chan := CHAN_VOICE;
    // use a positioned_sound, because this entity won't normally be
    // sent to any clients because it is invisible
    gi.positioned_sound(@ent^.s.origin, ent, chan, ent^.noise_index, ent^.volume, ent^.attenuation, 0);
  end;
end;

procedure SP_target_speaker(ent: edict_p); cdecl;
var
  buffer: array[0..MAX_QPATH-1] of char;
begin
  if st.noise = nil then
  begin
    gi.dprintf('target_speaker with no noise set at %s'#10, vtos(ent^.s.origin));
    exit;
  end;
  if strstr(st.noise, '.wav') = nil then
    Com_sprintf(buffer, sizeof(buffer), '%s.wav', [st.noise])
  else
    strncpy(buffer, st.noise, sizeof(buffer));
  ent^.noise_index := gi.soundindex(buffer);

  if ent^.volume = 0 then
    ent^.volume := 1.0;

  if ent^.attenuation = 0 then
    ent^.attenuation := 1.0
  else if ent^.attenuation = -1 then	// use -1 so 0 defaults to 1
    ent^.attenuation := 0;

  // check for prestarted looping sound
  if (ent^.spawnflags and 1) <> 0 then
    ent^.s.sound := ent^.noise_index;

  ent^.use := Use_Target_Speaker;

  // must link the entity so we get areas and clusters so
  // the server can determine who to send updates to
  gi.linkentity(ent);
end;


//==========================================================
{ QUAKED target_help (1 0 1) (-16 -16 -24) (16 16 24) help1
When fired, the "message" key becomes the current personal computer string, and the message light will be set on all clients status bars.
}
procedure Use_Target_Help(ent: edict_p; other: edict_p; activator: edict_p);
begin
  if (ent^.spawnflags and 1) <> 0 then
    strncpy(game.helpmessage1, ent^._message, sizeof(game.helpmessage2) - 1)
  else
    strncpy(game.helpmessage2, ent^._message, sizeof(game.helpmessage1) - 1);

  Inc(game.helpchanged);
end;

procedure SP_target_help(ent: edict_p);
begin
  if deathmatch^.Value <> 0 then
  begin  // auto-remove for deathmatch
    G_FreeEdict(ent);
    exit;
  end;

  if ent^._message = nil then
  begin
    gi.dprintf('%s with no message at %s'#10, ent^.classname, vtos(ent^.s.origin));
    G_FreeEdict(ent);
    exit;
  end;
  ent^.use := Use_Target_Help;
end;


//==========================================================
{ QUAKED target_secret (1 0 1) (-8 -8 -8) (8 8 8)
Counts a secret found.
These are single use targets.
}
procedure use_target_secret(ent: edict_p; other: edict_p; activator: edict_p);
begin
  gi.sound(ent, CHAN_VOICE, ent^.noise_index, 1, ATTN_NORM, 0);

  Inc(level.found_secrets);

  G_UseTargets(ent, activator);
  G_FreeEdict(ent);
end;

procedure SP_target_secret(ent: edict_p);
begin
  if deathmatch^.Value <> 0 then
  begin	// auto-remove for deathmatch
    G_FreeEdict(ent);
    exit;
  end;

  ent^.use := use_target_secret;
  if st.noise = nil then
    st.noise := 'misc/secret.wav';
  ent^.noise_index := gi.soundindex(st.noise);
  ent^.svflags := SVF_NOCLIENT;
  Inc(level.total_secrets);
  // map bug hack
  if (Q_stricmp(level.mapname, 'mine3') = 0) and (ent^.s.origin[0] = 280) and
     (ent^.s.origin[1] = -2048) and (ent^.s.origin[2] = -624) then
  begin
    ent^._message := 'You have found a secret area.';
  end;
end;

//==========================================================

{QUAKED target_goal (1 0 1) (-8 -8 -8) (8 8 8)
Counts a goal completed.
These are single use targets.
}
procedure use_target_goal(ent: edict_p; other: edict_p; activator: edict_p);
begin
  gi.sound(ent, CHAN_VOICE, ent^.noise_index, 1, ATTN_NORM, 0);

  Inc(level.found_goals);

  if level.found_goals = level.total_goals then
    gi.configstring(CS_CDTRACK, '0');

  G_UseTargets(ent, activator);
  G_FreeEdict(ent);
end;

procedure SP_target_goal(ent: edict_p);
begin
  if deathmatch^.Value <> 0 then
  begin	// auto-remove for deathmatch
    G_FreeEdict(ent);
    exit;
  end;

  ent^.use := use_target_goal;
  if st.noise = nil then
    st.noise := 'misc/secret.wav';
  ent^.noise_index := gi.soundindex(st.noise);
  ent^.svflags := SVF_NOCLIENT;
  Inc(level.total_goals);
end;

//==========================================================

{ QUAKED target_explosion (1 0 0) (-8 -8 -8) (8 8 8)
Spawns an explosion temporary entity when used.

"delay"		wait this long before going off
"dmg"		how much radius damage should be done, defaults to 0
}
procedure target_explosion_explode(self: edict_p);
var
  save: Single;
begin
  gi.WriteByte(svc_temp_entity);
  gi.WriteByte(Integer(TE_EXPLOSION1)); // cast from temp_event_t to Integer must be done
  gi.WritePosition(self^.s.origin);
  gi.multicast(@self^.s.origin, MULTICAST_PHS);

  T_RadiusDamage(self, self^.activator, self^.dmg, nil, self^.dmg + 40, MOD_EXPLOSIVE);

  save := self^.delay;
  self^.delay := 0;
  G_UseTargets(self, self^.activator);
  self^.delay := save;
end;

procedure use_target_explosion(self: edict_p; other: edict_p; activator: edict_p);
begin
  self^.activator := activator;

  if self^.delay = 0 then
  begin
    target_explosion_explode(self);
    exit;
  end;

  self^.think := target_explosion_explode;
  self^.nextthink := level.time + self^.delay;
end;

procedure SP_target_explosion(ent: edict_p);
begin
  ent^.use := use_target_explosion;
  ent^.svflags := SVF_NOCLIENT;
end;


//==========================================================

{ QUAKED target_changelevel (1 0 0) (-8 -8 -8) (8 8 8)
Changes level to "map" when fired
}
procedure use_target_changelevel(self: edict_p; other: edict_p; activator: edict_p);
begin
  if level.intermissiontime <> 0 then
    exit;		// already activated

  if (deathmatch^.Value = 0) and (coop^.Value =0) then
  begin
    if g_edicts[1].health <= 0 then
      exit;
  end;

  // if noexit, do a ton of damage to other
  if (deathmatch^.value <> 0) and not ((trunc(dmflags^.value) and DF_ALLOW_EXIT) <> 0) and (other <> world) then
  begin
    T_Damage(other, self, self, vec3_origin, other^.s.origin, vec3_origin, 10 * other^.max_health, 1000, 0, MOD_EXIT);
    exit;
  end;

  // if multiplayer, let everyone know who hit the exit
  if deathmatch^.Value <> 0 then
  begin
    // cast to interger must be done for mask operation
    if (Integer(activator) and Integer(activator^.client)) <> 0 then
	  gi.bprintf(PRINT_HIGH, '%s exited the level.'#10, activator^.client^.pers.netname);
  end;

  // if going to a new unit, clear cross triggers
  if strstr(self^.map, '*') <> nil then
    game.serverflags := game.serverflags and not SFL_CROSS_TRIGGER_MASK;

  BeginIntermission(self);
end;

procedure SP_target_changelevel(ent: edict_p);
begin
  if ent^.map = nil then
  begin
    gi.dprintf('target_changelevel with no map at %s'#10, vtos(ent^.s.origin));
    G_FreeEdict(ent);
    exit;
  end;

  // ugly hack because *SOMEBODY* screwed up their map
  if (Q_stricmp(level.mapname, 'fact1') = 0) and (Q_stricmp(ent^.map, 'fact3') = 0) then
    ent^.map := 'fact3$secret1';

  ent^.use     := use_target_changelevel;
  ent^.svflags := SVF_NOCLIENT;
end;


//==========================================================
{ QUAKED target_splash (1 0 0) (-8 -8 -8) (8 8 8)
Creates a particle splash effect when used.

Set "sounds" to one of the following:
  1) sparks
  2) blue water
  3) brown water
  4) slime
  5) lava
  6) blood

"count"	how many pixels in the splash
"dmg"	if set, does a radius damage at this location when it splashes
		useful for lava/sparks
}
procedure use_target_splash(self: edict_p; other: edict_p; activator: edict_p);
begin
  gi.WriteByte(svc_temp_entity);
  gi.WriteByte(Integer(TE_SPLASH));
  gi.WriteByte(self^.count);
  gi.WritePosition(self^.s.origin);
  gi.WriteDir(self^.movedir);
  gi.WriteByte(self^.sounds);
  gi.multicast(@self^.s.origin, MULTICAST_PVS);

  if self^.dmg <> 0 then