GameClassAncestors.pas from Sector-37 at Krugle
Show GameClassAncestors.pas syntax highlighted
unit GameClassAncestors;
interface
uses classes, sysutils, Graphics,
VectorTypes, VectorGeometry,
StrangeMovementManager,
GameConstants, GameStatisticsClasses, GameUnitClasses, GameSettings;
type
TCommonPlayerGameClass = class(TGameErrorHandlerClass)
public
ShieldTypes: array of TShieldType;
EngineTypes: array of TEngineType;
EquipmentTypes:array of TEquipmentType;
WeaponTypes: array of TWeaponType;
function GetWeaponType(Name: string): TWeaponType;
function GetEngineType(Name: string): TEngineType;
function GetShieldType(Name: string): TShieldType;
function GetEquipmentType(Name: string): TEquipmentType;
procedure OnRequestShieldType (Sender: TUnitType; const Filename: string; var ShieldType: TShieldType);
procedure OnRequestEquipmentType(Sender: TUnitType; const Filename: string; var EquipmentType: TEquipmentType);
procedure OnRequestEngineType (Sender: TUnitType; const Filename: string; var EngineType: TEngineType);
procedure onRequestWeaponType (Sender: TUnitType; const Filename: string; var WeaponType: TWeaponType);
destructor Destroy; override;
end;
//ancestor of TPlayer
TPlayerAncestor = class(TCommonPlayerGameClass)
public
Units: TList;
Projectiles: TList;
Planets: TList;
UnitTypes: array of TPlayerUnitType;
MainColor, Secondcolor: TColor;
Nick: string;
Clan: string;
Team: byte;
ID: byte;
Race: TRace;
IP: string;
PlayerType: byte; //determines the type of the Player
//see constants like PT_CPU_AVERAGE
Statistics: TPlayerStatistics;
Dead: Boolean;//if Player is still alive...
function GetUnitType(Name: String): TPlayerUnitType;
constructor Create;
destructor Destroy; override;
end;
//ancestor of TGame
TGameAncestor = class(TCommonPlayerGameClass)
protected
CurrentRandom: integer; //increases after each new random is used
public
UnitTypes: array of TUnitType;
RaceTypes: array of TRaceType;
Races: array of TRace;
UnitClasses: array of TUnitClass;
Profiles: array of TProfile;//all Game settings and options, sorted by categories
CurrentProfile: TProfile;
{it's a table of diplomatic relations between Players}
DiplomacyMatrix: array[0..MAX_PLAYERS - 1, 0..MAX_PLAYERS - 1] of TDiplomacyData;
function GetProfile(Name: string): TProfile;
function GetUnitType(Name: String): TUnitType;
function GetRaceType(Name: string): TRaceType;
function GetUnitClass(Name: string): TUnitClass;
procedure OnRequestRaceType (Sender: TObject; const Filename: string; const index: byte; var RaceType: TRaceType; var MaxRaceTypes: byte);
procedure OnRequestUnitClass (Sender: TObject; const Filename: string; const index: byte; var UnitClass: TUnitClass; var MaxUnitClasses: byte);
//myRandom functions
function myRandom: single; overload;
function myRandom(min, max: single): single; overload;
function myRandom(max: integer): integer; overload;
procedure myRandomPointOnSphere(r: single; var p : TVector3f; sign: shortint = 0);
constructor Create;
destructor Destroy; override;
end;
implementation
{ TCommonPlayerGameClass }
destructor TCommonPlayerGameClass.Destroy;
var
i: integer;
begin
if length(ShieldTypes) <> 0 then
for i := 0 to length(ShieldTypes) - 1 do
ShieldTypes[i].Destroy;
setlength(ShieldTypes, 0);
if length(EquipmentTypes) <> 0 then
for i := 0 to length(EquipmentTypes) - 1 do
EquipmentTypes[i].Destroy;
setlength(EquipmentTypes, 0);
if length(EngineTypes) <> 0 then
for i := 0 to length(EngineTypes) - 1 do
EngineTypes[i].Destroy;
setlength(EngineTypes, 0);
inherited;
end;
function TCommonPlayerGameClass.GetEngineType(Name: string): TEngineType;
var
i: byte;
begin
Result := nil;
for i := 0 to length(EngineTypes) - 1 do
if UpperCase(Name) = UpperCase(EngineTypes[i].Filename) then
begin
Result := EngineTypes[i];
exit;
end;
end;
function TCommonPlayerGameClass.GetEquipmentType(Name: string): TEquipmentType;
var
i: byte;
begin
Result := nil;
for i := 0 to length(EquipmentTypes) - 1 do
if UpperCase(Name) = UpperCase(EquipmentTypes[i].Filename) then
begin
Result := EquipmentTypes[i];
exit;
end;
end;
function TCommonPlayerGameClass.GetShieldType(Name: string): TShieldType;
var
i: byte;
begin
Result := nil;
for i:= 0 to length(ShieldTypes) - 1 do
if UpperCase(Name) = UpperCase(ShieldTypes[i].Filename) then
begin
Result := ShieldTypes[i];
exit;
end;
end;
function TCommonPlayerGameClass.GetWeaponType(Name: string): TWeaponType;
var
i: byte;
begin
Result := nil;
for i := 0 to length(WeaponTypes) - 1 do
if UpperCase(Name)=UpperCase(WeaponTypes[i].Filename) then
begin
Result := WeaponTypes[i];
exit;
end;
end;
procedure TCommonPlayerGameClass.OnRequestEngineType(Sender: TUnitType; const Filename: string; var EngineType: TEngineType);
begin
EngineType := GetEngineType(Filename);
end;
procedure TCommonPlayerGameClass.OnRequestEquipmentType(Sender: TUnitType; const Filename: string; var EquipmentType: TEquipmentType);
begin
EquipmentType := GetEquipmentType(Filename);
end;
procedure TCommonPlayerGameClass.OnRequestShieldType(Sender: TUnitType; const Filename: string; var ShieldType: TShieldType);
begin
ShieldType := GetShieldType(Filename);
end;
procedure TCommonPlayerGameClass.onRequestWeaponType(Sender: TUnitType; const Filename: string; var WeaponType: TWeaponType);
begin
WeaponType := GetWeaponType(Filename);
end;
{ TPlayerAncestor }
constructor TPlayerAncestor.Create;
begin
inherited Create;
Units := TList.Create;
Projectiles := TList.Create;
Planets := TList.Create;
end;
destructor TPlayerAncestor.Destroy;
var
i: integer;
begin
Units.Destroy;
Projectiles.Destroy;
Planets.Destroy;
if length(WeaponTypes) <> 0 then
for i := 0 to length(WeaponTypes) - 1 do
WeaponTypes[i].Destroy;
setlength(WeaponTypes, 0);
if length(UnitTypes) <> 0 then
for i := 0 to length(UnitTypes) - 1 do
UnitTypes[i].Destroy;
setlength(UnitTypes, 0);
inherited Destroy;
end;
function TPlayerAncestor.GetUnitType(Name: String): TPlayerUnitType;
var
i: integer;
begin
Result := nil;
if length(UnitTypes) <> 0 then
for i := 0 to length(UnitTypes) - 1 do
if UpperCase(Name) = UpperCase(UnitTypes[i].Filename) then
begin
Result := UnitTypes[i];
exit;
end;
end;
{ TGameAncestor }
function TGameAncestor.GetRaceType(Name: string): TRaceType;
var
i: byte;
begin
Result := nil;
if length(RaceTypes) <> 0 then
for i := 0 to length(RaceTypes) - 1 do
if UpperCase(Name) = UpperCase(RaceTypes[i].Filename) then
begin
Result := RaceTypes[i];
exit;
end;
end;
function TGameAncestor.GetUnitType(Name: String): TUnitType;
var
i: integer;
begin
Result := nil;
if length(UnitTypes) <> 0 then
for i := 0 to length(UnitTypes) - 1 do
if UpperCase(Name) = UpperCase(UnitTypes[i].Filename) then
begin
Result := UnitTypes[i];
exit;
end;
end;
function TGameAncestor.GetUnitClass(Name: string): TUnitClass;
var
i: byte;
begin
Result := nil;
if length(UnitClasses) <> 0 then
for i := 0 to length(UnitClasses) - 1 do
if UpperCase(Name) = UpperCase(UnitClasses[i].Filename) then
begin
Result := UnitClasses[i];
exit;
end;
end;
procedure TGameAncestor.OnRequestRaceType(Sender: TObject; const Filename:string; const index:byte; var RaceType:TRaceType; var MaxRaceTypes:byte);
begin
if Filename <> '' then
RaceType := GetRaceType(Filename)
else
RaceType := RaceTypes[index];
MaxRaceTypes := length(RaceTypes);
end;
procedure TGameAncestor.OnRequestUnitClass(Sender: TObject; const Filename: string; const index:byte; var UnitClass: TUnitClass; var MaxUnitClasses:byte);
begin
if Filename <> '' then
UnitClass := GetUnitClass(Filename)
else
UnitClass := UnitClasses[index];
MaxUnitClasses := length(UnitClasses);
end;
destructor TGameAncestor.Destroy;
var
i: integer;
begin
if length(Races) <> 0 then
for i := 0 to length(Races) - 1 do Races[i].Destroy;
if length(WeaponTypes) <> 0 then
for i := 0 to length(WeaponTypes) - 1 do
WeaponTypes[i].Destroy;
if length(RaceTypes) <> 0 then
for i := 0 to length(RaceTypes) - 1 do RaceTypes[i].Destroy;
if length(UnitTypes) <> 0 then
for i := 0 to length(UnitTypes) - 1 do UnitTypes[i].Destroy;
if length(UnitClasses) <> 0 then
for i := 0 to length(UnitClasses) - 1 do UnitClasses[i].Destroy;
inherited Destroy;
end;
function TGameAncestor.GetProfile(Name: string): TProfile;
var
i: byte;
begin
Result := nil;
for i := 0 to length(Profiles) - 1 do
if UpperCase(Name) = UpperCase(Profiles[i].Filename) then
begin
Result := Profiles[i];
exit;
end;
end;
constructor TGameAncestor.Create;
begin
CurrentRandom := 6;
end;
function TGameAncestor.myRandom(min, max: single): single;
begin
Result := myRandom * (max - min) + min;
end;
function TGameAncestor.myRandom: single;
begin
if CurrentRandom > 200 then
dec(CurrentRandom,201);
Result := RANDOM_ARRAY[CurrentRandom];
inc(CurrentRandom);
end;
function TGameAncestor.myRandom(max: integer): integer;
begin
Result := Trunc(myRandom * max);
end;
procedure TGameAncestor.myRandomPointOnSphere(r: single; var p : TVector3f; sign: shortint = 0);
label
xx;
var
t, w : Single;
begin
xx:
p[2] := 2 * myRandom - 1;
case sign of
1: if p[2] < 0 then goto xx;
-1: if p[2] > 0 then goto xx;
end;
t := 2 * PI * myRandom;
w := Sqrt(1 - p[2] * p[2]);
SinCos(t, w, p[1], p[0]);
ScaleVector(p, r);
end;
end.
See more files for this project here