Unit VPAData; (* VPA Data Structures *)
{$C MOVEABLE PRELOAD PERMANENT}
Interface
uses Mouse,AuxF,StrF;
const Version = '3.60d';
VerNum = 360;
type IArr11 = array [1..11] of int;
fcstr = array [1..3] of char;
type pptr = ^PRec;
PRec = record
when0 : int; { earliest data }
when : int; { latest data }
{ dat---> } owner : int; (* mandatory *)
{number : int; - in .dat only}
fcode : fcstr;
mines : int;
factories : int;
defense : int;
N,T,D,M : long; { on surface } { Dark Sense: }
colonists : long; { N,T,D,M<>-1 }
supplies : long; { Nc,Tc,Dc,Mc=-1 }
funds : long;
Nc,Tc,Dc,Mc : long; { in core } { =-2 for UTIL.DAT }
Nm,Tm,Dm,Mm : int; { 100 mines per 1 turn }
Ctax,Ntax : int;
Cstat,Nstat : int;
Ngovt : int;
natives : long;
Nrace : int;
climate : int;
{ dat---> } build : int;
end;
bptr = ^BRec;
BRec = record
{ dat---> } {planet : int; - in .dat only}
owner : int; (* mandatory *)
defense : int;
damage : int;
El,Hl,Wl,Tl : int;
EE : array [1..9] of int;
HH : array [1..20] of int;
WW,LL,TT : array [1..10] of int;
fighters : int;
fShip,fOp : int;
order : int;
{ dat---> } cHl,cEl,cWl,cWn,cTl,cTn,cBn : int;
end;
sptr = ^SRec;
SRec = record
when : int;
{ dat---> } {number : int; - in .dat only}
owner : int; (* mandatory *)
fcode : fcstr;
warp : int;
wx,wy : int; { waypoint }
x,y : int; { location } (* mandatory *)
El,hull,Wl,weapons,bays,Tl,TFnum,launchers : int;
mission : int; { if mission=-1 then enemy=heading }
enemy : int; { else wx,wy - waypoint }
tow_ship : int;
damage : int;
crew : int;
colonists : int;
name : array [1..20] of char;
fuel : int;
T,D,M,Sup : int;
CN,CT,CD,CM,CC,CS,CPl : int; { Unload/Jettison }
TN,TT,TD,TM,TC,TS,TSh : int; { Transfer }
intr_ship : int;
{ dat---> } credits : int;
mass,mass1,mass2 : int;
px1,py1,px2,py2 : int;
end;
STRec = record
{ dat---> } {number : int; - in .dat only}
owner : int;
warp : int;
x,y : int;
hull : int;
heading : int;
{ dat---> } name : array [1..20] of char;
end;
SVRec = record
{ dat---> } x,y : int;
owner : int;
{ dat---> } mass : int;
end;
mptr = ^MRec;
MRec = record
when : int;
x,y : int;
owner : int;
units : long;
web : int; { bit 0 - web, bit 1 - from KORE }
end;
MKRec = record { mine record in KORE.DAT }
x,y : int;
radius : int;
owner : int;
end;
iptr = ^IRec;
IRec = record
x,y : int;
radius : int;
voltage : int;
heading : int;
warp : byte;
grow : boolean;
px1,py1,px2,py2 : int;
end;
uptr = ^URec;
URec = record
when : int;
{ dat---> } color : int;
name : array [1..20] of char;
info : array [1..2,1..20] of char;
x,y : int;
warp : int;
heading : int;
rangeP : int;
rangeS : int;
radius : int;
{ dat---> } parent : int;
px1,py1,px2,py2 : int;
end;
wptr = ^WRec;
WRec = record
when : int;
x,y : int;
mass : int;
stable : int;
end;
EPln = record
when : int; { for sensor sweep }
owner : byte;
activity : byte;
{ bits 0-2 (and 7) = industrial activity
bit 7 (and 128) = base }
end;
const EP_Activity = 7; { mask for all industrial activity }
EP_Base = 128; { mask for base }
EP_NoBase = 64; { mask for no base }
{ these bits in newplan[i] indicate which fields are from this turn }
const NP_Owner = 1;
NP_NTDM_Funds = 2;
NP_MFD_FCode = 4;
NP_CPop = 8;
NP_NRace_NPop = 16;
NP_Climate = 32;
NP_Base = 64;
NP_Supplies = 128;
NP_See_It = 63+128;
type MarkType= (mrkNone,mrkFlag,mrkCircle,mrkCross,mrkSquare,
mrkRhombe,mrkPoint,mrkRCircle,mrkLine,mrkDLine,
mrkGrave,mrkCactus);
const LastMark= mrkCactus;
type MapMark = record
mtype : MarkType;
color : byte;
x,y : int;
bind : int; { msgn if > 0, ship id if < 0 }
case byte of
0 : (text : word; { for all others }
xalg,yalg : byte);
1 : (word0 : word; { for RCircle }
radius : word);
2 : (dx,dy : int) { for Line, DLine }
end;
Marks = array [1..2047] of MapMark;
var MarkXAlg : byte;
MarkYAlg : byte;
MarkGroup : array[MarkType] of String[15];
LastMarkMask : int;
MarkMask : array[0..15] of String;
CurMarkMask : int;
type
tdptr = ^TurnData;
TurnData = record
planet : array [1..500] of pptr;
base : array [1..500] of bptr;
ship : array [1..999] of sptr;
mines : array [1..500] of mptr;
ion : array [1..50] of iptr;
worm : array [0..199] of wptr;
ufo : array [1..100] of uptr;
eplan : array [1..500] of EPln;
newplan : array [1..500] of byte;
xyplan : array [1..500,1..2] of int;
nmark : int;
mark : ^Marks;
mtsize : word;
mtext : ^ByteArr;
ipos,opos,vpos : long; { f.positions of msg blocks }
inum,onum,vnum : int; { # of msgs in .db }
mopos : long; { f.pos of msgobj block }
end;
Score4 = array [1..4] of int;
ScoreList = array [1..11] of Score4; { PCFB }
PBPList = array [1..11] of int;
tptr = ^TRec;
TRec = record
prev,next : tptr;
turn : int;
fpos : long;
unk : boolean; { unknown blocks present }
score : ScoreList;
IsPBP : boolean;
PBP : PBPList;
data : tdptr;
end;
{ Planett = record
x,y : int;
name : array [1..20] of char;
end;}
HullType= record
name : array [1..18] of char;
pic : int;
maxmass : int;
T,D,M : int;
fuel : int;
crew : int;
engines : int;
mass : int;
tech : int;
cargo : int;
bays,launchers,weapons : int;
cost : int;
end;
EngType = record
name : array [1..18] of char;
cost : int;
T,D,M : int;
tech : int;
burn : array [1..9] of long;
end;
BeamType= record
name : array [1..18] of char;
cost : int;
T,D,M : int;
mass : int;
tech : int;
kill,expl : int;
end;
TorpType= record
name : array [1..6] of char;
cost,tcost : int; { cost = torp, tcost = tube! }
T,D,M : int;
mass : int;
tech : int;
kill,expl : int;
end;
MITptr = ^MITmisn;
MITmisn = record
next : MITptr;
mission : int;
name : string[18];
iname,tname : string[12];
param : word; { bit mask: 1 shl race }
end; { I = $8000, T = 1 }
const MIT_I = $8000;
MIT_T = 1;
const DBHeader : array [1..14] of char = 'VPA Database'#13#10;
DBVersion : byte = 6;
DBHeadLen = 15;
PRecordSize = 85; { planet }
BRecordSize = 156; { base }
SRecordSize = 107; { ship }
STRecordSize = 34; { target }
MRecordSize = 8; { mines in KOREn.DAT }
IRecordSize = 12; { ions in KOREn.DAT }
URecordSize = 78; { UFO in KOREn.DAT }
type DBlock = record
tag : long;
size : long;
number : int;
end;
TimeStamp = array [1..18] of char;
TBlock = record
tag : long;
size : long;
number : int;
stamp : TimeStamp;
score : ScoreList;
end;
(*
VPA.db ver 6 file structure:
DBHeader 14
DBVersion 1
T_TAG 4
Size 4
Turn number 2
TimeStamp 18 { stamp[1] = #0 means no stamp }
Score 88
Turn data Size
...
T_TAG 4
Size 4
Turn number 2
TimeStamp 18
Score 88
Turn data Size
...
Turn data structure:
Data block TAG 4
Size 4
# of records 2
Data block Size
Planet record:
id number 2
PRec SizeOf(PRec)
Incoming message data block:
message headers N*6
message data Size-N*6 (Size from DBlock)
Incoming message header:
offset from start 4
length 2
Outgoing message data block:
message headers N*10
message data Size-N*10 (Size from DBlock)
Outgoing message header:
offset from # of recs 4 (# of recs from DBlock)
length 2
from 2
to 2
*)
const T_TAG = $4E525554; { TURN }
P_TAG = $4E414C50; { PLAN }
B_TAG = $45534142; { BASE }
S_TAG = $50494853; { SHIP }
M_TAG = $454E494D; { MINE }
I_TAG = $534E4F49; { IONS }
U_TAG = $534F4655; { UFOS }
W_TAG = $4D524F57; { WORM }
E_TAG = $4E4C5045; { EPLN }
N_TAG = $4E4C504E; { NPLN }
A_TAG = $4B52414D; { MARK }
V_TAG = $53524356; { VCRS }
IM_TAG = $47534D49; { IMSG }
OM_TAG = $47534D4F; { OMSG }
MO_TAG = $4F47534D; { MSGO }
PP_TAG = $53504250; { PBPS }
VE_TAG = $53524556; { VERS }
PH_TAG = $54534850; { PHST }
PW_TAG = $53534150; { PASS }
SC_TAG = $524F4353; { SCOR }
RE_TAG = $53464552; { REFS }
XY_TAG = $4C505958; { XYPL }
TurnVer : int = 0;
TRoot : tptr = nil;
TEnd : tptr = nil;
const LockLo = $07FF; { lo and hi lock masks }
LockHi = $7800; { 16 types * 2047 objects supported }
const LockP = $0800; { planet }
LockS = $1000; { ship }
LockM = $1800; { minefield }
LockI = $2000; { ion storm }
LockA = $2800; { marker }
LockW = $3000; { wormhole }
LockU = $3800; { UFO }
const addir : string[67] = '';
lock : int = 0;
ltype : int = 0;
force : int = 0;
distlock: int = 0;
dll : int = 468;
SWPlan : boolean = Yes;
RegWP : boolean = No;
RegVPA : boolean = No;
RWMode : boolean = Yes;
NewTurn : boolean = No;
DFiles : boolean = Yes;
GPause : boolean = No;
Batch : boolean = No;
MaySave : boolean = No;
PHOST : boolean = No;
var PHOSTver: string[7];
const NatRace : array [0..10] of string[10] =
('','Humanoid','Bovinoid','Reptilian','Avian','Amorphous',
'Insectoid','Amphibian','Ghipsoldal','Siliconoid','??????????');
NatGovt : array [0..9] of string[14] =
('Communism!!!','Anarchy','Pre-Tribal','Early Tribal','Tribal',
'Feudal','Monarchy','Representative','Participatory','Unity');
Missions: array [0..15] of string[12] =
('','Exploration','Mine Sweep','Lay Mines','KILL!!!',
'Sensor Sweep','Colonize','Tow','Intrcept','','Cloak',
'Beam Up Fuel','Beam Up Du','Beam Up Tr','Beam Up Mo','Beam Up Supp');
SpecMisn: array [1..11] of string[12] =
('Super Refit','Hissssss!','Super Spy','Pillage','Rob Ship','Repair Self',
'Web Mines','Dark Sense','Bld Fighters','Grnd Attack','Bld Fighters');
BaseOrd : array [0..6] of string[17]=
('','Refuel','Maximize Defense','Load Torpedoes','Unload Freighters','Repair Base','Force a Surrender');
Industry: array [0..5] of string[11] =
('Strange','Minimal','Light','Moderate','Substantial','Heavy');
IonGrow : array [boolean] of string[9] = ('weakening','growing');
IonLevel: array [1..5] of string[15] =
('Harmless','Moderate','Strong','Dangerous','Very DANGEROUS!');
Stability: array [0..6] of string[18] =
('Strange','Very stable','Stable','Mostly stable',
'Unstable','Very unstable','Completely unstabl');
type climate = (Arctic,Cool,Warm,Tropic,Desert);
MFDtype = (_Mine,_Factory,_Defense);
TLtype = (_El,_Hl,_Wl,_Tl);
const ClimStr : array [climate] of string[6] = ('Arctic','Cool','Warm','Tropic','Desert');
TScale : array [climate] of byte = (0,15,40,65,85);
mfdFNum : array [MFDtype] of int = (200,100,50);
mfdCost : array [MFDtype] of int = (4,3,10);
TechRace: array [TLtype] of int = (8,1,7,9);
MIT : MITptr = nil;
const MinSM : int = 1000;
MaxSM : int = 0;
today : int = 0;
Stamp : TimeStamp = #0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0;
{var Planets : array [1..500] of Planett;}
var PlanName: array [1..500,1..20] of char;
StormName:array [1..50,1..20] of char;
Hulls : array [0..105] of HullType;
Engines : array [1..9] of EngType;
Beams : array [1..10] of BeamType;
Torps : array [1..10] of TorpType;
wmm,tmm : int; { weap and torp max mass }
RaceHull: array [1..11,1..20] of word;
RaceName: array [0..12,1..12] of char;
RaceFull: array [1..12,1..30] of char;
pname : array [1..20] of char;
player : int;
plstr : string[2];
dbname : filename;
TTurn : tptr;
TPrev : tptr;
turn : int;
lship : sptr;
lplan : pptr;
lbase : bptr;
cloneID : int; { ship ID to be cloned }
splan : array [1..999] of int;
chuns : boolean;
const IsData : array [-1..11] of boolean = (No,No,No,No,No,No,No,No,No,No,No,No,No);
const Race : array [1..12] of int = (1,2,3,4,5,6,7,8,9,10,11,12);
TrueHullByRace : boolean = Yes;
TaxRate : IArr11 = (200,100,100,100,100,100,100,100,100,100,100);
MinRate : IArr11 = (70,200,100,100,100,100,100,100,100,100,100);
IsHiss : boolean = Yes;
HissEffect : byte = 5;
DetectMineRange : int = 200;
WebMines : boolean = Yes;
SweepRate : int = 4;
IsESBonus : boolean = Yes;
ESBonus : byte = 50;
FedCrew : boolean = Yes;
Gravity : boolean = Yes;
GravityRange : byte = 3;
RoundWells : boolean = Yes;
HYPGravity : boolean = Yes;
AccurateFuelModel : boolean = No;
MaxIncome : long = 5000;
CloakFuelBurn : int = 5;
CloakPreventDamage : byte = 1;
Cloning : boolean = Yes;
CloneCost : IArr11 = (200,200,200,200,32767,200,32767,200,200,200,200);
Wormholes : boolean = No;
WormPower : int = 25;
Gambling : boolean = Yes;
Chunnel : boolean = Yes;
IsMines : boolean = Yes;
Alchemy : boolean = Yes;
ColFBuild : boolean = Yes;
RobFBuild : boolean = Yes;
RGA : boolean = Yes;
SuperRefit : boolean = Yes;
Terraformers : boolean = Yes;
OneEngineTow : boolean = No;
HyperDrive : boolean = Yes;
GloryDevice : boolean = Yes;
AntiCloak : boolean = Yes;
ImperialAssault : boolean = Yes;
AdvancedRefinery: boolean = Yes;
BioScanners : boolean = Yes;
RamScoop : byte = 2;
NoFuelMove : boolean = Yes;
var Password : string[10];
const NoPassword : array [1..10] of char = 'NOPASSWORD';
NewPassword : string[10] = '';
PlanetsRegInfo : array [1..2,1..25] of char =
( 'VGA Planets shareware ', 'Version 3.00 ' );
PWpos : long = 0;
type xtype = (Sh,Pl,Ba); { EXACTLY this order!!! }
var Changed : array [xtype,0..1000 div 8] of byte;
const DataChg : boolean = No;
FIZZ_BIN: array [1..8] of char = 'FIZZ.BIN';
xFName : array [xtype] of string[5] = ('SHIP','PDATA','BDATA');
xISize : array [xtype] of byte = (SRecordSize,PRecordSize,BRecordSize);
xINum : array [xtype] of byte = (1,2,1);
xFizz : array [xtype] of int = (667,1667,1262);
type ch20 = array [1..20] of char;
LRtype = (Left,Right);
VCRData = record
K0 : int;
int0 : int;
plnpic : int;
planet : int;
shpw : array [LRType] of int;
dd : array [LRType] of record
name : ch20;
dam,crew,id : int;
race,realrace : byte;
pic,wl,
weaps,bays,tl,tfn,launs : int;
end;
shld : array [LRType] of int;
end;
const VCSpeed : byte = 5;
VCSet : byte = 8;
type PDRec = record
id : int;
mines : int;
factories : int;
defense : int;
supplies : long; { total supp on the pl and all ships }
end;
PDArr = array [1..500] of PDRec;
const PDis : ^PDArr = nil;
PDisN : int = 0;
type BDRec = record
id : int;
fpos : long; { -> owner }
TF : array [0..10] of int; { 0 - fighters }
end; { total on base and all ships }
BDArr = array [1..500] of BDRec;
const BDis : ^BDArr = nil;
BDisN : int = 0;
var LocationPlanet : int;
LocationX,LocationY : int;
type HullFuncs = (hfAlchemy,hfRefinery,hfAdvRefinery,
hfHeat50,hfCool50,hfHeat100,
hfHyperDrive,hfGravitonic,
hfAllWormScan,hfGambling,hfAntiCloak,
hfImperialAssault,hfChunneling,hfRamScoop,
hfFullBioScan,hfAdvCloak,hfCloak,hfBioScan,
hfGloryDeviceL,hfGloryDeviceH);
const HullFunc1 = hfAlchemy;
HullFunc2 = hfGloryDeviceH;
HullFuncName : array [1..5,1..50] of char =
( 'Alchemy Refinery AdvancedRefinery HeatsTo50 CoolsT',
'o50 HeatsTo100 Hyperdrive Gravitonic ScansAllWormh',
'oles Gambling AntiCloak ImperialAssault Chunneling',
' RamScoop FullBioscan AdvancedCloak Cloak Bioscan ',
'GloryDeviceLowDamage GloryDeviceHighDamage ' );
var HullFunc: ^IntArr; { [Hull,Fn],[Hull,Fn],... }
HullFN : int;
const ReservedMemory = 30000;
ResMem : pointer = nil;
const FCChar : array [0..61] of char = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
procedure CheckMem (m:long);
procedure LockReservedMemory;
procedure UnLockReservedMemory (m:long);
function Distance2 (x1,y1,x2,y2:int) : long;
function Ceil (a:single) : longint;
function TSearch (turn:int) : tptr;
function PSearchXY (xx,yy:int) : int;
function PSearchNm (s:str20) : int;
function PDSearch (id:int) : int;
function BDSearch (id:int) : int;
procedure LoadBDis (id:int; var b:BRec);
function ShipIsHere (i,x,y:int) : boolean;
function MSearchXY (x,y:int) : int;
function OpenFile (var f:file; name:str79; mode:byte; mustbe:boolean) : boolean;
function OpenData (var f:file; name:filename; mustbe:boolean) : boolean;
function OpenRW (var f:file; name:filename; mustbe:boolean) : boolean;
function OpenW (var f:file; name:filename; mustbe:boolean) : boolean;
procedure CloseData (var f:file);
procedure ReadTurnList;
function LoadTurnData (t:tptr) : boolean;
procedure NewTurnData (t:tptr);
procedure SetTurn (t:int);
function CreateMark (var m:MapMark) : int;
procedure EraseMark (k:int);
procedure SetMarkText (k:int; var s:string);
function GetMarkText (k:int) : str20;
function PlanetIncome (p:pptr) : long;
function MiningRate (p:pptr; NTDMc:long; NTDMm:int) : int;
function MaxPlanetStruct (p:pptr; limit:int) : int;
function CHappyChange (id:int) : int;
function NHappyChange (id:int) : int;
function ClimateType (t:int) : climate;
function PlName (n:int; SayPlanet:boolean) : str20;
function Location (x,y:int) : str20;
function HullFit (n:byte; m1,m2:int) : boolean;
function OwnShipDesign (owner,hull:byte) : boolean;
function FuelCargoMass (h:sptr) : str20;
{function CloakFuel (h:sptr) : int;
function CalcFuel (h:sptr) : long;
function ETA (h:sptr) : int;}
procedure CalcMove (var sh:SRec; limit_fuel:boolean);
procedure CalcMovement (h:sptr; var burn,time:int);
procedure SetShipMass (var h:SRec);
procedure RandomFCode (var s:fcstr);
procedure ChangeData (xt:xtype; n:int);
function IfChanged (xt:xtype; n:int) : boolean;
function IsHullFunc (h:byte; f:HullFuncs) : int;
Implementation
uses Screen;
procedure CheckMem (m:long);
begin
if MaxAvail<m+15 then RunError(250);
end;
procedure LockReservedMemory;
begin
if ResMem<>nil then RunError(251);
if MaxAvail<ReservedMemory then RunError(250);
GetMem(ResMem,ReservedMemory);
end;
procedure UnLockReservedMemory (m:long);
begin
if ResMem=nil then RunError(251);
if m>ReservedMemory then RunError(250);
FreeMem(ResMem,ReservedMemory);
ResMem:=nil;
end;
function Distance2 (x1,y1,x2,y2:int) : long;
var dx,dy : long;
begin
dx:=x1-x2; dy:=y1-y2;
Distance2:=dx*dx+dy*dy
end;
function Ceil (a:single) : longint;
begin
if Frac(a)=0 then Ceil:=Round(a)
else if a>0 then Ceil:=Round(a+0.5)
else Ceil:=Round(a-0.5);
end;
function TSearch (turn:int) : tptr;
var t : tptr;
begin
t:=TEnd;
while (t<>nil) and (t^.turn<>turn) do t:=t^.prev;
TSearch:=t;
end;
function PSearchXY (xx,yy:int) : int;
var i : int;
data : tdptr;
begin
PSearchXY:=0;
if (TTurn=nil) or (TTurn^.data=nil) then data:=TEnd^.data
else data:=TTurn^.data;
with data^ do
for i:=1 to 500 do
if (xyplan[i,1]=xx) and (xyplan[i,2]=yy) then
begin PSearchXY:=i; Break end;
end;
function PSearchNm (s:str20) : int;
var i : word;
ls : byte absolute s;
begin
PSearchNm:=0;
with TTurn^.data^ do
for i:=1 to 500 do
if (xyplan[i,1]<>-1) and (StrCmp(PlanName[i],s,ls)) then
begin PSearchNm:=i; Break end;
end;
function PDSearch (id:int) : int;
var i : int;
begin
for i:=1 to PDisN do
if PDis^[i].id=id then begin PDSearch:=i; Exit end;
PDSearch:=0;
end;
function BDSearch (id:int) : int;
var i : int;
begin
for i:=1 to BDisN do
if BDis^[i].id=id then begin BDSearch:=i; Exit end;
BDSearch:=0;
end;
procedure LoadBDis (id:int; var b:BRec);
var i : int;
f : file;
begin
i:=BDSearch(id); { MUST be i<>0 }
OpenRW(f,xFName[Ba]+plstr+'.DIS',Yes);
Seek(f,BDis^[i].fpos);
BlockRead(f,b,BRecordSize-2);
CloseData(f);
end;
function ShipIsHere (i,x,y:int) : boolean;
var h : sptr;
begin
h:=TTurn^.data^.ship[i];
ShipIsHere:=(h<>nil) and (h^.when=turn) and (h^.x=x) and (h^.y=y);
end;
function MSearchXY (x,y:int) : int;
var i : int;
m : mptr;
begin
for i:=1 to 500 do
begin
m:=TTurn^.data^.mines[i];
if (m<>nil) and (m^.x=x) and (m^.y=y) then begin MSearchXY:=i; Exit end;
end;
MSearchXY:=0;
end;
function OpenFile (var f:file; name:str79; mode:byte; mustbe:boolean) : boolean;
begin
OpenFile:=No;
FileMode:=mode;
Assign(f,name);
Reset(f,1);
if (IOResult<>0) or (FileSize(f)=0) then
if mustbe then begin Writeln(#13#10'Can''t read file ',name); Halt end
else Exit;
OpenFile:=Yes;
end;
function OpenData (var f:file; name:filename; mustbe:boolean) : boolean;
begin
OpenData:=No;
FileMode:=0;
Assign(f,addir+name);
Reset(f,1);
if (IOResult<>0) or (FileSize(f)=0) then
begin
Assign(f,name);
Reset(f,1);
if (IOResult<>0) or (FileSize(f)=0) then
if mustbe then begin Writeln(#13#10'Can''t read file ',name); Halt end
else Exit;
end;
OpenData:=Yes;
end;
function OpenRW (var f:file; name:filename; mustbe:boolean) : boolean;
begin
OpenRW:=Yes;
FileMode:=2;
Assign(f,addir+name);
Reset(f,1);
if IOResult<>0 then
if mustbe then
begin Writeln(#13#10'Can''t read/write file ',addir,name); Halt end
else OpenRW:=No;
end;
function OpenW (var f:file; name:filename; mustbe:boolean) : boolean;
begin
Assign(f,addir+name);
Rewrite(f,1);
if IOResult=0 then OpenW:=Yes
else begin
Writeln(#13#10'Can''t write file ',addir,name);
if mustbe then Halt;
OpenW:=No;
end;
end;
procedure CloseData (var f:file);
begin
Close(f); if IOResult=0 then ;
end;
procedure ReadTurnList;
var id : array [1..DBHeadLen] of char;
tb : TBlock;
b : DBlock;
t : tptr;
fp : long;
f : file;
procedure AddTurn;
begin
CheckMem(SizeOf(TRec));
New(t); t^.next:=nil;
if TRoot=nil then
begin
t^.prev:=nil;
TRoot:=t;
end
else begin
TEnd^.next:=t;
t^.prev:=TEnd;
end;
TEnd:=t;
t^.fpos:=fp;
t^.unk:=No;
t^.IsPBP:=No;
t^.data:=nil;
end;
begin
fp:=0;
Assign(f,addir+dbname);
Reset(f,1);
if IOResult<>0 then Writeln(' doesn''t exist yet.')
else begin
Writeln;
BlockRead(f,id,DBHeadLen);
if Copy(id,1,14)<>DBHeader then RunError(254);
if byte(id[15])<>DBVersion then
begin Writeln('ERROR: Unknown version of VPA database'); Halt end;
fp:=FilePos(f);
while not Eof(f) do
begin
BlockRead(f,tb,SizeOf(tb));
if (IOResult<>0) or
(tb.tag<>T_TAG) or (tb.size<0) or (tb.number<=0) then RunError(254);
if (today<>0) and ((tb.number>today) or ((tb.number=today) and
(tb.stamp[1]<>#0) and (tb.stamp<>Stamp))) then Break;
AddTurn;
t^.turn:=tb.number;
t^.score:=tb.score;
if tb.size>=SizeOf(b) then
begin
BlockRead(f,b,SizeOf(b));
if b.tag=PP_TAG then
begin
t^.IsPBP:=Yes;
BlockRead(f,t^.PBP,SizeOf(PBPList));
end;
end;
Seek(f,fp+SizeOf(tb)+tb.size);
if IOResult<>0 then RunError(254);
fp:=FilePos(f);
end;
CloseData(f);
end;
TTurn:=TEnd; { set TTurn to the last turn in db }
if (today<>0) and ((TEnd=nil) or (TEnd^.turn<>today)) then
begin
AddTurn;
t^.turn:=today;
end;
if TEnd<>nil then today:=TEnd^.turn;
end;
procedure NewTurnData (t:tptr);
var i : int;
begin
if t^.data<>nil then Exit;
New(t^.data);
FillChar(t^.data^,SizeOf(TurnData),0);
t^.data^.xyplan[1,1]:=-30000; { XREF to LoadMap }
end;
procedure DisposeTurnData (t:tptr);
var i : int;
begin
if t^.data=nil then Exit;
with t^.data^ do
begin
for i:=0 to 500 do
begin
if (i>=1) and (i<=500) then
begin
if planet[i]<>nil then Dispose(planet[i]);
if base[i]<>nil then Dispose(base[i]);
if mines[i]<>nil then Dispose(mines[i]);
end;
if (i>=1) and (i<=999) then
if ship[i]<>nil then Dispose(ship[i]);
if (i>=1) and (i<=50) and (ion[i]<>nil) then Dispose(ion[i]);
if (i>=1) and (i<=100) and (ufo[i]<>nil) then Dispose(ufo[i]);
if (i>=0) and (i<=199) and (worm[i]<>nil) then Dispose(worm[i]);
end;
if mark<>nil then FreeMem(mark,nmark*SizeOf(MapMark));
if mtext<>nil then FreeMem(mtext,mtsize);
end;
Dispose(t^.data);
t^.data:=nil;
end;
function FreeDataMemory (size:long; critical:boolean) : boolean;
var t,t1,t2 : tptr;
m : long;
begin
m:=MaxAvail;
t1:=TRoot;
t2:=TEnd^.prev; if t2=nil then t2:=t1;
while (m<size) and ((t1<>TTurn) or (t2<>TTurn)) do
begin
if Abs(t1^.turn-turn)>Abs(t2^.turn-turn) then
begin t:=t1; t1:=t1^.next end
else
begin t:=t2; t2:=t2^.prev end;
if t=nil then Break;
DisposeTurnData(t);
m:=MaxAvail;
end;
FreeDataMemory:=(m>=size);
if critical and (m<size) then RunError(250);
end;
function LoadTurnData (t:tptr) : boolean;
var i,k : word; { word, not int }
b : DBlock;
fp : long;
f : file;
isxyplan: boolean;
function NoMem (m:word) : boolean;
begin
NoMem:=No;
if not FreeDataMemory(m,Yes) then
begin
Close(f);
NoMem:=Yes;
end;
end;
begin
LoadTurnData:=No;
if (t=nil) or (t^.fpos=0) or (t^.data<>nil) then Exit;
if not FreeDataMemory(SizeOf(TurnData),Yes) then Exit;
Assign(f,addir+dbname);
Reset(f,1);
if IOResult<>0 then RunError(253);
Seek(f,t^.fpos+SizeOf(TBlock));
if IOResult<>0 then RunError(253);
NewTurnData(t);
with t^.data^ do
begin
repeat
BlockRead(f,b,SizeOf(b));
if IOResult<>0 then RunError(253);
fp:=FilePos(f);
if b.tag=PP_TAG then
begin
t^.IsPBP:=Yes;
BlockRead(f,t^.PBP,SizeOf(PBPList));
end else
if b.tag=P_TAG then
for i:=1 to b.number do
begin
BlockRead(f,k,2);
if (k<1) or (k>500) or NoMem(SizeOf(PRec)) then Exit;
if planet[k]=nil then New(planet[k]);
BlockRead(f,planet[k]^,SizeOf(PRec));
end else
if b.tag=B_TAG then
for i:=1 to b.number do
begin
BlockRead(f,k,2);
if (k<1) or (k>500) or NoMem(SizeOf(BRec)) then Exit;
if base[k]=nil then New(base[k]);
BlockRead(f,base[k]^,SizeOf(BRec));
end else
if b.tag=S_TAG then
for i:=1 to b.number do
begin
BlockRead(f,k,2);
if (k<1) or (k>999) or NoMem(SizeOf(SRec)) then Exit;
if ship[k]=nil then New(ship[k]);
BlockRead(f,ship[k]^,SizeOf(SRec));
end else
if b.tag=M_TAG then
for i:=1 to b.number do
begin
BlockRead(f,k,2);
if (k<1) or (k>500) or NoMem(SizeOf(MRec)) then Exit;
if mines[k]=nil then New(mines[k]);
BlockRead(f,mines[k]^,SizeOf(MRec));
end else
if b.tag=I_TAG then
for i:=1 to b.number do
begin
BlockRead(f,k,2);
if (k<1) or (k>50) or NoMem(SizeOf(IRec)) then Exit;
if ion[k]=nil then New(ion[k]);
BlockRead(f,ion[k]^,SizeOf(IRec));
end else
if b.tag=U_TAG then
for i:=1 to b.number do
begin
BlockRead(f,k,2);
if (k<1) or (k>100) or NoMem(SizeOf(URec)) then Exit;
if ufo[k]=nil then New(ufo[k]);
BlockRead(f,ufo[k]^,SizeOf(URec));
end else
if b.tag=W_TAG then
for i:=1 to b.number do
begin
BlockRead(f,k,2);
if (k<0) or (k>199) or NoMem(SizeOf(WRec)) then Exit;
if worm[k]=nil then New(worm[k]);
BlockRead(f,worm[k]^,SizeOf(WRec));
end else
if b.tag=E_TAG then BlockRead(f,eplan,SizeOf(eplan)) else
if b.tag=N_TAG then BlockRead(f,newplan,SizeOf(newplan)) else
if b.tag=XY_TAG then BlockRead(f,xyplan,SizeOf(xyplan)) else { number=500, size=2000 }
if b.tag=A_TAG then
begin
if mark<>nil then FreeMem(mark,nmark*SizeOf(MapMark));
if mtext<>nil then FreeMem(mtext,mtsize);
if NoMem(b.size+16) then Exit;
nmark:=b.number;
k:=nmark*SizeOf(MapMark);
if nmark>0 then
begin
GetMem(mark,k);
BlockRead(f,mark^,k);
end;
mtsize:=b.size-k;
if mtsize>0 then
begin
GetMem(mtext,mtsize);
BlockRead(f,mtext^,mtsize);
end;
end else
if b.tag=IM_TAG then
begin
ipos:=fp-2;
inum:=b.number;
Seek(f,fp+b.size);
end else
if b.tag=OM_TAG then
begin
opos:=fp-2;
onum:=b.number;
Seek(f,fp+b.size);
end else
if b.tag=V_TAG then
begin
vpos:=fp-2;
vnum:=b.number;
Seek(f,fp+b.size);
end else
if b.tag=MO_TAG then
begin
mopos:=fp;
Seek(f,fp+b.size);
end else
if b.tag=PW_TAG then
begin
if t^.turn=today then PWpos:=fp;
Seek(f,fp+b.size);
end else
if b.tag=VE_TAG then
begin
TurnVer:=b.number;
{Seek(f,fp+b.size);} { size = 0 }
end else
if b.tag=PH_TAG then
begin
if t^.turn=today then
begin
PHOST:=Yes;
PHOSTver[0]:=char(b.size);
BlockRead(f,PHOSTver[1],b.size);
end
else Seek(f,fp+b.size);
end else
if b.tag<>T_TAG then
begin
t^.unk:=Yes;
Seek(f,fp+b.size);
end;
if IOResult<>0 then RunError(253);
until Eof(f) or (b.tag=T_TAG);
if (t<>TEnd) and (xyplan[1,1]=-30000) then { XREF to LoadMap }
Move(TEnd^.data^.xyplan,xyplan,SizeOf(xyplan));
end;
Close(f);
LoadTurnData:=Yes;
end;
procedure SetSPlan;
var i : int;
begin
FillChar(splan,SizeOf(splan),0);
chuns:=No;
for i:=1 to 999 do
if TTurn^.data^.ship[i]<>nil then
with TTurn^.data^.ship[i]^ do
begin
splan[i]:=PSearchXY(x,y);
if (not chuns) and (turn=TTurn^.turn) and (IsHullFunc(hull,hfChunneling)<>0) then chuns:=Yes;
end;
end;
procedure SetTurn (t:int);
begin
TTurn:=TSearch(t);
if TTurn=nil then Exit;
turn:=t;
if TTurn^.data=nil then LoadTurnData(TTurn);
TPrev:=TSearch(t-1);
if (TPrev<>nil) and (TPrev^.data=nil) then TPrev:=nil;
SetSPlan;
end;
function CreateMark (var m:MapMark) : int;
var i : int;
s : word;
p : pointer;
begin
CreateMark:=0;
with TEnd^.data^ do
begin
i:=1;
while (i<=nmark) and (mark^[i].mtype<>mrkNone) do inc(i);
if i>nmark then
begin
if (i>2047) or (i>65520 div SizeOf(MapMark)) then Exit;
s:=i*SizeOf(MapMark);
if not FreeDataMemory(s,No) then Exit;
GetMem(p,s);
if nmark>0 then
begin
dec(s,SizeOf(MapMark));
Move(mark^,p^,s);
FreeMem(mark,s);
end;
mark:=p;
inc(nmark);
end;
mark^[i]:=m;
end;
CreateMark:=i;
end;
procedure EraseMark (k:int);
var s : string[1];
begin
with TEnd^.data^.mark^[k] do
begin
if mtype=mrkNone then Exit;
if not (mtype in [mrkRCircle..mrkDLine]) and (text<>0) then
begin
s[0]:=#0;
SetMarkText(k,s);
end;
mtype:=mrkNone;
end;
end;
procedure SetMarkText (k:int; var s:string);
var p : word;
i,mts : int;
ls : byte absolute s;
m : ^ByteArr;
begin
with TEnd^.data^ do
begin
if (k>nmark) or (mark^[k].mtype in [mrkNone,mrkRCircle..mrkDLine]) then Exit;
mts:=0;
for i:=1 to nmark do
if (i<>k) and (not (mark^[i].mtype in [mrkNone,mrkRCircle..mrkDLine])) and (mark^[i].text<>0) then
inc(mts,mtext^[mark^[i].text]+1);
inc(mts,IIF(ls=0,0,word(ls)+1));
if MaxAvail<mts then Exit;
GetMem(m,mts);
p:=1;
for i:=1 to nmark do
if (i<>k) and (not (mark^[i].mtype in [mrkNone,mrkRCircle..mrkDLine])) and (mark^[i].text<>0) then
begin
Move(mtext^[mark^[i].text],m^[p],mtext^[mark^[i].text]+1);
mark^[i].text:=p;
inc(p,m^[p]+1);
end;
if ls=0 then mark^[k].text:=0
else begin
Move(s,m^[p],ls+1);
mark^[k].text:=p;
end;
FreeMem(mtext,mtsize);
mtext:=pointer(m);
mtsize:=mts;
end;
end;
function GetMarkText (k:int) : str20;
var s : str20;
ls : byte absolute s;
p : word;
begin
s:='';
with TTurn^.data^ do
if (k<=nmark) and not (mark^[k].mtype in [mrkNone,mrkRCircle..mrkDLine]) then
begin
p:=mark^[k].text;
if p>0 then
begin
Move(mtext^[p],s,Min(mtext^[p]+1,20));
if ls>20 then ls:=20;
end;
end;
GetMarkText:=s;
end;
function PlanetIncome (p:pptr) : long;
var l : long;
begin
l:=-1;
if p<>nil then
with p^ do
if (colonists>0) and (Ctax<>-1) and
(Nrace<>-1) and (natives<>-1) and (Ntax<>-1) and (Ngovt<>-1) then
if colonists<>0 then
begin
l:=0;
if Nrace<>5 then l:=Round(natives*Ntax*Ngovt/5000);
if colonists<l then l:=colonists;
if Nrace=6 then l:=l*2;
l:=l*TaxRate[owner] div 100+
Round(colonists*Ctax/1000)*TaxRate[owner] div 100;
if l>MaxIncome then l:=MaxIncome;
end;
PlanetIncome:=l;
end;
function MiningRate (p:pptr; NTDMc:long; NTDMm:int) : int;
var l : int;
begin
l:=0;
if p<>nil then
with p^ do
if (owner>0) and (owner<=11) and (Nrace<>-1) and (mines<>-1) and (NTDMc<>0) then
l:=Round(((NTDMm/100)*mines)*IIF(Nrace=3,2,1))*MinRate[owner] div 100;
MiningRate:=l;
end;
function MaxPlanetStruct (p:pptr; limit:int) : int;
begin
MaxPlanetStruct:=0;
with p^ do
if colonists>0 then
if colonists<=limit then MaxPlanetStruct:=colonists
else MaxPlanetStruct:=Round(Sqrt(colonists-limit))+limit;
end;
function HissHChange (id:int) : int;
var k,hn,x,y: int;
h : sptr;
begin
if HissEffect=0 then begin HissHChange:=0; Exit end;
hn:=0;
with TTurn^.data^ do
begin
x:=xyplan[id,1];
y:=xyplan[id,2];
for k:=1 to 999 do
begin
h:=ship[k];
if (h<>nil) and (Race[h^.owner]=2) and (h^.when=turn) and
(h^.x=x) and (h^.y=y) and (h^.mission=9) and
(h^.weapons>0) and (h^.fuel>0) then inc(hn);
end;
end;
HissHChange:=hn*HissEffect;
end;
function CHappyChange (id:int) : int;
var i : int;
p : pptr;
begin
i:=0;
p:=TTurn^.data^.planet[id];
if p<>nil then
with p^ do
if (colonists>0) and (owner<>-1) and (Ctax<>-1) and
(climate<>-1) and (mines<>-1) and (factories<>-1) then
i:=Round( 1000-Sqrt(colonists)-Ctax*80
-Abs(climate-IIF(Race[owner]=7,0,50))*3
-(mines+factories) div 3 ) div 100
+Min(HissHChange(id),Max(100-Cstat,0));
CHappyChange:=i;
end;
function NHappyChange (id:int) : int;
var i : int;
p : pptr;
begin
i:=0;
p:=TTurn^.data^.planet[id];
if p<>nil then
with p^ do
if (Nrace>0) and (natives>0) and (Ntax<>-1) and (Ngovt<>-1) and
(mines<>-1) and (factories<>-1) then
i:=Round( 500-Sqrt(natives)-Ntax*85
-(mines+factories) div 2+Ngovt*50 ) div 100
+IIF(Nrace=4,10,0)
+Min(HissHChange(id),Max(100-Nstat,0));
NHappyChange:=i;
end;
function ClimateType (t:int) : climate;
var c : climate;
begin
for c:=Arctic to Desert do
if 100-t>=TScale[c] then ClimateType:=c;
end;
function PlName (n:int; SayPlanet:boolean) : str20;
var s : str20;
begin
if PlanetNames then s:=PlanName[n]
else begin
s:=NStr0(n);
if SayPlanet then s:='Planet '+s;
end;
Trim(s);
PlName:=s;
end;
function Location (x,y:int) : str20;
var k,xx,yy : int;
gr2 : long;
data : tdptr;
begin
if MapWrap then WrapXY(x,y);
LocationPlanet:=PSearchXY(x,y);
LocationX:=x;
LocationY:=y;
if LocationPlanet<>0 then Location:=PlName(LocationPlanet,Yes)
else begin
if Gravity then
begin
if (TTurn=nil) or (TTurn^.data=nil) then data:=TEnd^.data
else data:=TTurn^.data;
with data^ do
for k:=500 downto 1 do
begin
xx:=xyplan[k,1];
yy:=xyplan[k,2];
gr2:=GravityRange*GravityRange;
if (RoundWells and (Distance2(x,y,xx,yy)<=gr2)) or
((not RoundWells) and (Abs(x-xx)<=GravityRange) and (Abs(y-yy)<=GravityRange)) then
begin
LocationPlanet:=k;
LocationX:=xx;
LocationY:=yy;
Break;
end;
end;
end;
if LocationPlanet<>0 then Location:='÷'+PlName(LocationPlanet,Yes)
else Location:='('+NStr0(x)+','+NStr0(y)+')';
end;
end;
function HullFit (n:byte; m1,m2:int) : boolean;
begin
HullFit:=(m1>=Hulls[n].mass) and (m2<=Hulls[n].maxMass);
end;
function OwnShipDesign (owner,hull:byte) : boolean;
var i : byte;
myrace : int;
begin
OwnShipDesign:=No;
if TrueHullByRace then myrace:=Race[owner]
else myrace:=owner;
for i:=1 to 20 do
if hull=RaceHull[myrace,i] then begin OwnShipDesign:=Yes; Break end;
end;
function FuelCargoMass (h:sptr) : str20;
var i,j : int;
s,s1 : string[6];
begin
s:=''; s1:='';
with h^ do
if (hull<>-1) and (mass<>-1) then
begin
j:=mass-Hulls[hull].mass;
Str(j,s);
i:=Hulls[hull].launchers*tmm+Hulls[hull].weapons*wmm;
if i>0 then
begin
if j<=i then s1:='0' else Str(j-i,s1);
s1:=s1+'-';
end;
end;
FuelCargoMass:=s1+s;
end;
PROCEDURE CalcMove (var sh:SRec; limit_fuel:boolean);
VAR _fuel,_mass,_pmass : long;
_dist,_travel,i : int;
h1 : sptr;
_sdist : single;
dx,dy : int;
gr0,rw0 : boolean;
procedure CalcMoveTim;
begin
with sh do
begin
if _dist<=_travel then _fuel:=Trunc(_fuel*(long(_dist)/long(_travel)/10000)*_mass)
else _fuel:=Trunc(_fuel/10000*_mass);
if limit_fuel and (_fuel>fuel) then
begin
if fuel>0 then
begin
_travel:=Round(long(_travel)*(long(fuel)/_fuel));
fuel:=0;
end
else _travel:=0;
_fuel:=0;
end;
if _travel>Trunc(_sdist-0.9) then
begin
dx:=wx;
dy:=wy;
_dist:=Trunc(_sdist-0.9)+1;
end
else begin
dx:=Round( (long(wx)/_sdist)*_travel );
dy:=Round( (long(wy)/_sdist)*_travel );
_dist:=_travel;
end;
end;
end;
procedure CalcMovePHOST;
var _rate : single;
_distf : single;
_move : single;
begin
with sh do
begin
if _dist>_travel then _move:=_travel
else _move:=_sdist;
_rate:=_fuel/(long(_travel)*100000);
if AccurateFuelModel then _fuel:=Round((1.0-Exp(-_rate*_move))*_pmass)
else _fuel:=Trunc(_rate*10*_mass*Trunc(_move));
if limit_fuel and (_fuel>fuel) then
begin
if fuel=0 then _move:=0 else
if AccurateFuelModel then _move:=Ln(_pmass/(_pmass-fuel))/_rate
else begin
_distf:=_mass*_rate*10;
_dist:=Trunc(fuel/_distf);
while Trunc(_distf*_dist)<=fuel do inc(_dist);
_move:=_dist-0.000001;
end;
fuel:=0;
end;
if _move=_sdist then
begin
dx:=wx;
dy:=wy;
end
else begin
if wx=0 then dx:=0 else dx:=Ceil(wx*_move/_sdist);
if wy=0 then dy:=0 else dy:=Ceil(wy*_move/_sdist);
end;
_dist:=Trunc(_move); {for Cobol}
end;
end;
BEGIN (* CalcMove *)
with sh do
begin
if (IsHullFunc(hull,hfCloak)<>0) and
((mission=10) or ((Race[owner]=3) and (mission=9))) then
begin
_fuel:=Max(Hulls[hull].mass*CloakFuelBurn div 100,CloakFuelBurn);
if (fuel>_fuel) or (not limit_fuel) then
begin
dec(fuel,_fuel); {assuming that Cl.F.B. works before movement}
dec(mass,Max(Min(_fuel,fuel),0));
end
else mission:=0;
end;
if (warp<1) or (wx or wy=0) then Exit;
_sdist:=Sqrt( Distance2(0,0,wx,wy) );
if HyperDrive and (IsHullFunc(hull,hfHyperDrive)<>0) and
(fcode='HYP') and (fuel>=50) then
begin
if (PHOST or (not SWPlan)) and (_sdist>=340) and (_sdist<=360) then
begin
dx:=wx; dy:=wy;
end
else begin
dx:=Trunc(350.0/_sdist*Abs(wx)+0.4999999)*Sign(wx);
dy:=Trunc(350.0/_sdist*Abs(wy)+0.4999999)*Sign(wy);
end;
inc(x,dx); dec(wx,dx);
inc(y,dy); dec(wy,dy);
{wx:=0; wy:=0; warp:=0;}
fcode:='hyp';
dec(fuel,50);
if HYPGravity then
begin
if not PHOST then
begin
gr0:=Gravity; i:=GravityRange; rw0:=RoundWells;
Gravity:=Yes; GravityRange:=2; RoundWells:=No;
end;
Location(x,y);
x:=LocationX;
y:=LocationY;
if not PHOST then
begin
Gravity:=gr0; GravityRange:=i; RoundWells:=rw0;
end;
end;
Exit;
end;
_dist:=Trunc(_sdist);
_travel:=warp*warp;
if IsHullFunc(hull,hfGravitonic)<>0 then _travel:=_travel*2;
_fuel:=Engines[El].burn[warp];
_pmass:=mass;
_mass:=Max(_pmass div 10,1);
i:=IIF(mission=7,tow_ship,0);
if i>0 then { tow }
begin { what about self-towing? }
h1:=TTurn^.data^.ship[i];
if (h1<>nil) and (h1^.mass<>-1) then
begin
_pmass:=h1^.mass;
if TSh=i then inc(_pmass,TN+TT+TD+TM+TC+TS);
if PHOST then
begin
inc(_pmass,mass);
_mass:=0;
end;
inc(_mass,Max(_pmass div 10,1));
end;
end;
if PHOST then CalcMovePHOST
else CalcMoveTim;
inc(x,dx); dec(wx,dx);
inc(y,dy); dec(wy,dy);
dec(fuel,_fuel);
dec(mass,Max(Min(_fuel,fuel),0));
if fuel>=0 then { don't add fuel in Cobol runs out of fuel - to show BURN, not MAKE }
if (not SWPlan) and (hull=96) then
fuel:=Min(fuel+_dist*RamScoop,Hulls[hull].fuel);
if warp>1 then
begin
Location(x,y);
x:=LocationX;
y:=LocationY;
end;
end;
END; (* CalcMove *)
procedure CalcMovement (h:sptr; var burn,time:int);
var sh : SRec;
begin
with h^ do
if (hull=-1) or (mission=-1) or (fuel=-1) or (mass=-1) or (warp=-1) or (El=-1) then
begin
burn:=20000;
time:=20000;
Exit;
end;
sh:=h^;
time:=0;
repeat { CalcMove must be called at least once for cloaking without moving }
if time>=10 then
begin
burn:=20000;
time:=20000;
Break;
end;
if (not NoFuelMove) and (sh.fuel=0) then Break;
CalcMove(sh,No);
inc(time);
until (sh.warp=0) or (sh.wx or sh.wy=0);
burn:=h^.fuel-sh.fuel;
end;
{function CloakFuel (h:sptr) : int;
begin
CloakFuel:=0;
with h^ do
if (IsHullFunc(hull,hfCloak)<>0) and
((mission=10) or ((Race[owner]=3) and (mission=9))) then
CloakFuel:=Max(Hulls[hull].mass*CloakFuelBurn div 100,CloakFuelBurn);
end;}
(*function CalcFuel (h:sptr) : long;
var mm,i2,n : int;
ef,r : long;
n1 : int;
h1 : sptr;
nd,dd,kf : single;
begin
r:=0; n:=0;
with h^ do
begin
if (warp=-1) or (mission=-1) then r:=-1 else
if (warp>0) and (wx or wy<>0) then
begin
dd:=wx; nd:=wy;
dd:=Sqrt(dd*dd+nd*nd); { XREF to LockDistTarget }
mm:=mass;
n1:=IIF(mission=7,tow_ship,0);
if n1>0 then { tow }
begin
h1:=TTurn^.data^.ship[n1];
if (h1<>nil) and (h1^.mass<>-1) then inc(mm,h1^.mass);
if TSh=n1 then inc(mm,TN+TT+TD+TM+TC+TS);
end;
i2:=warp*warp;
if IsHullFunc(hull,hfGravitonic)<>0 then i2:=i2*2;
ef:=Engines[El].burn[warp];
kf:=ef/100000;
n:=Ceil(dd/i2);
dec(n);
if n>0 then inc(r,Trunc(long(mm)*(1-Exp(n*Ln(1-kf)))));
nd:=dd-i2*n;
inc( r , Trunc(nd*((long(mm)-MinL(r,fuel)) div 10)*(ef/i2)/10000) );
end;
inc(n);
inc(r,long(CloakFuel(h))*n);
end;
CalcFuel:=r;
end;*)
(*function ETA (h:sptr) : int;
var i2 : int;
dd : long;
begin
ETA:=0;
with h^ do
begin
if (warp=0) or (wx or wy=0) then Exit;
i2:=warp*warp; { XREF to LockDistTarget }
if IsHullFunc(hull,hfGravitonic)<>0 then i2:=i2*2;
dd:=Distance2(0,0,wx,wy);
if dd<(i2+1)*(i2+1) then ETA:=1 else ETA:=Ceil(Sqrt(dd)/i2); { XREF to Report }
end;
end;*)
procedure SetShipMass (var h:SRec);
begin
h.mass:=Hulls[h.hull].mass+h.weapons*Beams[h.Wl].mass+h.launchers*Torps[h.Tl].mass+
h.fuel+h.T+h.D+h.M+h.Sup+h.colonists+h.TFnum;
h.mass1:=h.mass;
h.mass2:=h.mass;
end;
procedure RandomFCode (var s:fcstr);
begin
s[1]:=FCChar[Random(36)];
s[2]:=FCChar[36+Random(26)];
s[3]:=FCChar[Random(62)];
end;
procedure ChangeData (xt:xtype; n:int);
begin
dec(n);
Changed[xt,n div 8]:=Changed[xt,n div 8] or (1 shl (n and 7));
DataChg:=Yes;
end;
function IfChanged (xt:xtype; n:int) : boolean;
begin
dec(n);
IfChanged:=(Changed[xt,n div 8] and (1 shl (n and 7)) <> 0);
end;
function IsHullFunc (h:byte; f:HullFuncs) : int; assembler;
asm { returns # of (h,f) pair in HullFunc }
push ds
mov bl,h
mov bh,f
mov dx,HullFN
or dx,dx
jz @@3
lds si,HullFunc
mov cx,dx
cld
@@1: lodsw
cmp ax,bx
je @@2
loop @@1
xor dx,dx
jmp @@3
@@2: sub dx,cx
inc dx
@@3: xchg ax,dx
pop ds
end;
Begin
Randomize;
FillChar(Changed,SizeOf(Changed),0);
End.