Unit VPA3; (* VPA Main Part - Actions *)
Interface
uses AuxF,VPAData;
procedure CalcTaxes;
procedure FindPlanet;
procedure FindShip;
procedure DrawUserCircle;
procedure DrawHYPCircles;
procedure DrawMineCircle;
procedure TimeShift (dt:int);
procedure InputHull;
procedure ForgetShip;
procedure SetWarp;
procedure SetFCode (p_s:xtype; rnd:boolean);
procedure RandAllPCodes;
procedure SetName;
function ChooseMission (var misn:int; var md1,md2:boolean; hull,race:int; no_tow1,no_plan1:boolean;
x,y,x2:int) : boolean;
procedure SetMission;
function ChooseEnemy (var en:int; x,y,x2:int) : boolean;
procedure SetEnemy;
function UnloadShip (id:int) : boolean;
procedure UnloadAllShips;
procedure LoadForBuild; { MOT interface }
procedure BuildStructures (mfd:MFDtype); { MOT interface }
procedure SellSupp;
procedure BuildBase;
procedure CancelBase;
procedure IncreaseBaseDefense; { MOT interface }
procedure SetBaseOrder;
procedure BuyShipTF; { MOT interface }
procedure BuyBaseTF; { MOT interface }
procedure TransferCargo (t:xtype); { MOT interface }
procedure UpgradeBaseTech; { MOT interface }
procedure FixOrRecycleShip (bn,op,n:int);
procedure FixOrRecycle (op:byte);
function BuildClone : boolean;
procedure NextPlanet (dn:int);
procedure NextBase (dn:int);
procedure NextShip (dn:int);
procedure NextMines (dn:int);
procedure NextIon (dn:int);
procedure NextWorm (dn:int);
procedure NextUFO (dn:int);
procedure ChangePassword;
Implementation
uses Mouse,Keyboard,Screen,Graph,StrF,VPA2;
procedure CalcTaxes;
var p : pptr;
ip : pointer;
is : word;
s,s1 : string[7];
ls : byte absolute s;
tax,gv : int;
l,nt,cl : long;
kr,a,tr : int;
begin
p:=TTurn^.data^.planet[lock and LockLo];
if (p=nil) or (p^.Nrace=-1) or (p^.natives=-1) or (p^.Ngovt=-1) or (p^.Nrace=0) then Exit;
{MouseOff;}
MouseDisabled:=True;
is:=ImageSize(MX0,168,639,183);
UnLockReservedMemory(is);
GetMem(ip,is);
GetImage(MX0,168,639,183,ip^);
Clear(MX0,168,639,183);
SetColor(LightGray);
OutTextXY(MX0,168,' Taxes:');
OutTextXY(MX0,176,' Money:');
with p^ do
begin
nt:=natives;
gv:=Ngovt;
tax:=IIF(Ntax=-1,0,Ntax);
cl:=colonists; if cl=-1 then cl:=0;
kr:=IIF(Nrace=5,0,IIF(Nrace=6,2,1));
tr:=TaxRate[IIF(p^.owner<=0,player,p^.owner)];
end;
repeat
Clear(MX0+8*8,168,639,183);
SetColor(LightGray);
Str(tax:3,s);
OutTextXY(MX0+8*8,168,s+'% >');
l:=Round(nt*tax*gv/5000);
Str((l*tr div 100)*kr,s); s1:='';
if l>cl then
begin
Str((cl*tr div 100)*kr,s1);
s1:='('+s1+')';
end;
OutTextXY(MX0+8*8,176,s+' '+s1);
s:=GetStr(MX0+14*8,168,3);
if ls>0 then Val(s,tax,a);
until ls=0;
PutImage(MX0,168,ip^,NormalPut);
FreeMem(ip,is);
LockReservedMemory;
MouseDisabled:=False;
{MouseOn;}
end;
function SelectShip (x,y:int; myonly,forclone:boolean) : int;
var h : sptr;
i,k,k0,n: int;
ns : string[4];
s : string[13];
sh : int;
begin
NewMenu; UnLockReservedMemory(MenuSize(MX0,378,631,10,Yes));
sh:=0; k:=0; k0:=0; n:=0;
for i:=1 to 999 do
if ShipIsHere(i,x,y) then
begin
h:=TTurn^.data^.ship[i];
inc(k);
if (h=lship) or (myonly and (h^.owner<>player)) or
(forclone and ((h^.owner<>player) or OwnShipDesign(player,h^.hull))) then
AddMenuItem(' ---',cSInfo,No)
else begin
if h^.hull<>-1 then
if h^.owner=player then s:=h^.name else s:=Hulls[h^.hull].name
else if h^.mass<>-1 then s:='??? ('+NStr0(h^.mass)+'kt)'
else s:='???';
ns:=NStr(i)+' ';
AddMenuItem(ns+s,RaceColor[h^.owner,_S_],No);
k0:=k;
inc(n);
end;
end;
if (k=0) or (n<2) then sh:=k0
else begin
ChooseMenu(MX0,378,MX0,631,10,cSInfo,Yellow,1,No,Yes);
if (MenuKey<>27) and (MenuString<>' ---') then sh:=MenuValue;
end;
NewMenu; LockReservedMemory;
if sh<>0 then sh:=GoToShipXY(h,x,y,sh) and LockLo;
SelectShip:=sh;
end;
procedure FindPlanet;
var s : str20;
i : word;
a : integer;
begin
MouseMove;
{MouseOff;}
MouseDisabled:=True;
ClearInfo;
SetColor(White);
OutTextXY(MX0,72,'Find which planet:');
s:=GetStr(MX0,88,18);
MouseDisabled:=False;
{MouseOn;}
if s='' then Clear(MX0,72,639,111)
else begin
if s[1] in ['0'..'9'] then Val(s,i,a)
else begin
i:=PSearchNm(s);
end;
if (i<=0) or (i>500) or (TTurn^.data^.xyplan[i,1]=-1) then
begin SetColor(LightGray); OutTextXY(MX0,104,'Planet not found') end
else begin
{CenterMap(Planets[i].x,Planets[i].y,No);}
force:=i or LockP;
ForceKey:=13;
end;
end;
end;
procedure FindShip;
var s : str20;
ls : byte absolute s;
h : sptr;
a : integer;
i : int;
begin
MouseMove;
{MouseOff;}
MouseDisabled:=True;
ClearInfo;
SetColor(White);
OutTextXY(MX0,72,'Find which ship:');
s:=GetStr(MX0,88,18);
MouseDisabled:=False;
{MouseOn;}
h:=nil;
if s='' then Clear(MX0,72,639,111)
else begin
if s[1] in ['0'..'9'] then
begin
Val(s,i,a);
if (i>=1) and (i<=999) then h:=TTurn^.data^.ship[i];
end
else
for i:=1 to 999 do
begin
h:=TTurn^.data^.ship[i];
if (h<>nil) and (h^.when=turn) and StrCmp(h^.name,s,ls) then Break
else h:=nil;
end;
if h=nil then
begin SetColor(LightGray); OutTextXY(MX0,104,'Ship not found') end
else begin
{CenterMap(h^.x,h^.y,No);}
force:=i or LockS;
ForceKey:=13;
end;
end;
end;
procedure DrawUserCircle;
var s : str20;
r,a : integer;
begin
MouseMove;
{MouseOff;}
MouseDisabled:=True;
ClearInfo;
SetColor(White);
OutTextXY(MX0,72,'Radius (LY):');
SetColor(LightGray);
OutTextXY(MX0,88,NStr(radius0));
s:=GetStr(MX0,88,18);
MouseOff;
Clear(MX0,72,639,111);
Val(s,r,a);
if r>=0 then
begin
if r>0 then radius0:=r;
SetViewPort(0,0,479,479,ClipOn);
SetColor(DarkGray);
DrawWCircle(MouseX,MouseY,long(radius0)*ratio2 div ratio1);
SetViewPort(0,0,639,479,ClipOn);
DrawMap(No);
end;
MouseDisabled:=False;
MouseOn;
end;
procedure DrawHYPCircles;
begin
MouseOff;
SetViewPort(0,0,479,479,ClipOn);
SetColor(DarkGray);
if SWPlan and not PHOST then
DrawWCircle(MouseX,MouseY,long(350)*ratio2 div ratio1)
else begin
DrawWCircle(MouseX,MouseY,long(340)*ratio2 div ratio1);
DrawWCircle(MouseX,MouseY,long(360)*ratio2 div ratio1);
end;
SetViewPort(0,0,639,479,ClipOn);
DrawMap(No);
MouseOn;
end;
procedure DrawMineCircle;
var r,y : int;
h : sptr;
id,t,n : int;
ow : byte;
nnn : long;
begin
h:=lship; id:=lock and LockLo;
t:=10; n:=0;
MouseMove;
{MouseOff;}
MouseDisabled:=True;
ClearInfo;
ow:=Race[player];
if (h<>nil) and (h^.launchers>0) and (h^.Tl<>-1) then
begin
ow:=Race[h^.owner];
t:=h^.Tl;
n:=Max(h^.TFnum,0);
SetColor(cSInfo);
OutTextXY(MX0,72,'Ship '+NStr(id)+' has');
OutTextXY(MX0,80,NStr00(n,'no')+' '+Torps[t].name+' torps');
y:=88;
if Pos('|'+h^.fcode+'|','|mdh|mdq|md1|md2|md3|md4|md5|md6|md7|md8|md9|md0|')<>0 then
begin
OutTextXY(MX0,y,'and code " "');
WriteFCode(MX0+10*8,y,cSInfo,h^.fcode);
inc(y);
case h^.fcode[3] of
'h' : n:=n div 2;
'q' : n:=n div 4;
'0' : n:=Min(n,100);
'1'..'9' : n:=Min(n,(byte(h^.fcode[3])-ord('0'))*10);
end;
end;
if ow=9 then OutTextXY(MX0,y,'and has 4X bonus');
end;
SetColor(White);
OutTextXY(MX0,112,'Enter torpedo');
OutTextXY(MX0,120,'type and quantity:');
NewMenu; UnLockReservedMemory(MenuSize(MX0+8,136,MX0+12*8,10,Yes));
for y:=1 to 10 do AddMenuItem(Torps[y].name+' '+NStr(IIF(y=t,n,0)),LightGray,No);
GetStrKey:=0;
ChooseMenu(MX0+8,136,MX0+8,MX0+12*8,10,LightGray,Yellow,t,Yes,Yes);
NewMenu; LockReservedMemory;
ClearInfo;
MouseOff;
n:=IIF(MenuData>0,MenuData,IIF(MenuValue=t,n,0));
if (GetStrKey=13) and (n>0) then
begin
nnn:=long(MenuValue)*long(MenuValue)*n*IIF(ow=9,4,1);
r:=Trunc(Sqrt(nnn));
SetColor(White);
OutTextXY(MX0,72,NStr0(n)+' '+Torps[MenuValue].name+' torps');
OutTextXY(MX0,80,'form a minefield');
OutTextXY(MX0,88,'of '+NStr0(r)+' LY radius');
OutTextXY(MX0,96,'('+NStr0(nnn)+' mine units)');
if ow=9 then OutTextXY(MX0,104,'(using 4X bonus)');
SetViewPort(0,0,479,479,ClipOn);
SetColor(DarkGray);
DrawWCircle(MouseX,MouseY,long(r)*ratio2 div ratio1);
SetViewPort(0,0,639,479,ClipOn);
DrawMap(No);
end;
MouseDisabled:=False;
MouseOn;
end;
procedure TimeShift (dt:int);
var bs : boolean;
begin
if dt<>0 then
begin
if dt>0 then
begin
if TTurn^.next=nil then Exit
else SetTurn(TTurn^.next^.turn);
end;
if dt<0 then
begin
if TTurn^.prev=nil then Exit
else SetTurn(TTurn^.prev^.turn);
end;
end;
WriteTurn(turn);
DrawMap(Yes);
if ltype=LockA then MouseMove;
bs:=(ltype=LockP) and (lbase<>nil);
if lock<>0 then
begin
InitObjList;
force:=lock;
MouseMove;
if bs then lbase:=TTurn^.data^.base[force and LockLo]; {lock=0!}
ForceKey:=13;
end
else WriteFreeMem;
end;
procedure InputHull;
var i : int;
begin
if (turn<>today) or (lship=nil) or
(lship^.hull<>-1) or (lship^.owner=player) then Exit;
i:=EnterHull(MX0-8,88,-1,Yes);
if (i>0) and (HullFit(i,lship^.mass,lship^.mass)) then
begin
lship^.hull:=i;
DataChg:=Yes;
force:=lock;
ForceKey:=13;
end
end;
procedure ForgetShip;
begin
with lship^ do
begin
if (turn<>today) or (lship=nil) or (hull=-1) or (mass=-1) or (owner=player) then Exit;
hull:=-1;
if not HullFit(hull,mass1,mass2) then
begin
FillChar(name,20,$FF);
mass1:=mass; mass2:=mass;
FillChar(px1,4*2,$FF);
end;
end;
DataChg:=Yes;
force:=lock;
ForceKey:=13;
end;
procedure SetWarp;
var s : string[4];
ls : byte absolute s;
i : int;
number : word;
begin
if (turn<>today) or (lship=nil) or
(lship^.owner<>player) or (lship^.when<>turn) then Exit;
number:=lock and LockLo;
{MouseOff;}
MouseDisabled:=True;
{Clear(MX0+6*8,136,MX0+7*8+7,143);}
s:=GetStr(MX0+6*8,136,1);
if (ls=1) and (s[1] in ['0'..'9']) and (byte(s[1])<>lship^.warp+ord('0')) then
begin
DrawPath;
i:=byte(s[1])-ord('0');
lship^.warp:=i;
{if i=0 then begin lship^.wx:=0; lship^.wy:=0 end;}
ChangeData(Sh,number);
SayFuel;
DrawPath;
end;
SayMoving;
MouseDisabled:=False;
{MouseOn;}
end;
procedure SetFCode (p_s:xtype; rnd:boolean);
var s,s0 : string[3];
ls : byte absolute s;
rs : fcstr;
l0,k : int;
p : pptr;
h : sptr absolute p;
all : boolean;
begin
if (turn<>today) or
((p_s=Sh) and ((lship=nil) or (lship^.when<>today) or (lship^.owner<>player))) or
((p_s=Pl) and ((lplan=nil) or (lplan^.when<>today) or (lplan^.owner<>player))) then Exit;
all:=(KbdFlags and KbdCtrl<>0);
if p_s=Sh then s0:=lship^.fcode else s0:=lplan^.fcode;
l0:=IIF(p_s=Sh,168,112);
if not rnd then
begin
{MouseOff;}
MouseDisabled:=True;
{Clear(MX0+7*8,l0,639,l0+7);}
s:=GetStr(MX0+7*8,l0,3);
MouseDisabled:=False;
{MouseOn;}
end
else begin RandomFCode(rs); s:=rs end;
if (ls<>0) and (s<>s0) then
begin
while ls<3 do s:=s+' ';
for k:=1 to 999 do
if (p_s=Sh) or (k<=500) then
begin
if p_s=Pl then p:=TTurn^.data^.planet[k]
else h:=TTurn^.data^.ship[k];
if (p<>nil) and
( ((p_s=Pl) and (p^.when=today) and
(all or (p=lplan)) and (p^.owner=player) and (p^.fcode=s0))
or ((p_s=Sh) and (h^.when=today) and
(all or (h=lship)) and (h^.owner=player) and (h^.fcode=s0)) ) then
begin
if p_s=Pl then Move(s[1],p^.fcode,3)
else begin
DrawPath;
Move(s[1],h^.fcode,3);
DrawPath;
end;
ChangeData(p_s,k);
{ if (p_s=Sh) and (h=lship) and HyperDrive and (IsHullFunc(h^.hull,hfHyperDrive)<>0) and
(s='HYP') and (h^.warp<>1) then
begin
h^.warp:=1;
if h=lship then SayMoving;
end;}
end;
end;
end
else s:=s0;
Move(s[1],rs,3);
Clear(MX0+7*8,l0,639,l0+7);
WriteFCode(MX0+7*8,l0,IIF(p_s=Sh,cSInfo,cPInfo),rs);
end;
procedure RandAllPCodes;
var p,p0 : pptr;
i : int;
begin
if (turn<>today) or (lplan=nil) or (lplan^.when<>today) or (lplan^.owner<>player) then Exit;
p0:=lplan;
for i:=1 to 500 do
begin
p:=TTurn^.data^.planet[i];
if (p<>nil) and (p^.when=today) and (p^.owner=player) and
(p^.fcode<>'ATT') and (p^.fcode<>'NUK') and (Copy(p^.fcode,1,2)<>'mf') then
begin
lplan:=p;
SetFCode(Pl,Yes)
end;
end;
lplan:=p0;
PlanetInfo;
end;
procedure SetName;
var s,s0 : string[20];
ls : byte absolute s;
begin
if (turn<>today) or (lship=nil) or
(lship^.owner<>player) or (lship^.when<>today) then Exit;
MouseDisabled:=True;
s0:=lship^.name;
s:=GetStr(MX0,96,20);
if (ls<>0) and (s<>s0) then
begin
while ls<20 do s:=s+' ';
Move(s[1],lship^.name,20);
ChangeData(Sh,lock and LockLo);
end;
Clear(MX0,96,639,103);
SetColor(LightGray);
OutTextXY(MX0,96,lship^.name);
ObjList;
MouseDisabled:=False;
end;
function ChooseMission (var misn:int; var md1,md2:boolean; hull,race:int; no_tow1,no_plan1:boolean;
x,y,x2:int) : boolean;
{ enough memory must be freed already }
{ for ext.missions: I abd T values are stored in MenuData and MenuData2 }
var mis,mn : int;
s : str20;
ls : byte absolute s;
mp : MITptr;
i : int;
begin
ChooseMission:=No;
mis:=IIF(misn<=15,misn,0);
NewMenu;
for i:=1 to 15 do
begin
ls:=0;
if (not DullMissions) and
( ( (not IsMines) and ((i=2) or (i=3)) ) or
( ((i=3) or ((i=9) and (race=7))) and (Hulls[hull].launchers=0) ) or
( (i=7) and (no_tow1 or
((not OneEngineTow) and (Hulls[hull].engines<2))) ) or
( (i=9) and (((race=1) and ((not SuperRefit) or no_plan1)) or
((race=2) and no_plan1) or
((race=9) and not RobFBuild) or
((race=10) and not RGA) or
((race=11) and not ColFBuild)) ) or
( (i=9) and ((race=9) or (race=11)) and (Hulls[hull].bays=0) ) or
( (i=9) and (race in [2,4,5]) and (Hulls[hull].weapons=0) ) or
( (i in [11..15]) and no_plan1 )
) then begin end else
if (i=10) and ((IsHullFunc(hull,hfCloak)=0) and
(IsHullFunc(hull,hfAdvCloak)=0)) then begin end else
if i=9 then s:=SpecMisn[race]
else s:=Missions[i];
AddMenuItem(s,cSInfo,No);
end;
mn:=15;
mp:=MIT;
while mp<>nil do
begin
if mp^.param and (1 shl race)<>0 then
begin
if mn=15 then
begin
AddMenuItem('Ext. Misn.',cSInfo,No);
inc(mn);
end;
if misn=mp^.mission then mis:=16;
end;
mp:=mp^.next;
end;
ChooseMenu(x,y,x2,x+17*8-1,mn,cSInfo,Yellow,mis,No,No);
NewMenu;
repeat
if MenuKey=27 then Break;
mis:=MenuValue;
md1:=No; md2:=No;
if mis=16 then
begin
Clear(x,y,x+17*8-1,y+16*8-1);
mn:=0; mis:=1;
mp:=MIT;
while mp<>nil do
begin
if mp^.param and (1 shl race)<>0 then
begin
AddMenuItem(mp^.name,cSInfo,No);
inc(mn);
if misn=mp^.mission then mis:=mn;
end;
mp:=mp^.next;
end;
ChooseMenu(x,y,x,x+17*8-1,16,cSInfo,Yellow,mis,No,No);
NewMenu;
if MenuKey=27 then Break;
mis:=MenuValue;
mn:=0;
mp:=MIT;
while mp<>nil do
begin
if mp^.param and (1 shl race)<>0 then
begin
inc(mn);
if mn=mis then Break;
end;
mp:=mp^.next;
end;
if mp=nil then Break;
mis:=mp^.mission;
md1:=mp^.param and MIT_I<>0;
md2:=mp^.param and MIT_T<>0;
if md1 or md2 then
begin
Clear(x,y,x+17*8-1,y+16*8-1);
SetColor(Yellow);
OutTextXY(x,y,mp^.name);
SetColor(cSInfo);
if md1 then
begin
SetColor(cSInfo);
OutTextXY(x,y+16,mp^.iname+' =');
s:=GetStr(x+(byte(mp^.iname[0])+3)*8,y+16,5);
if ls=0 then Break
else begin Val(s,MenuData,mn); if mn<>0 then Break end;
end;
if md2 then
begin
SetColor(cSInfo);
OutTextXY(x,y+24,mp^.tname+' =');
s:=GetStr(x+(byte(mp^.tname[0])+3)*8,y+24,5);
if ls=0 then Break
else begin Val(s,MenuData2,mn); if mn<>0 then Break end;
end;
end;
end;
misn:=mis;
ChooseMission:=Yes;
until True;
end;
procedure SetMission;
var number : word;
mis : int;
md1,md2 : boolean;
xx0,yy0 : int;
mx,my : int;
dd,nd : long;
xx,yy : int;
gmt : boolean;
h : sptr;
i : word; { word! }
begin
if (turn<>today) or (lship=nil) or
(lship^.owner<>player) or (lship^.when<>today) then Exit;
number:=lock and LockLo;
MouseDisabled:=True;
UnLockReservedMemory(MenuSize(MX0,192,MX0+17*8-1,16,No));
mis:=lship^.mission;
md1:=No; md2:=No;
gmt:=ChooseMission(mis,md1,md2,lship^.hull,Race[lship^.owner],(ShipN<2),(PlanN=0),MX0,192,MX0+6*8-8);
LockReservedMemory;
if gmt then
repeat
if mis=7 then
begin
Clear(MX0,ListY,639,ListY+7);
SetColor(Yellow);
OutTextXY(MX0,ListY,'Tow ship:');
MenuData2:=SelectShip(lx,ly,No,No);
if MenuData2=0 then Break;
md2:=Yes;
end;
if mis=8 then
begin
if not (showS or showE) then Break;
Clear(MX0,ListY,639,479);
SetColor(Yellow);
OutTextXY(MX0,ListY+2*8,'Select target ship');
xx0:=MouseX; yy0:=MouseY;
gmt:=MouseGetTarget(0,0,No);
if gmt then
begin
nd:=1000000000;
for i:=1 to 999 do
begin
h:=TTurn^.data^.ship[i];
if (h<>nil) and (h^.when=turn) and
((showS and (h^.owner=player)) or (showE and (h^.owner<>player))) then
begin
dd:=Distance2(mmx,mmy,h^.x,h^.y);
if dd<nd then begin nd:=dd; xx:=h^.x; yy:=h^.y end;
end;
end;
if nd<>1000000000 then
begin
Abs2Scr(xx,yy,mx,my);
MoveMouseTo(mx,my); WriteCoord;
SetColor(Yellow);
OutTextXY(MX0,ListY,'Intercept ship:');
MenuData:=SelectShip(xx,yy,No,No);
if MenuData=0 then Break;
md1:=Yes;
end;
end;
MoveMouseTo(xx0,yy0);
if not gmt then Break;
end;
with lship^ do
begin
if (mis<>mission) or
(md1 and (intr_ship<>MenuData)) or
(md2 and (tow_ship<>MenuData2)) then
begin
mission:=mis;
intr_ship:=IIF(md1,MenuData,0);
tow_ship:=IIF(md2,MenuData2,0);
ChangeData(Sh,number);
if mis=8 then
begin
DrawPath;
wx:=xx-x;
wy:=yy-y;
if showT then DrawMap(Yes) else DrawPath;
end;
end;
end;
until True;
Clear(MX0-8,192-8,MX0-1,192+20*8+7);
ShipInfo;
MouseDisabled:=False;
end;
function ChooseEnemy (var en:int; x,y,x2:int) : boolean;
{ enough memory must be freed already }
var i : byte;
begin
NewMenu;
AddMenuItem('None',cSInfo,No);
for i:=1 to 11 do AddMenuItem(RaceName[i],cSInfo,No);
ChooseMenu(x,y,x2,x+17*8-1,12,cSInfo,Yellow,en+1,No,Yes);
NewMenu;
ChooseEnemy:=(MenuKey<>27);
en:=MenuValue-1;
end;
procedure SetEnemy;
var en,yy : int;
begin
if (turn<>today) or (lship=nil) or
(lship^.owner<>player) or (lship^.when<>today) then Exit;
MouseDisabled:=True;
en:=lship^.enemy;
yy:=200+IIF(lship^.mission>15,8,0);
UnLockReservedMemory(MenuSize(MX0,yy,631,12,Yes));
if ChooseEnemy(en,MX0,yy,MX0+7*8-8) and (en<>lship^.enemy) then
with lship^ do
begin
enemy:=en;
ChangeData(Sh,lock and LockLo);
Clear(MX0+56,yy,639,207);
SetColor(cSInfo);
OutTextXY(MX0+56,yy,RaceName[enemy]);
end;
LockReservedMemory;
MouseDisabled:=False;
end;
function UnloadShip (id:int) : boolean;
var h : sptr;
p : pptr;
pn : int;
begin
UnloadShip:=No;
h:=TTurn^.data^.ship[id];
with h^ do
begin
if (turn<>today) or (h=nil) or (owner<>player) or (when<>today) or
(T+D+M+Sup+IIF(Gambling and (IsHullFunc(hull,hfGambling)<>0),0,colonists)+credits=0) then Exit;
pn:=splan[id];
p:=TTurn^.data^.planet[pn];
if (pn=0) or (p=nil) or (p^.when<>today) or (p^.owner<>player) then Exit;
inc(p^.T,T); T:=0;
inc(p^.D,D); D:=0;
inc(p^.M,M); M:=0;
inc(p^.supplies,Sup); Sup:=0;
if (not Gambling) or (hull<>42) then
begin inc(p^.colonists,colonists); colonists:=0 end;
inc(p^.funds,credits); credits:=0;
SetShipMass(h^);
ChangeData(Sh,id);
ChangeData(Pl,pn);
UnloadShip:=Yes;
if (ltype=LockS) and (h=lship) then ShipInfo;
end;
end;
procedure UnloadAllShips;
var i,x,y : int;
was : boolean;
begin
if (turn<>today) or (lplan=nil) or (lplan^.when<>today) or (lplan^.owner<>player) then Exit;
with TTurn^.data^ do
begin
x:=xyplan[PlanN,1];
y:=xyplan[PlanN,2];
end;
was:=No;
for i:=1 to 999 do
if ShipIsHere(i,x,y) then was:=UnloadShip(i) or was; { U or was! not the reverse!! }
if was then PlanetInfo;
end;
procedure LoadForBuild; { M.O.T.}
var i,cost : int;
p : pptr;
procedure HowMany (fgt:boolean);
var s : string[10];
ch : word;
n : int;
begin
Clear(MX0,CY0+80,639,CY0+88+7);
SetColor(cSInfo);
OutTextXY(MX0,CY0+80,'Build how many');
if fgt then s:='fighters?' else s:='torpedoes?';
OutTextXY(MX0,CY0+88,s);
SetLineStyle(SolidLn,0,NormWidth);
n:=0;
repeat
Clear(640-4*8,CY0+88,639,CY0+88+7);
SetColor(cSInfo);
OutTextXY(640-4*8,CY0+88,NStr0(n));
SetColor(Yellow);
Line(640-4*8,CY0+88+7,640-4*8+23,CY0+88+7);
repeat ArrowBlink(640-4*8-3*8,CY0+88) until KeyPressed;
SetColor(Black);
Line(640-4*8,CY0+88+7,640-4*8+23,CY0+88+7);
ch:=ReadKey;
case ch of
$4B00 : n:=IIF(KbdFlags and KbdShft=0,Max(n-1,0),0);
$4D00 : n:=IIF(KbdFlags and KbdShft=0,Min(n+1,i),i);
$7300 : n:=Max(n-10,0);
$7400 : n:=Min(n+10,i);
$9B00 : n:=Max(n-100,0);
$9D00 : n:=Min(n+100,i);
ord('0')..ord('9') : begin
GetStr1stKey:=ch;
s:=GetStr(640-4*8,CY0+88,3);
if GetStrKey=13 then n:=Min(Max(Value(s),0),i);
end;
$3B00 : begin
helpscr:=5;
Help;
helpscr:=0;
DrawMap(Yes);
end;
end;
until (ch=13) or (ch=27);
i:=n;
end;
begin
with lship^ do
begin
if (turn<>today) or (lship=nil) or (owner<>player) or (when<>today) or (PlanN=0) then Exit;
if ((Race[owner]=9) and not RobFBuild) or ((Race[owner]=11) and not ColFBuild) then Exit;
p:=TTurn^.data^.planet[PlanN];
if (p=nil) or (p^.when<>today) or (p^.owner<>player) then Exit;
i:=Hulls[hull].cargo-T-D-M-Sup-colonists-TFnum;
if (bays>0) and (Race[player] in [9..11]) then
begin
if (i<10) or (p^.T<3) or (p^.M<2) or (p^.supplies<5) then Exit;
i:=MinL(MinL(Min(p^.T div 3,p^.M div 2),p^.supplies div 5),i div 10);
HowMany(Yes);
if i=0 then begin ShipInfo; Exit end;
inc(T,i*3); dec(p^.T,i*3);
inc(M,i*2); dec(p^.M,i*2);
inc(Sup,i*5); dec(p^.supplies,i*5);
if (Race[player]<>10) and (fcode<>'lfm') then mission:=9;
end else
if launchers>0 then
begin
cost:=Torps[Tl].cost;
if (i<3) or (p^.T=0) or (p^.D=0) or (p^.M=0) or
(10000-credits<cost) or (p^.funds+p^.supplies<cost) then Exit;
i:=MinL(MinL(MinL(MinL(MinL(p^.T,p^.D),p^.M),(p^.funds+p^.supplies) div cost),i div 3),(10000-credits) div cost);
HowMany(No);
if i=0 then begin ShipInfo; Exit end;
inc(T,i); dec(p^.T,i);
inc(D,i); dec(p^.D,i);
inc(M,i); dec(p^.M,i);
inc(credits,i*cost); dec(p^.funds,i*cost);
if p^.funds<0 then begin inc(p^.supplies,p^.funds); p^.funds:=0 end;
fcode:='mkt';
end
else Exit;
end;
SetShipMass(lship^);
ChangeData(Sh,lock and LockLo);
ChangeData(Pl,PlanN);
ShipInfo;
end;
procedure ChgSupplies (amt:long);
begin
with lplan^ do
begin
inc(supplies,amt);
ChangeData(Pl,lock and LockLo);
Clear(MX0+10*8,256,639,263);
SetColor(cPInfo);
OutTextXY(MX0+10*8,256,NStr0(supplies));
end
end;
procedure ChgFunds (amt:long);
begin
with lplan^ do
begin
inc(funds,amt);
ChangeData(Pl,lock and LockLo);
Clear(MX0+10*8,264,639,271);
SetColor(cPInfo);
OutTextXY(MX0+10*8,264,NStr0(funds));
end
end;
procedure SellSupplies (amt:long);
begin
ChgSupplies(-amt);
ChgFunds(amt);
end;
function SoldSupp (id:int) : long;
var i : int;
dsupp : long;
begin
i:=PDSearch(id); { MUST be i<>0 }
with PDis^[i] do dsupp:=supplies+mines+factories+defense;
with TTurn^.data^.planet[id]^ do dec(dsupp,supplies+mines+factories+defense);
for i:=1 to 999 do
if splan[i]=id then
with TTurn^.data^.ship[i]^ do
if owner=player then dec(dsupp,Sup+CS+TS);
SoldSupp:=dsupp;
end;
procedure BuildStructures (mfd:MFDtype); { M.O.T.}
type MFDarr = array [MFDtype] of int;
var mfdpp : pointer;
mfdp : ^MFDarr absolute mfdpp;
mfd0,mfd1 : MFDarr;
ch : word;
x,y,k : int;
s : string[3];
mf : MFDtype;
suppsold,l : long;
procedure PutNum;
begin
Clear(x,y,x+3*8-1,y+7);
SetColor(cpInfo);
Str(mfdp^[mfd]:3,s);
OutTextXY(x,y,s);
end;
procedure BuildStruct (amt:long);
begin
amt:=Min(Max(amt+mfdp^[mfd],mfd0[mfd]),mfd1[mfd])-mfdp^[mfd];
if amt=0 then Exit;
with lplan^ do
begin
amt:=MinL(MinL(amt,supplies),(funds+supplies) div (mfdCost[mfd]+1));
if amt=0 then Exit;
ChgSupplies(-amt); ChgFunds(-amt*mfdCost[mfd]);
if amt>0 then
begin
if funds<0 then
begin
dec(suppsold,funds); { funds<0 here }
SellSupplies(-funds);
end;
end
else if suppsold>0 then
begin
l:=MinL(suppsold,funds);
dec(suppsold,l);
SellSupplies(-l);
end;
inc(mfdp^[mfd],amt);
ChangeData(Pl,lock and LockLo);
if mfd=_Mine then WriteMiningRate;
if mfd<>_Defense then
begin
if Nrace<>0 then WriteHChange(Yes);
WriteHChange(No);
end;
end;
end;
begin
if (turn<>today) or (lplan=nil) or (lplan^.when<>today) or (lplan^.owner<>player) then Exit;
with lplan^ do
begin
mfdpp:=Addr(mines);
k:=PDSearch(lock and LockLo); { MUST be k<>0 }
Move(PDis^[k].mines,mfd0,SizeOf(MFDarr));
for mf:=_Mine to _Defense do
begin
if colonists<=mfdFNum[mf] then mfd1[mf]:=colonists
else mfd1[mf]:=Round(Sqrt(colonists-mfdFNum[mf]))+mfdFNum[mf];
mfd1[mf]:=Max(mfd0[mf],mfd1[mf]); { mfd1 must be >= mfd0 }
end;
end;
suppsold:=SoldSupp(lock and LockLo);
{MouseOff;}
MouseDisabled:=True;
SetLineStyle(SolidLn,0,NormWidth);
x:=MX0+11*8;
y:=224+byte(mfd)*8;
Clear(x-2*8,224,x-1,224+3*8-1);
repeat
PutNum;
SetColor(Yellow);
Line(x,y+7,x+23,y+7);
repeat ArrowBlink(x-2*8,y) until KeyPressed;
SetColor(Black);
Line(x,y+7,x+23,y+7);
ch:=ReadKey;
case ch of
$4800 : begin
Clear(x-2*8,y,x-1,y+7);
if mfd=_Mine then mfd:=_Defense else dec(mfd);
y:=224+byte(mfd)*8;
end;
$5000 : begin
Clear(x-2*8,y,x-1,y+7);
if mfd=_Defense then mfd:=_Mine else inc(mfd);
y:=224+byte(mfd)*8;
end;
$4B00 : if KbdFlags and KbdShft=0 then BuildStruct(-1)
else BuildStruct(mfd0[mfd]-mfdp^[mfd]);
$4D00 : if KbdFlags and KbdShft=0 then BuildStruct(1)
else BuildStruct(mfd1[mfd]-mfdp^[mfd]);
$7300 : BuildStruct(-10);
$7400 : BuildStruct(10);
$9B00 : BuildStruct(-100);
$9D00 : BuildStruct(100);
ord('0')..ord('9') : begin
GetStr1stKey:=ch;
s:=GetStr(x,y,3);
if GetStrKey=13 then
begin
k:=Min(Max(Value(s),mfd0[mfd]),mfd1[mfd]);
BuildStruct(k-mfdp^[mfd]);
end;
end;
$3B00 : begin
helpscr:=5;
Help;
helpscr:=0;
DrawMap(Yes);
end;
end;
until (ch=13) or (ch=27);
PlanetInfo;
MouseDisabled:=False;
{MouseOn;}
end;
procedure SellSupp; { M.O.T.}
var x,y : int;
k,sp0,ds: long;
s : string[6];
ch : word;
spp : pointer;
sp : ^long absolute spp;
begin
if (turn<>today) or (lplan=nil) or (lplan^.when<>today) or (lplan^.owner<>player) then Exit;
spp:=Addr(lplan^.supplies);
sp0:=sp^+MinL(SoldSupp(lock and LockLo),lplan^.funds);
{MouseOff;}
MouseDisabled:=True;
SetLineStyle(SolidLn,0,NormWidth);
x:=MX0+10*8;
y:=256;
repeat
ds:=sp0-sp^;
Clear(x,y,x+6*8-1,y+7);
SetColor(cpInfo);
OutTextXY(x,y,NStr0(lplan^.supplies));
SetColor(Yellow);
Line(x,y+7,x+47,y+7);
repeat ArrowBlink(640-2*8,y) until KeyPressed;
SetColor(Black);
Line(x,y+7,x+47,y+7);
ch:=ReadKey;
case ch of
$4B00 : if KbdFlags and KbdShft=0 then SellSupplies(-MinL(1,ds))
else SellSupplies(-ds);
$4D00 : if KbdFlags and KbdShft=0 then SellSupplies(MinL(1,sp^))
else SellSupplies(sp^);
$7300 : SellSupplies(-MinL(10,ds));
$7400 : SellSupplies(MinL(10,sp^));
$9B00 : SellSupplies(-MinL(100,ds));
$9D00 : SellSupplies(MinL(100,sp^));
ord('0')..ord('9') : begin
GetStr1stKey:=ch;
s:=GetStr(x,y,6);
if GetStrKey=13 then
begin
k:=MinL(MaxL(Value(s),0),sp0);
SellSupplies(sp^-k);
end;
end;
$3B00 : begin
helpscr:=5;
Help;
helpscr:=0;
DrawMap(Yes);
end;
end;
until (ch=13) or (ch=27);
PlanetInfo;
MouseDisabled:=False;
{MouseOn;}
end;
procedure BuildBase;
begin
if (turn<>today) or (lplan=nil) then Exit;
with lplan^ do
begin
if (when<>today) or (owner<>player) or
(TTurn^.data^.eplan[lock and LockLo].activity and 128<>0) or (build=1) or
(T<402) or (D<120) or (M<340) or (funds+supplies<900) then Exit;
dec(T,402);
dec(D,120);
dec(M,340);
dec(funds,900);
if funds<0 then SellSupplies(-funds);
build:=1;
ChangeData(Pl,lock and LockLo);
with TTurn^.data^.eplan[lock and LockLo] do activity:=activity or 128;
DrawMap(No);
end;
PlanetInfo;
end;
procedure CancelBase;
var s : string[1];
begin
if (turn<>today) or (lplan=nil) then Exit;
with lplan^ do
begin
if (when<>today) or (owner<>player) or (build=0) then Exit;
inc(T,402);
inc(D,120);
inc(M,340);
inc(funds,900);
build:=0;
ChangeData(Pl,lock and LockLo);
with TTurn^.data^.eplan[lock and LockLo] do activity:=activity and 127;
DrawMap(No);
end;
PlanetInfo;
end;
procedure IncreaseBaseDefense; { M.O.T.}
var ch : word;
bd0 : int;
bdp : pointer;
bd : ^int absolute bdp;
x,y,k : int;
suppsold,l : long;
s : string[3];
b : BRec;
procedure WriteRes;
begin
Clear(x,y,639,112+7);
SetColor(cBInfo);
OutTextXY(x,y,NStr(lbase^.defense));
OutTextXY(x,104,NStr(lplan^.D));
OutTextXY(x,112,NStr(lplan^.funds+lplan^.supplies));
end;
procedure BuildBDef (amt:long);
begin
amt:=Min(Max(amt+bd^,bd0),200)-bd^;
if amt=0 then Exit;
with lplan^ do
begin
amt:=MinL(MinL(amt,D),(funds+supplies) div 10);
if amt=0 then Exit;
dec(D,amt);
dec(funds,amt*10);
if amt>0 then
begin
if funds<0 then
begin
dec(suppsold,funds); { funds<0 here }
inc(supplies,funds);
funds:=0;
end;
end
else if suppsold>0 then
begin
l:=MinL(suppsold,funds);
dec(suppsold,l);
inc(supplies,l);
dec(funds,l);
end;
inc(lbase^.defense,amt);
ChangeData(Pl,PlanN);
ChangeData(Ba,PlanN);
end;
end;
begin
if (turn<>today) or (lbase=nil) or (lbase^.owner<>player) or
(lplan=nil) or (lplan^.owner<>player) then Exit;
bdp:=Addr(lbase^.defense);
{bd0:=bd^;}
LoadBDis(lock and LockLo,b);
bd0:=b.defense;
suppsold:=SoldSupp(lock and LockLo);
{MouseOff;}
MouseDisabled:=True;
SetLineStyle(SolidLn,0,NormWidth);
x:=MX0+11*8; y:=96;
Clear(x-2*8,y,639,y+7);
Clear(MX0,104,639,112+7);
SetColor(cBInfo);
OutTextXY(MX0,104,'Du:');
OutTextXY(MX0,112,'mc+sup:');
repeat
WriteRes;
SetColor(Yellow);
Line(x,y+7,x+23,y+7);
repeat ArrowBlink(x-2*8,y) until KeyPressed;
SetColor(Black);
Line(x,y+7,x+23,y+7);
ch:=ReadKey;
case ch of
$4B00 : if KbdFlags and KbdShft=0 then BuildBDef(-1)
else BuildBDef(bd0-bd^);
$4D00 : if KbdFlags and KbdShft=0 then BuildBDef(1)
else BuildBDef(200-bd^);
$7300 : BuildBDef(-10);
$7400 : BuildBDef(10);
$9B00 : BuildBDef(-100);
$9D00 : BuildBDef(100);
ord('0')..ord('9') : begin
GetStr1stKey:=ch;
s:=GetStr(x,y,3);
if GetStrKey=13 then
begin
k:=Min(Max(Value(s),bd0),200);
BuildBDef(k-bd^);
end;
end;
$3B00 : begin
helpscr:=5;
Help;
helpscr:=0;
DrawMap(Yes);
end;
end;
until (ch=13) or (ch=27);
BaseInfo;
MouseDisabled:=False;
{MouseOn;}
end;
procedure SetBaseOrder;
var i : byte;
begin
if (turn<>today) or (lbase=nil) or (lbase^.owner<>player) then Exit;
{MouseOff;}
MouseDisabled:=True;
NewMenu; UnLockReservedMemory(MenuSize(MX0,136,631,6,Yes));
for i:=1 to 6 do AddMenuItem(BaseOrd[i],cBInfo,No);
ChooseMenu(MX0,136,MX0,631,6,cBInfo,Yellow,lbase^.order,No,Yes);
NewMenu; LockReservedMemory;
with lbase^ do
if (MenuKey<>27) and (MenuValue<>order) then
begin
order:=MenuValue;
ChangeData(Ba,lock and LockLo);
Clear(MX0+8,128,639,128+7);
SetColor(cBInfo);
OutTextXY(MX0+8,128,BaseOrd[order]);
end;
MouseDisabled:=False;
{MouseOn;}
end;
function TFBuilt (id:int; tlv:byte) : int;
var k : int;
dtf : int;
begin
k:=BDSearch(id); { MUST be k<>0 }
with TTurn^.data^.base[id]^ do
begin
dtf:=IIF(tlv=0,fighters,TT[tlv])-BDis^[k].TF[tlv];
end;
for k:=1 to 999 do
if splan[k]=id then
with TTurn^.data^.ship[k]^ do
if (owner=player) and (Tl=tlv) then inc(dtf,TFnum);
TFBuilt:=dtf;
end;
procedure BuyTF (y0:int; c:byte; tlv:byte; limit:int; var TFn:int; xt:xtype; xn:word);
{ tlv = 1..10 for torps, 0 for fighters } { M.O.T.}
{ use limit=30000 for torps on base }
var p : pptr; { MOT interface }
ch : word;
l,x,k : int;
costT,costD,costM,costC : int;
tf0 : int;
suppsold,sl : long;
s : string[4];
procedure WriteBTFs;
begin
Clear(MX0+10*8,y0+8,639,l+8+7);
Clear(x,l+24,639,l+32+7);
SetColor(c);
OutTextXY(MX0+10*8,y0+8,NStr(p^.T));
if tlv>0 then OutTextXY(MX0+10*8,y0+16,NStr(p^.D));
OutTextXY(MX0+10*8,l,NStr(p^.M));
OutTextXY(MX0+10*8,l+8,NStr(p^.funds+p^.supplies));
if limit<30000 then OutTextXY(x,l+24,NStr(limit-TFn));
OutTextXY(x,l+32,NStr(TFn));
end;
procedure BuyIt (amt:long);
begin
amt:=MinL(MaxL(amt+TFn,tf0),limit)-TFn;
if amt=0 then Exit;
with p^ do
begin
if costT>0 then amt:=MinL(amt,T div costT);
if costD>0 then amt:=MinL(amt,D div costD);
if costM>0 then amt:=MinL(amt,M div costM);
if costC>0 then amt:=MinL(amt,(funds+supplies) div costC);
if amt=0 then Exit;
dec(T,amt*costT);
dec(D,amt*costD);
dec(M,amt*costM);
dec(funds,amt*costC);
if amt>0 then
begin
if funds<0 then
begin
dec(suppsold,funds); { funds<0 here }
inc(supplies,funds);
funds:=0;
end;
end
else if suppsold>0 then
begin
sl:=MinL(suppsold,funds);
dec(suppsold,sl);
inc(supplies,sl);
dec(funds,sl);
end;
inc(TFn,amt);
ChangeData(Pl,PlanN);
ChangeData(xt,xn);
end;
end;
begin
if (turn<>today) or (PlanN=0) or (TTurn^.data^.base[PlanN]=nil) then Exit;
p:=TTurn^.data^.planet[PlanN];
if (p=nil) or (p^.owner<>player) then Exit;
Clear(MX0,y0,639,y0+88+7);
SetColor(c);
OutTextXY(MX0,y0,'Base resources:');
OutTextXY(MX0,y0+8,' Tr:');
if tlv>0 then
begin
costT:=1; costD:=1; costM:=1; costC:=Torps[tlv].cost;
OutTextXY(MX0,y0+16,' Du:');
l:=y0+24;
OutTextXY(MX0,y0+24+32,'Torpedoes:');
OutTextXY(MX0,y0+24+48,'1 '+Torps[tlv].name+' torpedo =');
OutTextXY(MX0,y0+24+56,' 1Tr+1Du+1Mo+'+NStr0(costC)+'mc');
end
else begin
costT:=3; costD:=0; costM:=2; costC:=100;
l:=y0+16;
OutTextXY(MX0,y0+16+32,'Fighters:');
OutTextXY(MX0,y0+16+48,'1 fighter =');
OutTextXY(MX0,y0+16+56,' 3Tr+2Mo+100mc');
end;
OutTextXY(MX0,l,' Mo:');
OutTextXY(MX0,l+8,' mc+sup: ');
if limit<30000 then OutTextXY(MX0,l+24,'Cargo room:');
{tf0:=TFn;}
tf0:=Max(TFn-TFBuilt(PlanN,tlv),0);
suppsold:=SoldSupp(PlanN);
SetLineStyle(SolidLn,0,NormWidth);
x:=MX0+14*8;
repeat
WriteBTFs;
SetColor(Yellow);
Line(x,l+32+7,x+23,l+32+7);
repeat ArrowBlink(x-2*8,l+32) until KeyPressed;
SetColor(Black);
Line(x,l+32+7,x+23,l+32+7);
ch:=ReadKey;
case ch of
$4B00 : if KbdFlags and KbdShft=0 then BuyIt(-1)
else BuyIt(tf0-TFn);
$4D00 : if KbdFlags and KbdShft=0 then BuyIt(1)
else BuyIt(limit-TFn);
$7300 : BuyIt(-10);
$7400 : BuyIt(10);
$9B00 : BuyIt(-100);
$9D00 : BuyIt(100);
ord('0')..ord('9') : begin
GetStr1stKey:=ch;
s:=GetStr(x,l+32,4);
if GetStrKey=13 then
begin
k:=Min(Max(Value(s),tf0),limit);
BuyIt(k-TFn);
end;
end;
$3B00 : begin
helpscr:=5;
Help;
helpscr:=0;
DrawMap(Yes);
end;
end;
until (ch=13) or (ch=27);
end;
procedure BuyShipTF;
var b : bptr;
p : pptr;
free : int;
begin
if (turn<>today) or (lship=nil) or (PlanN=0) then Exit;
with lship^ do
begin
if (owner<>player) or (when<>today) or (bays or launchers=0) then Exit;
p:=TTurn^.data^.planet[PlanN];
b:=TTurn^.data^.base[PlanN];
if (p=nil) or (p^.owner<>player) or (b=nil) then Exit;
if (launchers>0) and (b^.Tl<Torps[Tl].tech) then
begin
Clear(MX0+9*8,CY0+64,639,CY0+64+7);
SetColor(LightRed);
OutTextXY(MX0+9*8,CY0+64,'Low tech!');
Exit;
end;
free:=Hulls[hull].cargo-colonists-Sup-T-D-M;
if free<=0 then
begin
Clear(MX0+9*8,CY0+64,639,CY0+64+7);
SetColor(LightRed);
OutTextXY(MX0+9*8,CY0+64,'No room!');
Exit;
end;
{MouseOff;}
MouseDisabled:=True;
BuyTF(CY0,cSInfo,IIF(bays=0,Tl,0),free,TFnum,Sh,lock and LockLo);
SetShipMass(lship^);
MouseDisabled:=False;
{MouseOn;}
ShipInfo;
end;
end;
procedure BuyBaseTF;
var i : byte;
begin
if (turn<>today) or (lbase=nil) or (lbase^.owner<>player) then Exit;
{MouseOff;}
MouseDisabled:=True;
Clear(MX0,192,639,BL2+15);
SetColor(cBInfo);
OutTextXY(MX0,192,'Buy items:');
NewMenu; UnLockReservedMemory(MenuSize(MX0+8,208,631,11,Yes));
AddMenuItem('Fighters',cBInfo,No);
i:=1;
while (i<=10) and (Torps[i].tech<=lbase^.Tl) do
begin AddMenuItem(Torps[i].name+' torpedoes',cBInfo,No); inc(i) end;
ChooseMenu(MX0+8,208,MX0+8,631,11,cBInfo,Yellow,1,No,Yes);
NewMenu; LockReservedMemory;
if (MenuKey<>27) and (MenuValue<>0) then
begin
dec(MenuValue);
if MenuValue=0 then BuyTF(192,cBInfo,0,60,lbase^.fighters,Ba,PlanN)
else BuyTF(192,cBInfo,MenuValue,30000,lbase^.TT[MenuValue],Ba,PlanN);
end;
MouseDisabled:=False;
{MouseOn;}
BaseInfo;
end;
function Min20 (l:long) : int;
begin
if l<20000 then Min20:=l else Min20:=20000
end;
type SArray = array [1..3,1..12] of int;
{ 1..8 = N,T,D,M,Sup,Cl,$,T/F (0+0 - disabled);
9 = Max Fuel (30000-unlimited);
10 = Max Cargo (30000-unl.);
11 = Max $ (30000-unl.);
12 = Add Cargo (blocked amount);
[3,12] = Max T/F for base (0 - don't count);
[3,1..8] = amounts loaded onto ship }
procedure Shipment (var a:SArray; x1,x2,xa,y:int; c2,lr:byte; xt:xtype; chgburn:boolean);
var i : byte; { M.O.T.}
ch : word;
xx,yy,k : int;
cargo : array [1..2] of int;
cargo0 : int;
s : string[5];
allowss : boolean;
procedure PutNum (x,y:int; c:byte; n:int);
var s : string[5];
begin
if n=0 then s:='' else if n>19999 then s:='++++' else Str(n,s);
Clear(x,y,x+39,y+7);
SetColor(c);
OutTextXY(x,y,s);
end;
procedure MoveCargo (i1,i2,amt:int); { move amt from i1 to i2 }
var amt1,dm : int;
s1,s2 : string[4];
begin
if allowss and (i1=2) and (i=7) and (a[2,7]=0) and (a[2,5]>0) then
begin
if amt=0 then amt:=a[2,5];
amt:=Min(Min(amt,a[1,11]-a[1,7]),a[2,5]);
if amt=0 then Exit;
with TTurn^.data^.planet[PlanN]^ do
begin
dec(supplies,amt);
inc(funds,amt);
ChangeData(Pl,PlanN);
end;
dec(a[2,5],amt);
inc(a[1,7],amt);
inc(a[3,7],amt);
dec(cargo[2],amt);
PutNum(x1,yy,cSInfo,a[1,7]);
PutNum(x2,yy-16,c2,a[2,5]);
Exit;
end;
if i=1 then amt1:=a[i2,9]-a[i2,1]
else if i=7 then amt1:=a[i2,11]-a[i2,7]
else if (i=8) and (i2=2) and (a[3,12]<>0) then amt1:=a[3,12]-a[2,8]
else amt1:=a[i2,10]-cargo[i2];
amt:=Min(Min(amt,a[i1,i]),amt1);
if amt=0 then Exit;
if i2=1 then inc(a[3,i],amt) else dec(a[3,i],amt);
if a[i1,i]<20000 then dec(a[i1,i],amt);
if a[i2,i]<20000 then inc(a[i2,i],amt);
if i in [2..6,8] then
begin
dec(cargo[i1],amt);
inc(cargo[i2],amt);
Str(cargo[1]+a[1,12],s1);
Str(a[1,10]+a[1,12],s2);
Clear(MX0+7*8,CY0,639,CY0+7);
SetColor(cSInfo);
OutTextXY(MX0+7*8,CY0,s1+'/'+s2+' kt');
end;
PutNum(x1,yy,cSInfo,a[1,i]);
PutNum(x2,yy,c2,a[2,i]);
if chgburn then
with lship^ do
begin
dm:=cargo[1]-cargo0+a[3,1];
inc(fuel,a[3,1]);
inc(mass,dm);
SayFuel;
dec(fuel,a[3,1]);
dec(mass,dm);
end;
end;
begin
cargo[1]:=a[1,2]+a[1,3]+a[1,4]+a[1,5]+a[1,6]+a[1,8];
cargo0:=cargo[1];
if a[2,10]=30000 then cargo[2]:=20000
else cargo[2]:=a[2,2]+a[2,3]+a[2,4]+a[2,5]+a[2,6]+a[2,8];
for i:=1 to 9 do
if a[1,i] or a[2,i] <> 0 then Break;
if i>8 then Exit;
allowss:=(xt=Pl) and (PlanN<>0);
if allowss then
with TTurn^.data^.planet[PlanN]^ do
allowss:=(when=today) and (owner=player);
Clear(x1,y,639,y+8*8-1);
yy:=y;
for i:=1 to 8 do
begin
PutNum(x1,yy,cSInfo,a[1,i]);
PutNum(x2,yy,c2,a[2,i]);
inc(yy,8);
end;
SetLineStyle(SolidLn,0,NormWidth);
i:=1;
yy:=y;
xx:=IIF(lr=1,x1,x2);
repeat
PutNum(xx,yy,IIF(lr=1,cSInfo,c2),a[lr,i]);
SetColor(Yellow);
Line(xx,yy+7,xx+39,yy+7);
repeat ArrowBlink(xa,yy) until KeyPressed;
SetColor(Black);
Line(xx,yy+7,xx+39,yy+7);
ch:=ReadKey;
case ch of
$4800 : begin
Clear(xa,yy,xa+15,yy+7);
repeat
dec(i); if i=0 then i:=8;
until (a[1,i]<>0) or (a[2,i]<>0) or ((i=7) and allowss);
yy:=y+(i-1)*8;
end;
$5000 : begin
Clear(xa,yy,xa+15,yy+7);
repeat
inc(i); if i=9 then i:=1;
until (a[1,i]<>0) or (a[2,i]<>0) or ((i=7) and allowss);
yy:=y+(i-1)*8;
end;
$4B00 : if KbdFlags and KbdShft=0 then MoveCargo(2,1,1)
else MoveCargo(2,1,a[2,i]);
$4D00 : if KbdFlags and KbdShft=0 then MoveCargo(1,2,1)
else MoveCargo(1,2,a[1,i]);
$7300 : MoveCargo(2,1,10);
$7400 : MoveCargo(1,2,10);
$9B00 : MoveCargo(2,1,100);
$9D00 : MoveCargo(1,2,100);
9 : begin
lr:=lr xor 3;
xx:=IIF(lr=1,x1,x2);
end;
ord('0')..ord('9') :
if a[lr,i]<=19999 then
begin
GetStr1stKey:=ch;
s:=GetStr(xx,yy,5);
if GetStrKey=13 then
begin
k:=Value(s);
if (k>=0) and (k<20000) then
begin
dec(k,a[lr,i]);
if k>0 then MoveCargo(lr xor 3,lr,k)
else MoveCargo(lr,lr xor 3,-k);
end;
end;
end;
$3B00 : begin
helpscr:=5;
Help;
helpscr:=0;
DrawMap(Yes);
end;
end;
until (ch=13) or (ch=27);
end;
procedure TransferCargo (t:xtype);
label Cancel,Direct;
var a : SArray;
pn,l0,s0: int;
number : word;
p : pptr;
b : bptr;
h : sptr;
c,lr : byte;
ix1,ix2 : word;
s : string[3];
chgburn : boolean;
{ 1..8 = N,T,D,M,Sup,Cl,$,T/F (0+0 - disabled);
9 = Max Fuel (30000-unlimited);
10 = Max Cargo (30000-unl.);
11 = Max $ (30000-unl.);
12 = Add Cargo (blocked amount);
[3,12] = Max T/F for base (0 - don't count);
[3,1..8] = amounts loaded onto ship }
procedure PrepareShipTransfer (var a:SArray; h:sptr; i:byte);
begin
with h^ do
begin
a[i,1]:=fuel; a[i,2]:=T; a[i,3]:=D; a[i,4]:=M;
a[i,5]:=Sup; a[i,6]:=colonists; a[i,7]:=credits;
a[i,12]:=TFnum;
a[i,9]:=Hulls[hull].fuel;
a[i,10]:=Hulls[hull].cargo-a[i,12];
a[i,11]:=10000;
end;
end;
procedure TransferShipCargo (var a:SArray; h:sptr; hn:int; i:byte);
var r : int;
begin { NEVER use [1..2,1..8]!!! It may be:=0!! }
if i=1 then r:=1 else r:=-1;
with h^ do
begin
inc(fuel,a[3,1]*r);
inc(T,a[3,2]*r);
inc(D,a[3,3]*r);
inc(M,a[3,4]*r);
inc(Sup,a[3,5]*r);
inc(colonists,a[3,6]*r);
inc(credits,a[3,7]*r);
inc(TFnum,a[3,8]*r);
SetShipMass(h^);
{inc(mass,(a[3,1]+a[3,2]+a[3,3]+a[3,4]+a[3,5]+a[3,6]+a[3,8])*r);}
ChangeData(Sh,hn);
end;
end;
function Min20 (l:long) : int;
begin
if l<20000 then Min20:=l else Min20:=20000
end;
procedure EnableTF (h:sptr; i:byte);
var s : string[3];
begin
a[i,8]:=h^.TFnum;
inc(a[i,10],a[i,8]); dec(a[i,12],a[i,8]);
{if i=1 then
begin
SetColor(cSInfo);
if h^.bays=0 then s:='Tp:' else s:='Fg:';
OutTextXY(MX0,CY0+64,s);
end;}
end;
begin
if (turn<>today) or (lship^.owner<>player) or (lship^.when<>today) then Exit;
number:=lock and LockLo;
{MouseOff;}
MouseDisabled:=True;
FillChar(a,SizeOf(SArray),0);
PrepareShipTransfer(a,lship,1);
Clear(MX0,CY0+80,639,CY0+88+7);
if t=Sh then begin c:=LightBlue; ix1:=MX0+13*8; ix2:=MX0+10*8 end
else begin c:=LightGreen; ix1:=MX0+9*8; ix2:=MX0+15*8 end;
SetColor(c);
lr:=2;
chgburn:=Yes;
if t=Sh then
begin
OutTextXY(MX0,CY0+88,'Transfer to');
pn:=lship^.TSh;
if pn=0 then pn:=SelectShip(lx,ly,No,No);
if pn<>0 then
begin
s0:=ObjL0; l0:=lock;
h:=TTurn^.data^.ship[pn];
ObjL0:=(ShipNumXY(h,lx,ly)-1) div 10;
lock:=pn or LockS;
ltype:=LockS;
ObjList;
ObjL0:=s0; lock:=l0; ltype:=lock and LockHi;
end;
if pn=0 then goto Cancel;
chgburn:=(lship^.mission<>7) or (lship^.tow_ship<>pn);
if h^.owner=player then
begin
Clear(MX0,CY0+88,639,CY0+88+7);
SetColor(LightBlue);
OutTextXY(MX0,CY0+88,'Trans. to/from '+NStr0(pn));
PrepareShipTransfer(a,h,2);
if ((lship^.bays>0) and (h^.bays>0)) or
((lship^.Tl>0) and (lship^.Tl=h^.Tl)) then
begin
EnableTF(lship,1);
EnableTF(h,2);
end;
end
else
Direct:
with lship^ do begin
SetColor(LightBlue);
OutTextXY(MX0+12*8,CY0+88,NStr0(pn));
a[2,1]:=TN; a[2,2]:=TT; a[2,3]:=TD; a[2,4]:=TM;
a[2,5]:=TS; a[2,6]:=TC; a[1,7]:=0;
a[2,9]:=30000; a[2,10]:=30000;
end;
end
else begin
p:=nil; pn:=splan[number];
if pn=0 then OutTextXY(MX0,CY0+88,'Jettison cargo!')
else begin
p:=TTurn^.data^.planet[pn];
if (p=nil) or (p^.when<>today) or (p^.owner<>player) then
begin p:=nil; OutTextXY(MX0,CY0+88,'Unload to '+NStr0(pn)) end
else begin
OutTextXY(MX0,CY0+88,'Trans. to/from '+NStr0(pn));
lr:=1;
end;
end;
if p=nil then with lship^ do
begin
a[2,1]:=CN; a[2,2]:=CT; a[2,3]:=CD; a[2,4]:=CM; a[2,5]:=CS;
{if pn<>0 then} a[2,6]:=CC {else a[1,6]:=0};
a[1,7]:=0;
a[2,9]:=30000; a[2,10]:=30000;
end
else begin
with p^ do
begin
a[2,1]:=Min20(N); a[2,2]:=Min20(T); a[2,3]:=Min20(D); a[2,4]:=Min20(M);
a[2,5]:=Min20(supplies); a[2,6]:=Min20(colonists); a[2,7]:=Min20(funds);
a[2,9]:=30000; a[2,10]:=30000; a[2,11]:=30000;
end;
with lship^ do
if bays+launchers<>0 then
begin
b:=TTurn^.data^.base[pn];
if b<>nil then
begin
EnableTF(lship,1);
if bays=0 then a[2,8]:=b^.TT[Tl] else a[2,8]:=b^.fighters;
if (bays<>0) {and (not NoLimits)} then a[3,12]:=60;
end;
end;
end;
end;
Shipment(a,MX0+4*8,ix1,ix2,CY0+8,c,lr,t,chgburn);
if a[3,1] or a[3,2] or a[3,3] or a[3,4] or
a[3,5] or a[3,6] or a[3,7] or a[3,8]<>0 then
begin
TransferShipCargo(a,lship,number,1);
if t=Sh then
if (h<>nil) and (h^.owner=player) then TransferShipCargo(a,h,pn,2)
else with lship^ do begin
dec(TN,a[3,1]);
dec(TT,a[3,2]);
dec(TD,a[3,3]);
dec(TM,a[3,4]);
dec(TS,a[3,5]);
dec(TC,a[3,6]);
if TN or TT or TD or TM or TS or TC = 0 then pn:=0;
if TSh<>pn then TSh:=pn;
ChangeData(Sh,number);
end
else
if p=nil then
with lship^ do
begin
dec(CN,a[3,1]);
dec(CT,a[3,2]);
dec(CD,a[3,3]);
dec(CM,a[3,4]);
dec(CS,a[3,5]);
dec(CC,a[3,6]);
if CN or CT or CD or CM or CS or CC = 0 then pn:=0;
if CPl<>pn then CPl:=pn;
ChangeData(Sh,number);
end
else with p^ do begin
dec(N,a[3,1]);
dec(T,a[3,2]);
dec(D,a[3,3]);
dec(M,a[3,4]);
dec(supplies,a[3,5]);
dec(colonists,a[3,6]);
dec(funds,a[3,7]);
ChangeData(Pl,pn);
if a[3,8]<>0 then
begin
if lship^.bays=0 then dec(b^.TT[lship^.Tl],a[3,8])
else dec(b^.fighters,a[3,8]);
ChangeData(Ba,pn);
end;
end;
end;
Cancel:
ShipInfo;
MouseDisabled:=False;
{MouseOn;}
end;
procedure UpgradeBaseTech; { M.O.T.}
const yy0 = 152;
type TLarr = array [TLtype] of int;
var ch : word;
x,y : int;
lv : TLtype;
lvlp : pointer;
lvl : ^TLarr absolute lvlp;
lvl0,lvl1 : TLarr;
suppsold : long;
b : BRec;
myrace : int;
procedure WriteIt;
begin
SetColor(cBInfo);
Clear(MX0+8*8,yy0-2*8,639,yy0-2*8+7);
OutTextXY(MX0+8*8,yy0-2*8,NStr0(lplan^.supplies+lplan^.funds));
Clear(x,y,x+2*8-1,y+7);
OutTextXY(x,y,NStr(lvl^[lv]));
end;
procedure UpgradeTech (amt:int); { amt = 1 or -1 only }
var level : int;
k : long;
begin
level:=lvl^[lv];
amt:=Min(Max(level+amt,lvl0[lv]),lvl1[lv])-level;
if amt=0 then Exit;
with lplan^ do
begin
if (amt=1) and (funds+supplies<level*100) then Exit;
if amt=1 then
begin
dec(funds,level*100);
if funds<0 then
begin
dec(suppsold,funds); { funds<0 here }
inc(supplies,funds);
funds:=0;
end;
end
else begin
inc(funds,(level-1)*100);
if suppsold>0 then
begin
k:=MinL(suppsold,funds);
dec(suppsold,k);
inc(supplies,k);
dec(funds,k);
end;
end;
end;
inc(lvl^[lv],amt);
ChangeData(Pl,PlanN);
ChangeData(Ba,lock and LockLo);
end;
begin
if (turn<>today) or (lbase=nil) or (lplan=nil) or (lbase^.owner<>player) then Exit;
SetColor(cBInfo);
OutTextXY(MX0,yy0-2*8,'mc+sup:');
with lbase^ do
begin
lvlp:=Addr(El);
Move(lvl^,lvl0,SizeOf(TLarr));
for lv:=_El to _Tl do { lvl1 must be >= lvl0 }
lvl1[lv]:=Max(lvl0[lv],IIF(SWPlan and (lplan^.Nrace<>TechRace[lv]),6,10));
end;
LoadBDis(lock and LockLo,b);
Move(b.El,lvl0,SizeOf(TLArr));
if TrueHullByRace then myrace:=Race[lbase^.owner]
else myrace:=lbase^.owner;
for x:=1 to 20 do
if lbase^.HH[x]-b.HH[x]>0 then lvl0[_Hl]:=Max(lvl0[_Hl],Hulls[RaceHull[myrace,x]].tech);
for x:=1 to 10 do
if lbase^.EE[x]-b.EE[x]>0 then lvl0[_El]:=Max(lvl0[_El],Engines[x].tech);
for x:=1 to 10 do
if lbase^.WW[x]-b.WW[x]>0 then lvl0[_Wl]:=Max(lvl0[_Wl],Beams[x].tech);
for x:=1 to 10 do
if lbase^.LL[x]-b.LL[x]>0 then lvl0[_Tl]:=Max(lvl0[_Tl],Torps[x].tech);
for x:=1 to 10 do
if TFBuilt(lock and LockLo,x)>0 then lvl0[_Tl]:=Max(lvl0[_Tl],Torps[x].tech);
suppsold:=SoldSupp(lock and LockLo);
{MouseOff;}
MouseDisabled:=True;
SetLineStyle(SolidLn,0,NormWidth);
x:=MX0+13*8;
y:=yy0;
lv:=_El;
repeat
WriteIt;
SetColor(Yellow);
Line(x,y+7,x+15,y+7);
repeat ArrowBlink(640-2*8,y) until KeyPressed;
SetColor(Black);
Line(x,y+7,x+15,y+7);
ch:=ReadKey;
case ch of
$4800 : begin
Clear(640-2*8,y,639,y+7);
if lv=_El then lv:=_Tl else dec(lv);
y:=yy0+byte(lv)*8;
end;
$5000 : begin
Clear(640-2*8,y,639,y+7);
if lv=_Tl then lv:=_El else inc(lv);
y:=yy0+byte(lv)*8;
end;
$4B00 : UpgradeTech(-1);
$4D00 : UpgradeTech(1);
$3B00 : begin
helpscr:=5;
Help;
helpscr:=0;
DrawMap(Yes);
end;
end;
until (ch=13) or (ch=27);
BaseInfo;
MouseDisabled:=False;
{MouseOn;}
end;
procedure FixOrRecycleShip (bn,op,n:int);
var b : bptr;
begin
b:=TTurn^.data^.base[bn];
if (b=nil) or (b^.owner<>player) then Exit;
if b^.fShip=n then n:=0;
b^.fShip:=n;
if n=0 then op:=0;
b^.fOp:=op;
ChangeData(Ba,bn);
if ltype=LockS then ShipInfo
else BaseInfo;
end;
procedure FixOrRecycle (op:byte);
var n : int;
h : sptr;
s : string[3];
i0 : int absolute h;
begin
if (turn<>today) or (lbase=nil) or (lbase^.owner<>player) then Exit;
Clear(MX0,ListY,639,ListY+7);
SetColor(Yellow);
if op=1 then OutTextXY(MX0,ListY,'Fix ship:')
else OutTextXY(MX0,ListY,'Recycle ship:');
n:=SelectShip(lx,ly,op=2,No);
FixOrRecycleShip(lock and LockLo,op,n);
end;
function BuildClone : boolean;
var h : sptr;
begin
BuildClone:=No;
if (turn<>today) or (lbase=nil) or (lbase^.owner<>player) then Exit;
Clear(MX0,ListY,639,ListY+7);
SetColor(Yellow);
OutTextXY(MX0,ListY,'Clone ship:');
cloneID:=SelectShip(lx,ly,Yes,Yes);
if cloneID=0 then BaseInfo else BuildClone:=Yes;
end;
function SameOwner (r1,r2:int) : boolean;
begin
if r1=-1 then SameOwner:=(r2=player) else
if (r1=player) or (r1=0) then SameOwner:=(r2=r1) else
if IsData[r1] then SameOwner:=IsData[r2] else
SameOwner:=(r2>0) and (r2<>player) and (not IsData[r2]);
end;
procedure NextPlanet (dn:int);
var n,n0 : int;
p : pptr;
begin
if lplan=nil then Exit;
n:=lock and LockLo;
n0:=n;
repeat
inc(n,dn);
if n>500 then n:=1 else if n<1 then n:=500;
p:=TTurn^.data^.planet[n];
until (n=n0) or ((p<>nil) and (p^.when=turn) and SameOwner(lplan^.owner,p^.owner));
if n=n0 then Exit;
{CenterMap(Planets[n].x,Planets[n].y,No);}
force:=n or LockP;
ForceKey:=13;
end;
procedure NextBase (dn:int);
var n,n0 : int;
p : bptr;
begin
if lbase=nil then Exit;
n:=lock and LockLo;
n0:=n;
repeat
inc(n,dn);
if n>500 then n:=1 else if n<1 then n:=500;
p:=TTurn^.data^.base[n];
until (n=n0) or ((p<>nil) and SameOwner(lbase^.owner,p^.owner));
if n=n0 then Exit;
{ CenterMap(Planets[n].x,Planets[n].y,No);}
force:=n or LockP;
lbase:=p;
ForceKey:=13;
end;
procedure NextShip (dn:int);
var n,n0 : int;
p : sptr;
begin
n:=lock and LockLo;
n0:=n;
repeat
inc(n,dn);
if n>999 then n:=1 else if n<1 then n:=999;
p:=TTurn^.data^.ship[n];
until (n=n0) or ((p<>nil) and (p^.when=turn) and SameOwner(lship^.owner,p^.owner));
if n=n0 then Exit;
{CenterMap(p^.x,p^.y,nO);}
force:=n or LockS;
ForceKey:=13;
end;
procedure NextMines (dn:int);
var n,n0 : int;
p : mptr;
ow : int;
begin
if ltype<>LockM then Exit;
n:=lock and LockLo;
ow:=TTurn^.data^.mines[n]^.owner;
n0:=n;
repeat
inc(n,dn);
if n>500 then n:=1 else if n<1 then n:=500;
p:=TTurn^.data^.mines[n];
until (n=n0) or ((p<>nil) and SameOwner(ow,p^.owner));
if n=n0 then Exit;
{CenterMap(p^.x,p^.y,nO);}
force:=n or LockM;
ForceKey:=13;
end;
procedure NextIon (dn:int);
var n,n0 : int;
p : iptr;
begin
n:=IIF(lock=0,1,lock and LockLo);
n0:=n;
repeat
inc(n,dn);
if n>50 then n:=1 else if n<1 then n:=50;
p:=TTurn^.data^.ion[n];
until (n=n0) or (p<>nil);
if n=n0 then Exit;
{CenterMap(p^.x,p^.y,No);}
force:=n or LockI;
ForceKey:=13;
end;
procedure NextWorm (dn:int);
var n,n0 : int;
p : wptr;
begin
n:=lock and LockLo;
n0:=n;
repeat
inc(n,dn);
if n>199 then n:=0 else if n<0 then n:=199;
p:=TTurn^.data^.worm[n];
until (n=n0) or (p<>nil);
if n=n0 then Exit;
{CenterMap(p^.x,p^.y,No);}
force:=n or LockW;
ForceKey:=13;
end;
procedure NextUFO (dn:int);
var n,n0 : int;
p : uptr;
begin
n:=lock and LockLo;
n0:=n;
repeat
inc(n,dn);
if n>100 then n:=1 else if n<1 then n:=100;
p:=TTurn^.data^.ufo[n];
until (n=n0) or (p<>nil);
if n=n0 then Exit;
{CenterMap(p^.x,p^.y,No);}
force:=n or LockU;
ForceKey:=13;
end;
procedure ChangePassword;
var s,s1 : string[10];
ls : byte absolute s;
begin
if not RWMode then Exit;
MouseMove;
ClearInfo;
GetStrPwdChar:='*';
if Password<>NoPassword then
begin
SetColor(White);
OutTextXY(MX0,88,'Type OLD password:');
s:=GetStr(MX0+4*8,104,10);
if s<>Password then
begin
SetColor(Red);
OutTextXY(MX0,120,'Invalid password!');
GetStrPwdChar:=#0;
Exit;
end;
end;
SetColor(White);
OutTextXY(MX0,120,'Type NEW password:');
s:=GetStr(MX0+4*8,136,10);
OutTextXY(MX0,152,'Retype to confirm:');
s1:=GetStr(MX0+4*8,168,10);
GetStrPwdChar:=#0;
if s<>s1 then
begin
SetColor(Red);
OutTextXY(MX0,184,'Input mismatch!');
Exit;
end;
SetColor(Yellow);
if ls=0 then s:=NoPassword;
if s=Password then
begin
OutTextXY(MX0,192,'Password unchanged');
Exit;
end;
if s=NoPassword then
begin
OutTextXY(MX0,192,'Password will be');
OutTextXY(MX0,200,'disabled next time');
end
else begin
OutTextXY(MX0,192,'Changes will take');
OutTextXY(MX0,200,'effect next time');
end;
OutTextXY(MX0,208,'you run VPA');
NewPassword:=s;
DataChg:=Yes;
end;
End.