|
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 enth„lt 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 enth„lt 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^ | |
