|
My Programming Page - VGAPDATA
|
VGAPDATA
Contents of this page
- VGAPDATA.PAS, Unit holding VGA Planets data-access functions
VGAPDATA.PAS
{************************************************}
{ }
{ UNIT DATA VGA-Planets-Data-Files }
{ Copyright (c) 1994-95 by Tom Wellige }
{ Donated as FREEWARE }
{ }
{ E-Mail: wellige@geocities.com }
{ }
{************************************************}
unit Data;
interface
uses objects, dos, crt;
type
TPlanetName = string[20];
(* Ships ---------------------------------*)
PShipRec = ^TShipRec;
TShipRec = record
Name : string[30];
Typ, Dummy1, Dummy2,
Tritanium, Duranium, Molebdenum,
TechLevel, Costs, Mass,
Cargo, Fuel,Engines, Crew,
Bays, Tubes, Beams: word;
end;
PShipCollection = ^TShipCollection;
TShipCollection = object(TCollection)
procedure FreeItem(Item: Pointer); virtual;
end;
POwnShipRec = ^TOwnShipRec;
TOwnShipRec = record
name: string[20];
fcode: string[3];
x, y, dx, dy,id, race, typ, warp, masse,
crew, clans, mission, enemy, drive,
beam_typ, beam_num, torp_typ, torp_num, fishes: integer;
N, T, D, M, Supplies, Funds, Damage: word;
RestRec: array[1..30] of word;
end;
POwnShipCollection = ^TOwnShipCollection;
TOwnShipCollection = object(TCollection)
procedure FreeItem(Item: Pointer); virtual;
end;
PTargetShipRec = ^TTargetShipRec;
TTargetShipRec = record
name: string[20];
id, race, warp, x, y, typ: word;
heading: integer;
end;
PTargetShipCollection = ^TTargetShipCollection;
TTargetShipCollection = object(TSortedCollection)
procedure FreeItem(Item: Pointer); virtual;
function Compare(Key1, Key2: Pointer): Integer; virtual;
procedure Store(var S: TStream);
end;
PXYShipRec = ^TXYShipRec;
TXYShipRec = record
id, race, mass, x, y: word;
end;
PXYShipCollection = ^TXYShipCollection;
TXYShipCollection = object(TSortedCollection)
procedure FreeItem(Item: Pointer); virtual;
function Compare(Key1, Key2: Pointer): Integer; virtual;
procedure Store(var S: TStream);
end;
TShipData = record
Hull, Own, Target, Deep: pointer;
end;
{ ein Schiff ist getarnt, wenn HULL und TARGET <> nil }
PAllShips = ^TAllShips;
TAllShips = array[0..500] of TShipData;
{ Feld 0 enthlt Zeiger auf die einzelnen Collections }
(* Races ---------------------------------*)
PRaceRec = ^TRaceRec;
TRaceRec = record
LongName : string[30]; { The Solar Federation }
Name : string[20]; { The Feds }
ShortName: string[12]; { Fed }
end;
PRaceArray = ^TRaceArray;
TRaceArray = array[0..11] of TRaceRec;
(* Bases ---------------------------------*)
PBaseRec = ^TBaseRec;
TBaseRec = record
RestRec: array[0..77] of word;
ID, Defense, Damage, Fighter,
Tech_Hulls, Tech_Engines, Tech_Weapons, Tech_Torpedos,
Order: word;
end;
PBaseCollection = ^TBaseCollection;
TBaseCollection = object(TCollection)
procedure FreeItem(Item: Pointer); virtual;
end;
(* Planets -------------------------------*)
PPlanetRec = ^TPlanetRec;
TPlanetRec = record
Besiedelt, ID, Temp: word;
FCode: string[3];
Mines, Factories, Defense: word;
N, Nmax, T, Tmax, D, Dmax, M, Mmax,
Col_Pop, Nat_Pop, Supplies, Funds: longint;
Ndens, Tdens, Ddens, Mdens,
Col_Tax, Col_Sat, Nat_Tax, Nat_Sat, Government, Native: word;
end;
PPlanetCollection = ^TPlanetCollection;
TPlanetCollection = object(TCollection)
procedure FreeItem(Item: Pointer); virtual;
end;
PHSTPlanetRec = ^THSTPlanetRec;
THSTPlanetRec = record
Race, ID, Temp: word;
FCode: string[3];
Mines, Factories, Defense: word;
N, Nmax, T, Tmax, D, Dmax, M, Mmax,
Col_Pop, Nat_Pop, Supplies, Funds: longint;
Ndens, Tdens, Ddens, Mdens,
Col_Tax, Col_Sat, Nat_Tax, Nat_Sat, Government, Native, Dummy: word;
end;
PHSTPlanetCollection = ^THSTPlanetCollection;
THSTPlanetCollection = object(TCollection)
procedure FreeItem(Item: Pointer); virtual;
end;
PPlanets = ^TPlanets;
TPlanets = record
Name: string[20];
x,y: word;
end;
PPlanetsCollection = ^TPlanetsCollection;
TPlanetsCollection = object(TCollection)
procedure FreeItem(Item: Pointer); virtual;
end;
TPlanetData = record
Name, Data, Base: pointer;
end;
PAllPlanets = ^TAllPlanets;
TAllPlanets = array[0..500] of TPlanetData;
{ Feld 0 enthlt Zeiger auf die einzelnen Collections }
const
NativeRec : array[0..9] of string[11] =
('', 'Humanoid', 'Bovinoid', 'Reptilian', 'Avian', 'Amorphous',
'Insectoid', 'Amphibian', 'Ghipsoldal', 'Siliconoid');
GovernmentRec: array[0..9] of string[14] =
('', 'Anarchy', 'Pre-Tribal', 'Early-Tribal', 'Tribal',
'Feudal', 'Monarchy', 'Representative', 'Participatory', 'Unity');
TorpedoRec: array[0..10] of string[13] =
('', 'Mark 1 Photon', 'Proton Torp', 'Mark 2 Photon', 'Gamma Bomb',
'Mark 3 Photon', 'Mark 4 Photon', 'Mark 5 Photon', 'Mark 6 Photon',
'Mark 7 Photon', 'Mark 8 Photon');
BeamRec: array[0..10] of string[15] =
('', 'Laser', 'X-Ray Laser', 'Plasma Bolt', 'Blaster', 'Positron Beam',
'Disruptor', 'Heavy Blaster', 'Phaser', 'Heavy Disruptor', 'Heavy Phaser');
EngineRec: array[0..9] of string[17] =
('', 'StarDrive 1', 'StarDrive2', 'StarDrive 3', 'Super StarDrive 4',
'Nova Drive 5', 'HeavyNova Drive 6', 'Quantum Drive 7', 'Hyper Drive 8',
'Transwarp Drive');
MissionRec: array[0..15] of string[18] =
('', 'Exploration', 'Mine Sweep', 'Lay Mines', 'Kill !!', 'Sensor Sweep',
'Colonize', 'Tow', 'Intercept', 'Race Mission 1', 'Race Mission 2',
'Beam up Fuel', 'Beam up Duranium', 'Beamp up Tritanium',
'Beam up Molebdenum', 'Beam up Supplies');
OrderRec: array[0..6] of string[21] =
('', 'Refuel', 'Max Defense!', 'Load Torps onto Ships',
'Unload all Freigthers', 'Repair Base', 'Force a surrender');
(* liest die Datei HULLSPEC.DAT aus *)
function GetShipCollection(F: string): PShipCollection;
(* liest die Datei TARGETx.DAT aus *)
function GetTargetShipCollection(F: string): PTargetShipCollection;
(* gibt PTargetShipRec mittels Ship-ID zurck *)
function GetTargetShipRecByID(C: PTargetShipCollection; ID: word): PTargetShipRec;
(* liest die Datei SHIPx.DAT aus *)
function GetOwnShipCollection(F: string): POwnShipCollection;
(* gibt POwnShipRec mittels Ship-ID zurck *)
function GetOwnShipRecByID(C: POwnShipCollection; ID: word): POwnShipRec;
(* liest die Datei SHIPXYx.DAT aus *)
function GetXYShipCollection(F: string): PXYShipCollection;
(* erzegut TAllShips - Array *)
function GetShips(pdir, gdir, p: string): PAllShips;
(* liest die Datei PDATAx.DAT aus *)
function GetPlanetCollection(F: string): PPlanetCollection; {eigene Planeten}
(* liest die Datei PDATA.HST aus *)
function GetHSTPlanetCollection(F: string): PHSTPlanetCollection; { HST Planeten }
(* liest die Datei PLANET.NM + XYPLAN.DAT aus *)
function GetPlanetsCollection(Dir: string): PPlanetsCollection; {alle Planeten}
(* liest die Datei BDATAx.DAT aus *)
function GetBaseCollection(F: string): PBaseCollection;
(* erzeugt TAllPlanets - Array *)
function GetPlanets(pdir, gdir, p: string): PAllPlanets;
(* liest die Datei RACE.NM aus *)
function GetRaceNames(F: string; var R: TRaceArray): boolean;
(* ermittelt mittels x, y die Loacation *)
function GetLocation(C: PPlanetsCollection; x, y: word): TPlanetName;
(* ermittelt Klima aus Temperatur *)
function GetTemperature(t: word): string;
(* ermittelt Stimmung aus Satisfaction *)
function GetSatisfaction(t: word): string;
(* ermittelt, ob Schiff getarnt fliegt *)
function IsCloaked(id: word; p: PAllShips): boolean;
var NewRaceArray: TRaceArray;
implementation
(* Temperatur *)
function GetTemperature(t: word): string;
var s: string;
begin
if t > 80 then s:= 'Desert' else
if t > 60 then s:= 'Tropical' else
if t > 40 then s:= 'Warm' else
if t > 20 then s:= 'Cool' else
s:= 'Arctic';
GetTemperature:= s;
end;
(* Satisfaction *)
function GetSatisfaction(t: word): string;
var s: string;
begin
if t > 80 then s:= 'happy' else
if t > 60 then s:= 'calm' else
if t > 40 then s:= 'unhappy' else
if t > 20 then s:= 'angry' else
s:= 'rioting';
GetSatisfaction:= s;
end;
(* RACE.NM *)
function GetRaceNames(F: string; var R: TRaceArray): boolean;
var
S: PDosStream;
i: integer;
begin
S:= New(PDosStream, Init (F, stOpenRead));
if S^.Status = stOk then
begin
S^.Seek(0);
for i:= 1 to 11 do
begin
R[i].LongName[0]:= #30;
S^.Read(R[i].LongName[1], 30);
end;
for i:= 1 to 11 do
begin
R[i].Name[0]:= #20;
S^.Read(R[i].Name[1], 20);
end;
for i:= 1 to 11 do
begin
R[i].ShortName[0]:= #12;
S^.Read(R[i].ShortName[1], 12);
end;
Dispose(S, Done);
GetRaceNames:= true;
end else
GetRaceNames:= false;
end;
(* gibt Planeten-Namen zurck *)
function GetLocation(C: PPlanetsCollection; x, y: word): TPlanetName;
var
s: TPlanetName;
p: PPlanets;
i: integer;
begin
s:= '';
if Assigned(C) then
if C^.Count > 0 then
for i:= 0 to C^.Count - 1 do
begin
p:= C^.At(i);
if (p^.x = x) and (p^.y = y) then s:= p^.name;
end;
if s = '' then s:= 'deep Space';
GetLocation:= s;
end;
(* HULLSPEC.DAT Hllendaten *)
function GetShipCollection(F: string): PShipCollection;
var
C: PShipCollection;
R: PShipRec;
S: PDosStream;
i, y: integer;
begin
C:= nil;
S:= New(PDosStream, Init (F, stOpenRead));
if S^.Status = stOk then
begin
C:= New(PShipCollection, Init(10, 5));
i:= 0;
y:= 0;
while i < S^.GetSize do
begin
inc(y);
S^.Seek(i);
New(R);
with R^ do
begin
Name[0]:= #30;
Typ := y;
S^.Read(Name[1], 30);
S^.Read(Dummy1, 2); { ??? }
S^.Read(Dummy2, 2); { ??? }
S^.Read(Tritanium, 2);
S^.Read(Duranium, 2);
S^.Read(Molebdenum, 2);
S^.Read(Fuel, 2);
S^.Read(Crew, 2);
S^.Read(Engines, 2);
S^.Read(Mass, 2);
S^.Read(TechLevel, 2);
S^.Read(Cargo, 2);
S^.Read(Bays, 2);
S^.Read(Tubes, 2);
S^.Read(Beams, 2);
S^.Read(Costs, 2);
end;
C^.Insert(R);
i:= i + 60;
end;
Dispose(S, Done);
end else
begin
ClrScr;
Writeln(#7);
Writeln('Fehler beim Lesen der ShipDaten (', S^.Status, ') !');
readln;
end;
GetShipCollection:= C;
end;
(* PLANET.NM XYPLAN.DAT *)
function GetPlanetsCollection(Dir: string): PPlanetsCollection;
var
C: PPlanetsCollection;
R: PPlanets;
S1, S2: PDosStream;
i, y: integer;
begin
C:= nil;
S1:= New(PDosStream, Init (Dir + 'XYPLAN.DAT', stOpenRead));
if S1^.Status = stOk then
begin
S2:= New(PDosStream, Init (Dir + 'PLANET.NM', stOpenRead));
if S2^.Status = stOk then
begin
C:= New(PPlanetsCollection, Init(10, 5));
for i:= 1 to 500 do
begin
New(R);
r^.name[0]:= #20;
S2^.read(r^.Name[1], 20);
S1^.read(r^.x, 2);
S1^.read(r^.y, 2);
S1^.read(y, 2); { DUMMY, eigentlich Base }
c^.insert(r);
end;
Dispose(S1, done);
Dispose(S2, done);
end else
begin
Dispose(S1, done);
write(#7);
write('Kann ', Dir, 'PLANET.NM nicht ffnen !');
halt(1);
end;
end else
begin
write(#7);
write('Kann ', Dir, 'XYPLAN.DAT nicht ffnen !');
halt(1);
end;
GetPlanetsCollection:= c;
end;
(* PDATAx.DAT eigene Planetendaten *)
function GetPlanetCollection(F: string): PPlanetCollection;
var
C: PPlanetCollection;
R: PPlanetRec;
S: PDosStream;
i, y: integer;
dummy: word;
begin
C:= nil;
S:= New(PDosStream, Init (F, stOpenRead));
if S^.Status = stOk then
begin
C:= New(PPlanetCollection, Init(10, 5));
S^.read(y, 2);
for i:= 1 to y do
begin
New(R);
with R^ do
begin
S^.Read(Besiedelt,2);
S^.Read(ID,2);
FCode[0]:= #3;
S^.Read(FCode[1], 3);
S^.Read(Mines,2);
S^.Read(Factories,2);
S^.Read(Defense,2);
S^.Read(N,4);
S^.Read(T,4);
S^.Read(D,4);
S^.Read(M,4);
S^.Read(Col_Pop,4);
S^.Read(Supplies,4);
S^.Read(Funds,4);
S^.Read(Nmax,4);
S^.Read(Tmax,4);
S^.Read(Dmax,4);
S^.Read(Mmax,4);
S^.Read(Ndens,2);
S^.Read(Tdens,2);
S^.Read(Ddens,2);
S^.Read(Mdens,2);
S^.Read(Col_Tax,2);
S^.Read(Nat_Tax,2);
S^.Read(Col_Sat,2);
S^.Read(Nat_Sat,2);
S^.Read(Government,2);
S^.Read(Nat_Pop,4);
S^.Read(Native,2);
S^.Read(Temp,2);
Temp:= 100-Temp;
S^.Read(dummy,2);
end;
C^.Insert(R);
end;
Dispose(S, Done);
end else
begin
ClrScr;
Writeln(#7);
Writeln('Fehler beim Lesen der PlanetDaten (', S^.Status, ') !');
readln;
end;
GetPlanetCollection:= C;
end;
(* PDATA.HST HOST-Planetendaten *)
function GetHSTPlanetCollection(F: string): PHSTPlanetCollection;
var
C: PHSTPlanetCollection;
R: PHSTPlanetRec;
S: PDosStream;
i, y: integer;
begin
C:= nil;
S:= New(PDosStream, Init (F, stOpenRead));
if S^.Status = stOk then
begin
C:= New(PHSTPlanetCollection, Init(10, 5));
S^.read(y, 2);
for i:= 1 to 500 do
begin
New(R);
with R^ do
begin
S^.Read(Race,2);
S^.Read(ID,2);
FCode[0]:= #3;
S^.Read(FCode[1], 3);
S^.Read(Mines,2);
S^.Read(Factories,2);
S^.Read(Defense,2);
S^.Read(N,4);
S^.Read(T,4);
S^.Read(D,4);
S^.Read(M,4);
S^.Read(Col_Pop,4);
S^.Read(Supplies,4);
S^.Read(Funds,4);
S^.Read(Nmax,4);
S^.Read(Tmax,4);
S^.Read(Dmax,4);
S^.Read(Mmax,4);
S^.Read(Ndens,2);
S^.Read(Tdens,2);
S^.Read(Ddens,2);
S^.Read(Mdens,2);
S^.Read(Col_Tax,2);
S^.Read(Nat_Tax,2);
S^.Read(Col_Sat,2);
S^.Read(Nat_Sat,2);
S^.Read(Government,2);
S^.Read(Nat_Pop,4);
S^.Read(Native,2);
S^.Read(Temp,2);
Temp:= 100-Temp;
S^.Read(dummy,2);
end;
C^.Insert(R);
end;
Dispose(S, Done);
end else
begin
ClrScr;
Writeln(#7);
Writeln('Fehler beim Lesen der HOST-PlanetDaten (', S^.Status, ') !');
readln;
end;
GetHSTPlanetCollection:= C;
end;
(* BDATAx.DAT eigene Basedaten *)
function GetBaseCollection(F: string): PBaseCollection;
var
C: PBaseCollection;
R: PBaseRec;
S: PDosStream;
i, y: integer;
begin
C:= nil;
S:= New(PDosStream, Init (F, stOpenRead));
if S^.Status = stOk then
begin
C:= New(PBaseCollection, Init(10, 5));
S^.read(y, 2);
for i:= 1 to y do
begin
New(R);
with R^ do
begin
S^.Read(restrec, 78*2);
id := restrec[0];
defense:= restrec[2];
Damage := restrec[3];
Fighter:= restrec[67];
Order := restrec[70];
Tech_Hulls := restrec[5];
Tech_Engines := restrec[4];
Tech_Weapons := restrec[6];
Tech_Torpedos:= restrec[7];
end;
C^.Insert(R);
end;
Dispose(S, Done);
end else
begin
ClrScr;
Writeln(#7);
Writeln('Fehler beim Lesen der BaseDaten (', S^.Status, ') !');
readln;
end;
GetBaseCollection:= C;
end;
(* SHIPx.DAT eigene Schiffsdaten *)
function GetOwnShipCollection(F: string): POwnShipCollection;
var
C: POwnShipCollection;
R: POwnShipRec;
S: PDosStream;
i, z: integer;
dummy: word;
l: longint;
begin
C:= nil;
S:= New(PDosStream, Init (F, stOpenRead));
if S^.Status = stOk then
begin
C:= New(POwnShipCollection, Init(10, 5));
S^.read(z, 2);
for i:= 1 to z do
begin
New(R);
with r^ do
begin
S^.seek (2+(i-1)*107);
S^.read (id, 2);
S^.read (race, 2);
S^.read (fcode[1], 3);
fcode[0]:=#3;
S^.read (warp, 2);
S^.read(dx, 2);
S^.read(dy, 2);
S^.read(x, 2);
S^.read(y, 2);
S^.read(drive, 2);
S^.read(typ, 2);
S^.read(beam_typ, 2);
S^.read(beam_num, 2);
S^.read(dummy, 2); {???}
S^.read(torp_typ, 2);
S^.read(fishes, 2);
S^.read(torp_num, 2);
S^.read(mission, 2);
S^.read(enemy, 2);
S^.read(dummy, 2); {???}
S^.read(dummy, 2); {???}
S^.read(crew, 2);
S^.read(clans, 2);
S^.read(name[1],20);
name[0]:=#20;
S^.read(N, 2);
S^.read(T, 2);
S^.read(D, 2);
S^.read(M, 2);
S^.read(supplies, 2);
S^.read(funds, 2);
S^.read(restrec, 30);
funds:= restrec[15];
end;
C^.Insert(R);
end;
Dispose(S, Done);
end else
begin
ClrScr;
Writeln(#7);
Writeln('Fehler beim Lesen der eigenen Schiffsdaten (', S^.Status, ') !');
readln;
end;
GetOwnShipCollection:= C;
end;
(* Daten aus Liste aus SHIPx.DAT *)
function GetOwnShipRecByID(C: POwnShipCollection; ID: word): POwnShipRec;
var
D, P: POwnShipRec;
i: integer;
begin
P:= nil;
if Assigned(C) then
if C^.Count > 0 then
for i:= 0 to C^.Count - 1 do
begin
D:= C^.At(i);
if D^.ID = ID then P:= D;
end;
GetOwnShipRecByID:= P;
end;
(* TARGETx.DAT feindliche Schiffe im Scanbereich *)
function GetTargetShipCollection(F: string): PTargetShipCollection;
var
C: PTargetShipCollection;
R: PTargetShipRec;
S: PDosStream;
i, z: integer;
dummy: word;
begin
c:= nil;
s:= New(PDosStream, Init (F, stOpenRead));
if s^.Status = stOk then
begin
c:= New(PTargetShipCollection, Init(10, 5));
s^.read(z, 2);
for i:= 1 to z do
begin
New(r);
with r^ do
begin
s^.read(id,2);
s^.read(race,2);
s^.read(warp,2);
s^.read(x,2);
s^.read(y,2);
s^.read(typ,2);
s^.read(heading,2);
s^.read (name[1],20);
name[0]:=#20;
end;
c^.insert(r);
end;
dispose(s, done);
end;
GetTargetShipCollection:= c;
end;
(* Daten aus Liste aus TARGETx.DAT *)
function GetTargetShipRecByID(C: PTargetShipCollection; ID: word): PTargetShipRec;
var
D, P: PTargetShipRec;
i: integer;
begin
P:= nil;
if Assigned(C) then
if C^.Count > 0 then
for i:= 0 to C^.Count - 1 do
begin
D:= C^.At(i);
if D^.ID = ID then P:= D;
end;
GetTargetShipRecByID:= P;
end;
(* SHIPXYx.DAT Deepspace-Scanner *)
function GetXYShipCollection(F: string): PXYShipCollection;
var
C: PXYShipCollection;
R: PXYShipRec;
Rec: TXYShipRec;
S: PDosStream;
i: integer;
rest: array[1..5] of word;
begin
c:= nil;
s:= New(PDosStream, Init (F, stOpenRead));
if s^.Status = stOk then
begin
c:= New(PXYShipCollection, Init(10, 5));
for i:= 1 to 500 do
begin
with rec do
begin
id:= i;
s^.read(x,2);
s^.read(y,2);
s^.read(race,2);
s^.read(mass,2);
end;
if ((rec.x <> 0) and (rec.y <> 0)) or (rec.mass <> 0) or (rec.race <> 0) then
begin
new(r);
r^:= rec;
c^.insert(r);
end;
end;
s^.read(rest, 10); {???}
dispose(s, done);
end;
GetXYShipCollection:= c;
end;
(* alles was zu kriecht und fleucht im Universum *)
function GetShips(pdir, gdir, p: string): PAllShips;
var
A: PAllShips;
i: integer;
t: word;
pO: POwnShipRec;
pT: PTargetShipRec;
pX: PXYShipRec;
pS: PShipRec;
begin
new(a);
for i:= 0 to 500 do
begin
a^[i].hull := nil;
a^[i].own := nil;
a^[i].target:= nil;
a^[i].deep := nil;
end;
if pdir <> '' then
if pdir[length(pdir)] <> '\' then pdir:= pdir + '\';
if gdir <> '' then
if gdir[length(gdir)] <> '\' then gdir:= gdir + '\';
writeln('scanning '+gdir+'SHIP'+p+'.DAT for your own ships...');
a^[0].own:= GetOwnShipCollection(gdir+'ship'+p+'.dat');
if assigned(a^[0].own) then
writeln(' found ', PCollection(a^[0].own)^.Count, ' of your own ships');
writeln('scanning '+gdir+'TARGET'+p+'.DAT for near enemy ships...');
a^[0].target:= GetTargetShipCollection(gdir+'target'+p+'.dat');
if assigned(a^[0].target) then
writeln(' found ', PCollection(a^[0].target)^.Count, ' enemy ships near to you');
writeln('scanning '+gdir+'SHIPXY'+p+'.DAT for far enemy ships...');
a^[0].deep:= GetXYShipCollection(gdir+'shipxy'+p+'.dat');
if assigned(a^[0].deep) then
writeln(' found ', PCollection(a^[0].deep)^.Count, ' enemy ships in deep space');
writeln('scanning '+pdir+'HULLSPEC.DAT for ship hulls...');
a^[0].hull:= GetShipCollection(pdir+'hullspec.dat');
if assigned(a^[0].own) then
writeln(' found ', PCollection(a^[0].hull)^.Count, ' ship-hulls');
writeln('sorting all ship datas...');
(* eigene Schiffsdaten einsortieren *)
if assigned(POwnShipCollection(a^[0].own)) then
for i:= 0 to POwnShipCollection(a^[0].own)^.Count - 1 do
begin
pO:= POwnShipCollection(a^[0].own)^.at(i);
POwnShipRec(a^[pO^.id].own):= pO;
end;
(* Sensor Sweep Daten einsortieren *)
if assigned(PTargetShipCollection(a^[0].target)) then
for i:= 0 to PTargetShipCollection(a^[0].target)^.Count - 1 do
begin
pT:= PTargetShipCollection(a^[0].target)^.at(i);
PTargetShipRec(a^[pT^.id].target):= pT;
end;
(* Deep Space Scanner Daten einsortieren *)
if assigned(PXYShipCollection(a^[0].deep)) then
for i:= 0 to PXYShipCollection(a^[0].deep)^.Count - 1 do
begin
pX:= PXYShipCollection(a^[0].deep)^.at(i);
PXYShipRec(a^[pX^.id].deep):= pX;
end;
(* Hllendaten jeweils den Schiffen zuordnen *)
if assigned(PShipCollection(a^[0].hull)) then
for i:= 1 to 500 do
begin
t:= 0;
if assigned(a^[i].own) then t:= POwnShipRec(a^[i].own)^.typ else
if assigned(a^[i].target) then t:= PTargetShipRec(a^[i].target)^.typ;
if (t <> 0) and (t < PShipCollection(a^[0].hull)^.Count) then
begin
pS:= PShipCollection(a^[0].hull)^.at(t-1);
PShipRec(a^[i].hull):= pS;
end;
end;
GetShips:= a;
end;
function GetPlanets(pdir, gdir, p: string): PAllPlanets;
var
A: PAllPlanets;
i: integer;
pN: PPlanets; (* GetPlanetsCollection *)
pD: PPlanetRec; (* GetPlanetCollection *)
pB: PBaseRec;
begin
new(a);
for i:= 0 to 500 do
begin
a^[i].Name:= nil;
a^[i].Data:= nil;
a^[i].Base:= nil;
end;
if pdir <> '' then
if pdir[length(pdir)] <> '\' then pdir:= pdir + '\';
if gdir <> '' then
if gdir[length(gdir)] <> '\' then gdir:= gdir + '\';
writeln('scanning in '+pdir+' PLANET.NM & XYPLAN.DAT for all planets...');
a^[0].name:= GetPlanetsCollection(pdir);
if assigned(a^[0].name) then
writeln(' found ', PCollection(a^[0].name)^.Count, ' planets in whole universe');
writeln('scanning '+gdir+'PDATA'+p+'.DAT for own planets...');
a^[0].data:= GetPlanetCollection(gdir+'pdata'+p+'.dat');
if assigned(a^[0].data) then
writeln(' found ', PCollection(a^[0].data)^.Count, ' of your own planets');
writeln('scanning '+gdir+'BDATA'+p+'.DAT for own bases...');
a^[0].base:= GetBaseCollection(gdir+'bdata'+p+'.dat');
if assigned(a^[0].base) then
writeln(' found ', PCollection(a^[0].base)^.Count, ' of your own bases');
writeln('sorting all planet datas...');
(* Planeten Namen und Location einsortieren *)
if assigned(PPlanetsCollection(a^[0].name)) then
for i:= 1 to 500 do
begin
pN:= PPlanetsCollection(a^[0].name)^.at(i-1);
PPlanets(a^[i].name):= pN;
end;
(* eigene Planeten einsortieren *)
if assigned(PPlanetCollection(a^[0].data)) then
for i:= 0 to PPlanetCollection(a^[0].data)^.Count - 1 do
begin
pD:= PPlanetCollection(a^[0].data)^.at(i);
PPlanetRec(a^[pD^.id].data):= pD;
end;
(* eigene Bases einsortieren *)
if assigned(PBaseCollection(a^[0].Base)) then
for i:= 0 to PBaseCollection(a^[0].base)^.Count - 1 do
begin
pB:= PBaseCollection(a^[0].base)^.at(i);
PBaseRec(a^[pB^.id].base):= pB;
end;
GetPlanets:= a;
end;
function IsCloaked(id: word; p: PAllShips): boolean;
begin
IsCloaked:= assigned(p^[id].target) and not assigned(p^[id].deep);
end;
(* ************************ Data-Collections ************************** *)
procedure TShipCollection.FreeItem(Item: Pointer);
begin
Dispose(PShipRec(Item));
end;
procedure TOwnShipCollection.FreeItem(Item: Pointer);
begin
Dispose(POwnShipRec(Item));
end;
procedure TTargetShipCollection.FreeItem(Item: Pointer);
begin
Dispose(PTargetShipRec(Item));
end;
function TTargetShipCollection.Compare(Key1, Key2: Pointer): Integer;
var i: integer;
begin
if PTargetShipRec(Key1)^.id < PTargetShipRec(Key2)^.id then i:= -1 else
if PTargetShipRec(Key1)^.id > PTargetShipRec(Key2)^.id then i:= 1 else
i:= 0;
end;
procedure TTargetShipCollection.Store(var S: TStream);
var
i, ii: integer;
p: PTargetShipRec;
begin
S.Write(Count, 2);
for i:= 0 to Count-1 do
begin
p:= at(i);
S.Write(p^.id, 2);
S.Write(p^.race, 2);
S.Write(p^.warp, 2);
S.Write(p^.x, 2);
S.Write(p^.y, 2);
S.Write(p^.typ, 2);
S.Write(p^.heading, 2);
S.Write(p^.Name[1], 20);
end;
end;
procedure TXYShipCollection.FreeItem(Item: Pointer);
begin
Dispose(PXYShipRec(Item));
end;
function TXYShipCollection.Compare(Key1, Key2: Pointer): Integer;
var i: integer;
begin
if PXYShipRec(Key1)^.id < PXYShipRec(Key2)^.id then i:= -1 else
if PXYShipRec(Key1)^.id > PXYShipRec(Key2)^.id then i:= 1 else
i:= 0;
end;
procedure TXYShipCollection.Store(var S: TStream);
var
i, ii: integer;
p: PXYShipRec;
w, act: word;
begin
w:= 0;
act:= 0;
p:= at(act);
for i:= 1 to 500 do
begin
if p^.id = i then
begin
S.Write(p^.x, 2);
S.Write(p^.y, 2);
S.Write(p^.race, 2);
S.Write(p^.mass, 2);
inc(act);
if act < count then p:= at(act);
end else
begin
S.Write(w, 2);
S.Write(w, 2);
S.Write(w, 2);
S.Write(w, 2);
end;
end;
end;
procedure TPlanetCollection.FreeItem(Item: Pointer);
begin
Dispose(PPlanetRec(Item));
end;
procedure THSTPlanetCollection.FreeItem(Item: Pointer);
begin
Dispose(PHSTPlanetRec(Item));
end;
procedure TPlanetsCollection.FreeItem(Item: Pointer);
begin
Dispose(PPlanets(Item));
end;
procedure TBaseCollection.FreeItem(Item: Pointer);
begin
Dispose(PPlanets(Item));
end;
begin
with NewRaceArray[0] do
begin
LongName := '';
Name := '';
ShortName:= '';
end;
end.
|
This page was created using
|
 |
Bookmark this page.
|
|
|
