Unit VPA2; (* VPA Main Part - Display *)
{DEFINE DEBUG} (* include TurnsInMemory *)
Interface
uses AuxF,VPAData;
const ListY = 362;
BL1 = 208;
BL2 = 312;
CY0 = 256;
const dline : boolean = Off;
radius0 : int = 0;
var ObjN,PlanN,ShipN: int;
ObjL0,Obj0 : int;
procedure DrawMap (clr:boolean);
function GoToShipXY (var h:sptr; x,y,k:int) : int;
procedure MouseMove;
function MouseGetTarget (lcolor,lstyle:byte; ctrl:boolean) : boolean; { sets mmx,mmy }
procedure DrawWCircle (x,y,r:int);
procedure DrawPath;
procedure SayMoving;
procedure PlanetInfo;
procedure BaseInfo;
procedure ShipInfo;
procedure InitObjList;
procedure ObjList;
procedure WriteMiningRate;
function ShipNumXY (h:sptr; x,y:int) : word;
procedure Main;
Implementation
uses Graph,Screen,Mouse,StrF,Keyboard,VPA3,Tasks;
var mt0,mt1 : longint;
MineN,IonN,WormN,UfoN : int;
BL0 : int;
bOver : boolean;
AllH,eAllH,hOver: boolean;
ScanH : int;
lsxy : array [1..2,1..2] of int;
dlx,dly : int;
dlship : SRec;
{ dlf0 : long;
dlw,dlc : byte;}
dlf : long;
dlt : int;
dlc : byte;
mEv0 : word;
var DScolorR: byte;
DScolorO: byte;
DScolorT: byte;
DSwm : byte;
const DSdrawn : boolean = No;
SRdrawn : boolean = No;
forceDL : boolean = No;
var SRradius: word;
function UnderTow (id:int) : int; { tower's id or 0 }
var i : int;
h1 : sptr;
begin
UnderTow:=0;
for i:=1 to 999 do
begin
h1:=TTurn^.data^.ship[i];
if (h1<>nil) and (h1^.when=turn) and
(h1^.mission=7) and (h1^.tow_ship=id) then
begin UnderTow:=i; Exit end;
end;
end;
procedure DrawDistLine;
var vp : ViewPortType;
p0 : int;
begin
MouseOff;
GetViewSettings(vp);
SetViewPort(0,0,479,479,ClipOn);
SetLineStyle(DashedLn,0,NormWidth);
SetColor(cmDist);
p0:=GetPixel(lsxy[1,1],lsxy[1,2]);
SetWriteMode(XORPut);
Line(lsxy[1,1],lsxy[1,2],lsxy[2,1],lsxy[2,2]);
SetWriteMode(NormalPut);
PutPixel(lsxy[1,1],lsxy[1,2],p0);
SetViewPort(vp.x1,vp.y1,vp.x2,vp.y2,vp.clip);
MouseOn;
dline:=not dline;
end;
procedure DrawDistLock;
var xx,yy : int;
begin
if distlock<0 then Exit;
MouseOff;
Abs2Scr(dlx,dly,xx,yy);
if xx<476 then PutImage(xx-4,yy-4,BrownC^,XORPut);
MouseOn;
end;
procedure DrawWLine (x1,y1,x2,y2:int; FindMin:boolean);
procedure DrawLine (x1,y1,x2,y2:int);
var p1,p2 : byte;
outta : boolean;
begin
asm
mov outta,Yes
xor cx,cx { cx = 0 }
mov dx,479 { dx = 479 }
mov ax,x1 { ax = Min(x1,x2) }
mov bx,x2 { bx = Max(x1,x2) }
cmp ax,bx
jle @@1
xchg ax,bx
@@1: cmp ax,cx { ax = Max(ax,0) }
jge @@2
mov ax,cx
@@2: cmp bx,dx { bx = Min(bx,479) }
jle @@3
mov bx,dx
@@3: cmp ax,bx { if ax>bx then outta }
jg @@9
mov ax,y1 { ax = Min(y1,y2) }
mov bx,y2 { bx = Max(y1,y2) }
cmp ax,bx
jle @@4
xchg ax,bx
@@4: cmp ax,cx { ax = Max(ax,0) }
jge @@5
mov ax,cx
@@5: cmp bx,dx { bx = Min(bx,479) }
jle @@6
mov bx,dx
@@6: cmp ax,bx { if ax>bx then outta }
jg @@9
mov outta,No
@@9:
end;
if outta then Exit;
p1:=GetPixel(x1,y1); p2:=GetPixel(x2,y2);
Line(x1,y1,x2,y2);
PutPixel(x1,y1,p1); PutPixel(x2,y2,p2);
end;
begin
if MapWrap and FindMin then
begin
if long(Abs(x2-x1))*ratio1 div ratio2>400 then dec(x2,MapSSize*Sign(x2-x1));
if long(Abs(y2-y1))*ratio1 div ratio2>400 then dec(y2,MapSSize*Sign(y2-y1));
end;
DrawLine(x1,y1,x2,y2);
if MapWrap and (ratioN=1) then
begin
if (x1<0) or (x2<0) then DrawLine(x1+480,y1,x2+480,y2)
else if (x1>479) or (x2>479) then DrawLine(x1-480,y1,x2-480,y2);
if (y1<0) or (y2<0) then DrawLine(x1,y1+480,x2,y2+480)
else if (y1>479) or (y2>479) then DrawLine(x1,y1-480,x2,y2-480);
end;
end;
procedure DrawCircle (x,y,r:int);
var x1,y1 : int;
begin
if (x<-r) or (x>479+r) or (y<-r) or (y>479+r) then Exit; {completely outside}
x1:=x-IIF(x<240,479,0);
y1:=y-IIF(y<240,479,0);
if long(r)*r>long(x1)*x1+long(y1)*y1 then Exit; {completely inside}
Circle(x,y,r);
end;
procedure DrawWCircle (x,y,r:int);
var xw,yw : boolean;
begin
DrawCircle(x,y,r);
if MapWrap and (ratioN=1) then
begin
xw:=(x-r<0) or (x+r>479);
yw:=(y-r<0) or (y+r>479);
if xw then DrawCircle(x-Sign(x-r)*480,y,r);
if yw then DrawCircle(x,y-Sign(y-r)*480,r);
if xw and yw then DrawCircle(x-Sign(x-r)*480,y-Sign(y-r)*480,r);
end;
end;
procedure DrawFlyPath (h:sptr; sx1,sy1,heading,warp,wx,wy:int; c:byte);
var sx2,sy2 : int;
i,xx,yy,fc,fa : int;
fh,fh1 : sptr;
if1 : boolean;
hk : single;
_fuel,_eta : int;
begin
sx2:=sx1; sy2:=sy1;
if heading=-2 then
begin
if {(warp>0) and} (wx or wy<>0) then
begin
inc(sx2,long(wx)*ratio2 div ratio1);
dec(sy2,long(wy)*ratio2 div ratio1);
end;
CalcMovement(h,_fuel,_eta);
if Chunnel and chuns and (ltype=LockS) and (_eta<=1) then { check for chunnel }
begin
xx:=h^.x; yy:=h^.y;
if warp>0 then begin inc(xx,wx); inc(yy,wy) end;
if warp>1 then
begin
Location(xx,yy);
xx:=LocationX;
yy:=LocationY;
end;
if1:=(h^.warp=0) or
(h^.mission=10) or ((Race[h^.owner]=3) and (h^.mission=9)) or
(h^.fuel=0) or
(h^.fuel=_fuel);
for i:=1 to 999 do
begin
fh:=TTurn^.data^.ship[i];
with fh^ do
if (fh<>nil) and (when=turn) and (x=xx) and (y=yy) and
(warp=0) and (fuel>=50) and
(IsHullFunc(hull,hfChunneling)<>0) and (UnderTow(i)=0) and
((owner=h^.owner) or (h^.fcode=fcode) or if1) then
begin
Val(fcode,fc,fa);
if (fa=0) and (fc>0) and (fc<=999) then
begin
fh1:=TTurn^.data^.ship[fc];
with fh1^ do
if (fh1<>nil) and (when=turn) and (warp=0) and (owner=fh^.owner) and
(IsHullFunc(hull,hfChunneling)<>0) and (UnderTow(fc)=0) and
(Distance2(xx,yy,x,y)>=10000) then
begin
SetColor(IIF(showT,DScolorO xor DScolorR,DScolorO));
SetLineStyle(SolidLn,0,NormWidth);
Abs2Scr(xx,yy,xx,yy);
Abs2Scr(x,y,fc,fa);
DrawWLine(xx,yy,fc,fa,Yes);
Break;
end;
end;
end;
end;
end;
end
else if warp>0 then
begin
hk:=long(warp*warp)*ratio2/ratio1;
if (h<>nil) and (IsHullFunc(h^.hull,hfGravitonic)<>0) then hk:=hk*2;
inc(sx2,Round(hk*Sin(heading*Pi/180.0)));
dec(sy2,Round(hk*Cos(heading*Pi/180.0)));
end;
if (sx2<>sx1) or (sy2<>sy1) then
begin
SetColor(c);
SetLineStyle(SolidLn,0,NormWidth);
DrawWLine(sx1,sy1,sx2,sy2,No);
end;
end;
procedure DrawPath;
var x,y,px1,py1,px2,py2,wx,wy,heading,warp : int;
sx1,sy1,sx2,sy2 : int;
p1,p2 : byte;
mdr : boolean;
vp : ViewPortType;
h : sptr;
is : iptr;
u : uptr;
function NearBy (x1,y1,x2,y2:int) : boolean;
begin
NearBy:=(Abs(x1-x2)<=3) and (Abs(y1-y2)<=3);
end;
begin
if {showT or} ((ltype<>LockS) and (ltype<>LockI)) then Exit;
mdr:=mdraw;
MouseOff;
SetWriteMode(DSwm);
GetViewSettings(vp);
SetViewPort(0,0,479,479,ClipOn);
repeat { try }
if ltype=LockS then
begin
h:=TTurn^.data^.ship[lock and LockLo];
if h=nil then Break;
x:=h^.x; y:=h^.y;
px1:=h^.px1; py1:=h^.py1;
px2:=h^.px2; py2:=h^.py2;
wx:=h^.wx; wy:=h^.wy;
heading:=IIF(h^.mission=-1,h^.enemy,-2);
warp:=h^.warp;
end else
if ltype=LockI then
begin
is:=TTurn^.data^.ion[lock and LockLo];
if is=nil then Break;
x:=is^.x; y:=is^.y;
px1:=is^.px1; py1:=is^.py1;
px2:=is^.px2; py2:=is^.py2;
wx:=-1; wy:=-1;
heading:=is^.heading;
warp:=is^.warp;
h:=nil; { needed for DrawFlyPath }
end else
if ltype=LockU then
begin
u:=TTurn^.data^.ufo[lock and LockLo];
if u=nil then Break;
x:=u^.x; y:=u^.y;
px1:=u^.px1; py1:=u^.py1;
px2:=u^.px2; py2:=u^.py2;
wx:=-1; wy:=-1;
heading:=u^.heading;
warp:=u^.warp;
h:=nil; { needed for DrawFlyPath }
end;
Abs2Scr(x,y,sx1,sy1);
if heading<>-1 then DrawFlyPath(h,sx1,sy1,heading,warp,wx,wy,IIF(showT,8,DScolorR));
if ltype=LockS then
begin
sx2:=UnderTow(lock and LockLo);
if (sx2<>0) and ((h^.mission<>7) or (lock and LockLo>sx2)) then
begin
h:=TTurn^.data^.ship[sx2]; { h is changed !!! }
DrawFlyPath(h,sx1,sy1,-2,h^.warp,h^.wx,h^.wy,IIF(showT,DScolorO xor DScolorR,DScolorO));
end;
end;
SetColor(IIF(showT,8,DScolorT));
if (px1<>-1) and (not NearBy(x+wx,y+wy,px1,py1)) then
begin
SetLineStyle(UserBitLn,$6666,NormWidth);
Abs2Scr(px1,py1,sx2,sy2);
if (px1<>x+wx) or (py1<>y+wy) then DrawWLine(sx1,sy1,sx2,sy2,Yes);
sx1:=sx2; sy1:=sy2;
end;
if (px2<>-1) and ((px2<>x) or (py2<>y)) and (not NearBy(x+wx,y+wy,px2,py2)) then
begin
SetLineStyle(UserBitLn,$8888,NormWidth);
Abs2Scr(px2,py2,sx2,sy2);
DrawWLine(sx1,sy1,sx2,sy2,Yes);
end;
until True; { finally }
SetViewPort(vp.x1,vp.y1,vp.x2,vp.y2,vp.clip);
SetWriteMode(NormalPut);
if mdr then MouseOn;
DSdrawn:=not DSdrawn;
end;
procedure DrawShipRange;
{ var vp : ViewPortType;
xx,yy : int;
i2,ee,ww,ff,mm,n1 : int;
h1 : sptr;}
begin
(* with lship^ do
begin
if (ltype<>LockS) or (hull<=0) or (mass<=0) then Exit;
MouseOff;
GetViewSettings(vp);
SetViewPort(0,0,479,479,ClipOn);
SetLineStyle(SolidLn,0,NormWidth);
SetColor(DarkGray);
SetWriteMode(XORPut);
if not SRdrawn then
begin
ee:=IIF(El>0,El,9);
ww:=IIF(El>0,IIF(warp=0,El,warp),9);
ff:=IIF(fuel=-1,mass-Hulls[hull].mass,fuel);
mm:=mass;
n1:=IIF(mission=7,tow_ship,0);
if (n1<>-1) and (n1<>0) then { tow }
begin
h1:=TTurn^.data^.ship[n1];
if (h1<>nil) and (h1^.mass<>-1) then mm:=mm+h1^.mass;
end;
i2:=ww*ww;
if Lo(hull) in GraviHulls then i2:=i2*2;
SRradius:=Round(Ln(ff/mm)/Ln(1-Engines[ee].burn[ww]/100000)*i2);
end;
Abs2Scr(x,y,xx,yy);
DrawWCircle(xx,yy,long(SRradius)*ratio2 div ratio1));
SetWriteMode(NormalPut);
SetViewPort(vp.x1,vp.y1,vp.x2,vp.y2,vp.clip);
MouseOn;
end;
SRdrawn:=not SRdrawn;*)
end;
function MarkOffsetX(t:MarkType) : int;
begin
MarkOffsetX:=0;
if t=mrkFlag then
begin
MarkOffsetX:=-1;
end;
end;
function MarkOffsetY(t:MarkType) : int;
begin
MarkOffsetY:=0;
if (t=mrkFlag) or (t=mrkGrave) or (t=mrkCactus) then
begin
MarkOffsetY:=3;
end;
end;
procedure DrawMark (x,y:int; c:byte; t:MarkType); { XREF to VPA 3 }
begin
if t=mrkDLine then SetLineStyle(UserBitLn,$5B5B,NormWidth)
else SetLineStyle(SolidLn,0,NormWidth);
SetWriteMode(NormalPut);
SetColor(c);
case t of
mrkFlag : begin Line(x,y,x,y-7);
Line(x,y-6,x+3,y-5);
Line(x+3,y-5,x,y-4) end;
mrkCircle : Circle(x,y,2); { not DrawCircle! they can be on the right screen }
mrkCross : begin Line(x-2,y-2,x+2,y+2);
Line(x-2,y+2,x+2,y-2) end;
mrkSquare : Rectangle(x-2,y-2,x+2,y+2);
mrkRhombe : begin Line(x-2,y,x,y-2);
Line(x,y-2,x+2,y);
Line(x+2,y,x,y+2);
Line(x,y+2,x-2,y) end;
mrkPoint : PutPixel(x,y,c);
mrkRCircle: Circle(x,y,3); { not DrawCircle! they can be on the right screen }
mrkLine,
mrkDLine : Line(x-3,y-3,x+3,y+3);
mrkGrave : begin Line(x,y,x,y-6);
Line(x-2,y-5,x+2,y-5);
Line(x-1,y-1,x+1,y-2); end;
mrkCactus : begin Line(x,y,x,y-6);
Line(x-2,y-4,x-2,y-5);
Line(x-1,y-3,x+1,y-2);
Line(x+2,y-3,x+2,y-5); end;
end;
end;
procedure DrawMap (clr:boolean);
var xx,yy : int;
x2,y2 : int;
i : int;
l0 : int;
c : byte;
sh0 : boolean;
s : str20;
ls : byte absolute s;
mc : String[1];
begin
MouseOff;
MouseDisabled:=Yes;
SetViewPort(0,0,479,479,ClipOn);
if clr then
begin
ClearViewPort;
DSdrawn:=No;
SRdrawn:=No;
end
else begin
if DSdrawn then DrawPath;
if SRdrawn then DrawShipRange;
if distlock<>0 then DrawDistLock;
if dline then begin dline:=No; DrawDistLine end;
MouseOff; { DrawDistLock and DrawDistLine turn mouse on! }
end;
if MapWrap then
begin
SetColor(DarkGray);
SetLineStyle(DashedLn,0,NormWidth);
Abs2Scr(MapX0,MapY0,xx,yy);
Line(xx,0,xx,479);
Line(0,yy,479,yy);
end;
SetLineStyle(SolidLn,0,NormWidth);
with TTurn^.data^ do
begin
if showT or not clr then
begin
DSwm:=NormalPut;
sh0:=showT; showT:=No;
l0:=lock;
ltype:=LockS;
for i:=1 to 999 do
if ship[i]<>nil then
with ship[i]^ do
if when=turn then
begin
lock:=i or LockS;
DScolorR:=IIF(sh0 and (((showS) and (owner=player)) or ((showE) and (owner<>player))),cmRoute,Black);
DSColorO:=IIF(DSColorR=Black,Black,cmRoute);
DSColorT:=IIF(DSColorR=Black,Black,cmTrace);
DrawPath;
end;
ltype:=LockI;
for i:=1 to 50 do
if ion[i]<>nil then
with ion[i]^ do
begin
lock:=i or LockI;
DScolorR:=IIF(sh0 and showI,cmRoute,Black);
DSColorO:=IIF(DSColorR=Black,Black,cmTow);
DSColorT:=IIF(DSColorR=Black,Black,cmTrace);
DrawPath;
end;
ltype:=LockU;
for i:=1 to 100 do
if ufo[i]<>nil then
with ufo[i]^ do
begin
lock:=i or LockU;
DScolorR:=IIF(sh0 and showU,cmRoute,Black);
DSColorO:=IIF(DSColorR=Black,Black,cmTow);
DSColorT:=IIF(DSColorR=Black,Black,cmTrace);
DrawPath;
end;
lock:=l0; ltype:=lock and LockHi;
showT:=sh0;
end;
DSwm:=XORPut; DScolorR:=cmRoute; DScolorT:=cmTrace; DScolorO:=cmTow; DSdrawn:=No;
if showI or not clr then
for i:=1 to 50 do
if ion[i]<>nil then
with ion[i]^ do
begin
Abs2Scr(x,y,xx,yy);
SetColor(IIF(showI,IIF(voltage<50,cmIWeak,IIF(voltage<150,cmIMod,cmIDang)),Black));
DrawWCircle(xx,yy,long(radius)*ratio2 div ratio1);
end;
if IsMines and (showM or not clr) then
for i:=1 to 500 do
if mines[i]<>nil then
with mines[i]^ do
begin
Abs2Scr(x,y,xx,yy);
SetColor(IIF(showM,RaceColor[owner,_M_],Black));
DrawWCircle(xx,yy,Round(Sqrt(MaxL(units,0))*ratio2/ratio1));
end;
if showP and (ratioN>=PNRatio) then
begin
if UseSmallFont then SetTextStyle(SmallFont,HorizDir,4);
SetTextJustify(CenterText,BottomText);
SetColor(LightGray);
for i:=1 to 500 do
if (xyplan[i,1]<>-1) and Abs2Scr(xyplan[i,1],xyplan[i,2],xx,yy) then
begin
c:=eplan[i].owner;
if c=255 then c:=0;
SetColor(RaceColor[c,_P_]);
OutTextXY(xx,yy-4,PlName(i,No));
end;
for i:=1 to 100 do
if ufo[i]<>nil then
with ufo[i]^ do
if (color<>0) and Abs2Scr(x,y,xx,yy) then
begin
SetColor(color);
s:=name; Trim(s);
OutTextXY(xx,yy-4,s);
end;
if UseSmallFont then SetTextStyle(DefaultFont,HorizDir,1);
SetTextJustify(LeftText,TopText);
end;
if showA then
begin
mc := '*';
if UseSmallFont then SetTextStyle(SmallFont,HorizDir,4);
for i:=1 to nmark do
with mark^[i] do
if (mtype<>mrkNone) and (Abs2Scr(x,y,xx,yy) or
(mtype in [mrkRCircle..mrkDLine])) then begin
mc[1] := MarkGroup[mtype][color];
if (LastMarkMask < 1) or (MarkMask[CurMarkMask]='*') or
(PosInStr(mc,MarkMask[CurMarkMask]) <> 0) then
{ Abs2Scr MUST be executed, therefore, it is first in OR }
begin
if mtype=mrkRCircle then
begin
SetColor(color);
DrawWCircle(xx,yy,long(radius)*ratio2 div ratio1);
end else
if mtype in [mrkLine,mrkDLine] then
begin
SetLineStyle(IIF(mtype=mrkDLine,DashedLn,SolidLn),0,NormWidth);
x2:=xx; y2:=yy;
inc(x2,long(dx)*ratio2 div ratio1);
dec(y2,long(dy)*ratio2 div ratio1);
SetColor(color);
DrawWLine(xx,yy,x2,y2,No);
end
else begin
DrawMark(xx,yy,color,mtype);
s:=GetMarkText(i);
if (ls>0) and (s[1]<>'`') then
begin
SetTextJustify(xalg,yalg);
OutTextXY(xx+(1-xalg)*3+1,yy+(yalg-1)*3-1,s);
end;
end;
end;
end;
if UseSmallFont then SetTextStyle(DefaultFont,HorizDir,1);
SetTextJustify(LeftText,TopText);
end;
if showU or not clr then
begin
for i:=0 to 199 do
if worm[i]<>nil then
with worm[i]^ do
begin
Abs2Scr(x,y,xx,yy);
SetColor(IIF(showU,cmWorm,Black));
DrawWCircle(xx,yy,Round(( Exp(Ln(mass)*WormPower/100)/2 )*ratio2/ratio1));
if (i and 1=1) and (worm[i-1]<>nil) then
begin
MoveTo(xx,yy);
with worm[i-1]^ do Abs2Scr(x,y,xx,yy);
if showU and (cmWorm and 8=8) then SetColor(cmWorm xor 8);
SetLineStyle(DashedLn,0,NormWidth);
LineTo(xx,yy);
end;
end;
for i:=1 to 100 do
if ufo[i]<>nil then
with ufo[i]^ do
begin
Abs2Scr(x,y,xx,yy);
SetColor(IIF(showU,color,Black));
DrawWCircle(xx,yy,long(radius)*ratio2 div ratio1);
end;
end;
for i:=1 to 999 do
if (ship[i]<>nil) and (splan[i]<>0) then
with ship[i]^ do
if when=turn then
if Abs2Scr(x,y,xx,yy) then
begin
c:=RaceColor[owner,_S_];
c:=IIF(((owner=player) and showS) or ((owner<>player) and showE),c,Black);
SetColor(c); Circle(xx,yy,IIF(owner=player,3,2));
end;
for i:=1 to 500 do
if (xyplan[i,1]<>-1) and Abs2Scr(xyplan[i,1],xyplan[i,2],xx,yy) then
begin
c:=eplan[i].owner;
if c=255 then c:=0;
c:=IIF(eplan[i].activity and EP_Base=0,RaceColor[c,_P_],RaceColor[c,_B_]);
PutPixel(xx,yy,c);
if (LargePlanets and (ratioN>1)) or (eplan[i].activity and EP_Base<>0) then
begin
PutPixel(xx-1,yy,c);
PutPixel(xx+1,yy,c);
PutPixel(xx,yy-1,c);
PutPixel(xx,yy+1,c);
end;
end;
for i:=1 to 999 do
if (ship[i]<>nil) and (splan[i]=0) then
with ship[i]^ do
if (when=turn) and (owner<>player) then
if Abs2Scr(x,y,xx,yy) then
PutPixel(xx,yy,IIF(showE,RaceColor[owner,_S_],Black));
for i:=1 to 999 do
if (ship[i]<>nil) and (splan[i]=0) then
with ship[i]^ do
if (when=turn) and (owner=player) then
if Abs2Scr(x,y,xx,yy) then
begin
c:=RaceColor[owner,_S_];
if showS or (GetPixel(xx,yy)=c) then PutPixel(xx,yy,IIF(showS,c,Black));
end;
end;
if distlock<>0 then DrawDistLock;
if dline then begin dline:=No; DrawDistLine end;
{if not showT then} DrawPath;
DrawShipRange;
SetViewPort(0,0,639,479,ClipOn);
MouseDisabled:=No;
MouseOn;
end;
procedure LockDistTarget (xx,yy:int);
var i,n,mm : int;
{ ef,r : long;
i2 : int;}
{nd,}dd : single;
mx,my : int;
s,s1,s2 : string[6];
{ h1 : sptr;}
{ kf : single;}
{ clFB : int;}
dlsh1 : SRec;
lsxy0 : array [1..2,1..2] of int;
begin
if dline then DrawDistLine;
Abs2Scr(xx,yy,mx,my);
Move(lsxy,lsxy0,SizeOf(lsxy));
Abs2Scr(dlx,dly,lsxy[1,1],lsxy[1,2]);
lsxy[2,1]:=mx; lsxy[2,2]:=my;
DrawDistLine;
if forceDL then forceDL:=No
else if not Diff(lsxy,lsxy0,SizeOf(lsxy)) then Exit;
if MapWrap then
begin
if Sign(dlx-xx)<>Sign(lsxy[1,1]-lsxy[2,1]) then inc(xx,MapSize*Sign(lsxy[2,1]-lsxy[1,1]));
if Sign(yy-dly)<>Sign(lsxy[1,2]-lsxy[2,2]) then inc(yy,MapSize*Sign(lsxy[1,2]-lsxy[2,2]));
end;
dd:=Trunc(Sqrt(Distance2(dlx,dly,xx,yy))*10)/10;
Str(dd:4:1,s);
SetColor(LightGray);
Clear(MX0,dll+2,639,479);
if dll>400 then OutTextXY(MX0,472,'Distance = '+s)
else begin
OutTextXY(MX0,370,'Distance = '+s);
OutTextXY(MX0,380,'Warp Time Fuel');
SetLineStyle(SolidLn,0,NormWidth);
Line(MX0,388,623,388);
with dlship do
begin
if (mass=-1) or (hull=-1) or (El=-1) or (fuel=-1) then Exit;
wx:=xx-dlx;
wy:=yy-dly;
dlship.mission:=IIF(dlc=1,10,IIF(dlship.tow_ship=0,0,7));
if dd=0 then
begin
if dlc=1 then
begin
dlsh1:=dlship;
CalcMove(dlsh1,No);
n:=dlship.fuel-dlsh1.fuel;
SetColor(IIF(dlship.fuel>n,LightGray,Brown));
OutTextXY(MX0,392,'Cloaking : '+NStr0(n)+' kt');
end;
if (dlc<>2) and (turn=today) and (dlship.owner=player) then
begin
SetColor(White);
OutTextXY(MX0,392,'C');
end;
Exit;
end;
for i:=1 to 9 do
begin
dlsh1:=dlship;
dlsh1.warp:=i;
CalcMovement(@dlsh1,mm,n);
SetColor(IIF(mm>fuel,IIF(i=dlship.warp,Brown,DarkGray),
IIF(i=dlship.warp,Yellow,LightGray)));
if distlock<0 then inc(n,dlt);
if distlock<0 then inc(mm,dlf);
Str(i:2,s);
if n>=20000 then
begin
s1:=' too';
s2:='long';
end
else begin
Str(n:4,s1);
s2:=NStrMax(mm,4,'+');
for n:=1 to 3 do
if s2[n]='-' then s2[n]:='+';
end;
OutTextXY(MX0+8,380+i*10,s+' '+s1+' '+s2);
Line(MX0,388+i*10,623,388+i*10);
if (i<>dlship.warp) and (turn=today) {and (dlship.owner=player)} then
begin
SetColor(White);
OutTextXY(MX0+8,380+i*10,s);
end;
if dlc=1 then
begin
SetColor(LightGray);
OutTextXY(640-8,380+i*10,Copy('Cloaked',i,1));
end;
end;
if (dlc<>2) and (turn=today) {and (dlship.owner=player)} then
begin
SetColor(White);
OutTextXY(640-8,380+1*10,'C');
end;
end;
end;
end;
(*procedure LockDistTarget (lx,ly:int);
var i,n,mm : int;
ef,r : long;
i2 : int;
nd,dd : single;
mx,my : int;
s,s1,s2 : string[6];
h,h1 : sptr;
kf : single;
clFB : int;
n1 : int;
begin
if dline then DrawDistLine;
Abs2Scr(lx,ly,mx,my);
Abs2Scr(dlx,dly,lsxy[1,1],lsxy[1,2]);
lsxy[2,1]:=mx; lsxy[2,2]:=my;
DrawDistLine;
if MapWrap then
begin
if Sign(dlx-lx)<>Sign(lsxy[1,1]-lsxy[2,1]) then inc(lx,MapSize*Sign(lsxy[2,1]-lsxy[1,1]));
if Sign(ly-dly)<>Sign(lsxy[1,2]-lsxy[2,2]) then inc(ly,MapSize*Sign(lsxy[1,2]-lsxy[2,2]));
end;
dd:=Sqrt(Distance2(dlx,dly,lx,ly));
Str(dd:4:1,s);
SetColor(LightGray);
Clear(MX0,dll+2,639,479);
if dll>400 then OutTextXY(MX0,472,'Distance = '+s)
else begin
OutTextXY(MX0,370,'Distance = '+s);
OutTextXY(MX0,380,'Warp Time Fuel');
SetLineStyle(SolidLn,0,NormWidth);
Line(MX0,388,623,388);
h:=TTurn^.data^.ship[Abs(distlock) and LockLo];
if (h=nil) or (h^.mass=-1) or (h^.hull=-1) or (h^.El=-1) or (h^.fuel=-1) then Exit;
with h^ do
begin
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;
end;
if dlc=1 then
begin
i:=h^.mission;
h^.mission:=10;
clFB:=CloakFuel(h);
h^.mission:=i;
end
else clFB:=0;
if distlock<0 then dec(mm,MinL(h^.fuel,dlf));
if dd=0 then
begin
if dlc=1 then
begin
SetColor(IIF(h^.fuel>clFB,LightGray,Brown));
OutTextXY(MX0,392,'Cloaking : '+NStr0(clFB)+' kt');
end;
if (dlc<>2) and (turn=today) and (h^.owner=player) then
begin
SetColor(White);
OutTextXY(MX0,392,'C');
end;
Exit;
end;
for i:=1 to 9 do
begin
i2:=i*i; { XREF to CalcFuel }
if IsHullFunc(h^.hull,hfGravitonic)<>0 then i2:=i2*2;
ef:=Engines[h^.El].burn[i];
kf:=ef/100000;
SetColor(IIF(i=dlw{h^.warp},Yellow,LightGray));
Str(i:2,s);
if dd<i2+1 then n:=1 else n:=Ceil(dd/i2); { XREF to ETA }
if distlock<0 then inc(n,dlt);
Str(n:4,s1);
dec(n);
if n>0 then r:=Trunc(long(mm)*(1.0-Exp(Ln(1-kf)*n)))
else r:=0;
nd:=dd-long(i2)*n;
inc( r , long(clFB)*(n+1)+Trunc(nd*((long(mm)-MinL(r,h^.fuel)) div 10)*(ef/i2)/10000) ); {local XREF}
if distlock<0 then inc(r,dlf);
if i=dlw{h^.warp} then
begin
if dd>i2 then nd:=i2 else nd:=dd;
dlf0:=Trunc(nd*(mm div 10)*(ef/i2)/10000)+clFB; { local XREF }
end;
if r>h^.fuel then SetColor(IIF(i=dlw{h^.warp},Brown,DarkGray));
s2:=NStrMax(r,4,'+');
OutTextXY(MX0+8,380+i*10,s+' '+s1+' '+s2);
Line(MX0,388+i*10,623,388+i*10);
if (i<>dlw) and (turn=today) and (h^.owner=player) then
begin
SetColor(White);
OutTextXY(MX0+8,380+i*10,s);
end;
if dlc=1 then
begin
SetColor(LightGray);
OutTextXY(640-8,380+i*10,Copy('Cloaked',i,1));
end;
end;
if (dlc<>2) and (turn=today) and (h^.owner=player) then
begin
SetColor(White);
OutTextXY(640-8,380+1*10,'C');
end;
end;
end;*)
procedure CenterMap (x,y:int; forced:boolean);
var sx,sy : int;
begin
Abs2Scr(x,y,sx,sy);
if forced or (sx<0) or (sy<0) or (sx>479) or (sy>479) then
begin
inc(x0,sx-240); inc(y0,sy-240);
MoveMouseTo(240,240);
DrawMap(Yes);
if distlock<>0 then LockDistTarget(mmx,mmy);
end;
end;
procedure Zoom (k:byte); {0 - ZoomOut, 1 or 255 - enlarge/sqeeze }
var mx,my : int;
w0 : boolean;
begin
Scr2Abs(MouseX,MouseY,mx,my);
if k=0 then ratioN:=1
else begin
inc(ratioN,k);
if ratioN=0 then ratioN:=NRatios;
if ratioN>NRatios then ratioN:=1;
end;
InitRatios;
x0:=0; y0:=0;
w0:=MapWrap; MapWrap:=No;
if ratioN=1 then
begin
Abs2Scr(mx,my,MouseX,MouseY);
MouseX:=Min(Max(MouseX,0),479);
MouseY:=Min(Max(MouseY,0),479);
end
else begin
Abs2Scr(mx,my,x0,y0);
dec(x0,239); dec(y0,239);
MouseX:=240; MouseY:=240;
end;
MapWrap:=w0;
MoveMouseTo(MouseX,MouseY);
DrawMap(Yes);
if lock<>0 then begin force:=lock; ForceKey:=13 end
else MouseMove;
end;
procedure SetScreenPos (n:byte);
begin
if KbdFlags and KbdShft<>0 then { store screen pos }
begin
Move(ratioN,ScreenPos[n],SizeOf(VPAScr)-2);
ScreenPos[n].force:=lock;
end
else if ScreenPos[n].ratioN<>0 then
begin { retrieve screen pos }
MouseMove;
Move(ScreenPos[n],ratioN,SizeOf(VPAScr)-2-NShows); { without showflags }
InitRatios;
force:=ScreenPos[n].force;
DrawMap(Yes);
if force<>0 then ForceKey:=13;
end;
end;
procedure InitObjList;
var i : int;
h : sptr;
p : pptr;
begin
ObjL0:=0;
ObjN:=0;
for i:=1 to 999 do
if ShipIsHere(i,lx,ly) then
begin
if lock=i or LockS then ObjL0:=ObjN div 10; { before increment! }
inc(ObjN);
end;
ShipN:=ObjN;
with TTurn^.data^ do
begin
if showM then
for i:=1 to 500 do
if (mines[i]<>nil) and (mines[i]^.x=lx) and (mines[i]^.y=ly) then
begin
if lock=i or LockM then ObjL0:=ObjN div 10;
inc(ObjN);
end;
MineN:=ObjN;
if showI then
for i:=1 to 50 do
if (ion[i]<>nil) and (ion[i]^.x=lx) and (ion[i]^.y=ly) then
begin
if lock=i or LockI then ObjL0:=ObjN div 10;
inc(ObjN);
end;
IonN:=ObjN;
if showU then
for i:=0 to 199 do
if (worm[i]<>nil) and (worm[i]^.x=lx) and (worm[i]^.y=ly) then
begin
if lock=i or LockW then ObjL0:=ObjN div 10;
inc(ObjN);
end;
WormN:=ObjN;
if showU then
for i:=1 to 100 do
if (ufo[i]<>nil) and (ufo[i]^.x=lx) and (ufo[i]^.y=ly) then
begin
if lock=i or LockU then ObjL0:=ObjN div 10;
inc(ObjN);
end;
UfoN:=ObjN;
if showA then
for i:=1 to nmark do
with mark^[i] do
if ((mtype<>mrkNone) and (x=lx) and (y=ly)) or
((mtype in [mrkLine,mrkDLine]) and (x+dx=lx) and (y+dy=ly)) then
begin
if lock=i or LockA then ObjL0:=ObjN div 10;
inc(ObjN);
end;
end;
if lock=0 then PlanN:=0
else PlanN:=PSearchXY(lx,ly);
end;
function GoToShipXY (var h:sptr; x,y,k:int) : int;
var i : int;
begin
for i:=1 to 999 do
if ShipIsHere(i,x,y) then
begin
h:=TTurn^.data^.ship[i];
dec(k);
if k<=0 then begin GoToShipXY:=i or LockS; Exit end;
end;
h:=nil;
GoToShipXY:=0;
end;
function ShipNumXY (h:sptr; x,y:int) : word;
var i,k : int;
begin
k:=1;
if h<>nil then
begin
for i:=1 to 999 do
if ShipIsHere(i,x,y) then
begin
if TTurn^.data^.ship[i]=h then Break;
inc(k);
end;
end;
ShipNumXY:=k;
end;
function GoToMinesXY (var m:mptr; x,y,k:int) : int;
var i : int;
begin
with TTurn^.data^ do
for i:=1 to 500 do
if (mines[i]<>nil) and (mines[i]^.x=x) and (mines[i]^.y=y) then
begin
m:=mines[i];
dec(k);
if k<=0 then begin GoToMinesXY:=i or LockM; Exit end;
end;
m:=nil;
GoToMinesXY:=0;
end;
function GoToIonXY (var ii:iptr; x,y,k:int) : int;
var i : int;
begin
with TTurn^.data^ do
for i:=1 to 50 do
if (ion[i]<>nil) and (ion[i]^.x=x) and (ion[i]^.y=y) then
begin
ii:=ion[i];
dec(k);
if k<=0 then begin GoToIonXY:=i or LockI; Exit end;
end;
ii:=nil;
GoToIonXY:=0;
end;
function GoToWormXY (var w:wptr; x,y,k:int) : int;
var i : int;
begin
with TTurn^.data^ do
for i:=0 to 199 do
if (worm[i]<>nil) and (worm[i]^.x=x) and (worm[i]^.y=y) then
begin
w:=worm[i];
dec(k);
if k<=0 then begin GoToWormXY:=i or LockW; Exit end;
end;
w:=nil;
GoToWormXY:=0;
end;
function GoToUfoXY (var u:uptr; x,y,k:int) : int;
var i : int;
begin
with TTurn^.data^ do
for i:=1 to 100 do
if (ufo[i]<>nil) and (ufo[i]^.x=x) and (ufo[i]^.y=y) then
begin
u:=ufo[i];
dec(k);
if k<=0 then begin GoToUfoXY:=i or LockU; Exit end;
end;
u:=nil;
GoToUfoXY:=0;
end;
function GoToMarkXY (var a:MapMark; x,y,k:int) : int;
var i : int;
begin
with TTurn^.data^ do
for i:=1 to nmark do
with mark^[i] do
if ((mtype<>mrkNone) and (x=lx) and (y=ly)) or
((mtype in [mrkLine,mrkDLine]) and (x+dx=lx) and (y+dy=ly)) then
begin
a:=mark^[i];
dec(k);
if k<=0 then begin GoToMarkXY:=i or LockA; Exit end;
end;
GoToMarkXY:=0;
end;
procedure ObjList;
var h : sptr;
m : mptr;
ii : iptr;
w : wptr;
u : uptr;
a : MapMark;
k : byte;
l : int;
s : string[8];
n : int;
ms : str20;
mls : byte absolute s;
procedure Highlight;
begin
SetFillStyle(SolidFill,8);
Bar(MX0,l,639,l+7);
Obj0:=k;
end;
begin
if (distlock<>0) and (dll<400) then Exit;
if distlock<>0 then Clear(MX0,ListY,639,dll-2)
else begin
Clear(MX0,ListY,639,479);
DrawHelpPrompt;
end;
if lock=0 then Exit;
Obj0:=0;
k:=ObjL0*10+1; l:=378;
while (k<=ObjN) and (k<=ObjL0*10+10) do
begin
if k<=ShipN then
begin
n:=GoToShipXY(h,lx,ly,k);
if h<>nil then
begin
if n=lock then Highlight;
SetColor(RaceColor[h^.owner,_S_]);
with h^ do
if hull<>-1 then
if owner=player then OutTextXY(MX0+24,l,name)
else OutTextXY(MX0+24,l,Hulls[hull].name)
else begin
if mass=-1 then s:='' else s:=' ('+NStr0(mass)+'kt)';
OutTextXY(MX0+24,l,'Ship '+NStr0(n and LockLo)+s);
end;
end;
end else
if k<=MineN then
begin
n:=GoToMinesXY(m,lx,ly,k-ShipN);
if n=lock then Highlight;
SetColor(RaceColor[m^.owner,_M_]);
if m^.web and 1=0 then s:='field' else s:='WEB';
OutTextXY(MX0+24,l,'Mine '+s+' '+NStr(n and LockLo));
end else
if k<=IonN then
begin
n:=GoToIonXY(ii,lx,ly,k-MineN);
if n=lock then Highlight;
SetColor(cIInfo);
OutTextXY(MX0+24,l,'Ion storm '+NStr(n and LockLo));
end else
if k<=WormN then
begin
n:=GoToWormXY(w,lx,ly,k-IonN);
if n=lock then Highlight;
SetColor(cWInfo);
OutTextXY(MX0+24,l,'Wormhole '+NStr0(n and LockLo));
end else
if k<=UfoN then
begin
n:=GoToUfoXY(u,lx,ly,k-WormN);
if n=lock then Highlight;
SetColor(u^.color);
OutTextXY(MX0+24,l,u^.name);
end
else begin
n:=GoToMarkXY(a,lx,ly,k-UfoN);
if n=lock then Highlight;
SetColor(LightGray);
OutTextXY(MX0+24+16,l,'marker');
DrawMark(MX0+24+4,l+4+MarkOffsetY(a.mtype),a.color,a.mtype);
end;
Str(k:2,s);
SetColor(cSInfo);
OutTextXY(MX0,l,s);
SetColor(White);
OutTextXY(MX0+8,l,s[2]);
inc(l,8);
inc(k);
end;
SetColor(White);
if ObjL0>0 then OutTextXY(MX0+24,ListY+12*8,'PgUp');
if (ObjN>0) and (ObjL0<(ObjN-1) div 10) then OutTextXY(640-4*8,ListY+12*8,'PgDn');
if PlanN<>0 then
begin
if (lbase<>nil) or (ltype<>LockP) then
begin
SetColor(cPInfo);
OutTextXY(640-8*8,ListY,'<Planet>');
SetColor(White);
OutTextXY(640-7*8,ListY,'P');
end;
with TTurn^.data^ do
if (lbase=nil) and (eplan[PlanN].activity and EP_Base<>0) and
(planet[PlanN]<>nil) and (planet[PlanN]^.build<>1) then
begin
k:=IIF(ltype=LockP,6,18);
SetColor(IIF((base[PlanN]<>nil) or (newplan[PlanN] and NP_Base<>0),cPInfo,cOPInfo));
OutTextXY(640-k*8,ListY,'<Base>');
if base[PlanN]<>nil then
begin
SetColor(White);
OutTextXY(640-(k-1)*8,ListY,'B');
end;
end;
end;
end;
procedure WriteMiningRate;
var s : string[3];
begin
if lplan=nil then Exit;
SetColor(IIF((lplan^.when=turn) and (lplan^.when=lplan^.when0),cPInfo,cOPInfo));
with lplan^ do
begin
if (Nc<>-1) and (Nm<>-1) and (Nc<>0) then
begin
Clear(MX0+12*8+1,308,MX0+15*8-1,315);
Str(MiningRate(lplan,Nc,Nm):3,s);
OutTextXY(MX0+12*8,308,s);
end;
if (Tc<>-1) and (Tm<>-1) and (Tc<>0) then
begin
Clear(MX0+12*8+1,318,MX0+15*8-1,325);
Str(MiningRate(lplan,Tc,Tm):3,s);
OutTextXY(MX0+12*8,318,s);
end;
if (Dc<>-1) and (Dm<>-1) and (Dc<>0) then
begin
Clear(MX0+12*8+1,328,MX0+15*8-1,335);
Str(MiningRate(lplan,Dc,Dm):3,s);
OutTextXY(MX0+12*8,328,s);
end;
if (Mc<>-1) and (Mm<>-1) and (Mc<>0) then
begin
Clear(MX0+12*8+1,338,MX0+15*8-1,345);
Str(MiningRate(lplan,Mc,Mm):3,s);
OutTextXY(MX0+12*8,338,s);
end;
end;
end;
procedure WriteMineral (M,y:int; N,Nc:long; Nm:int);
var s,s1,s2,s3 : string[6];
sm : array [1..2] of char absolute M;
begin
s:=''; s1:=' '; s2:='';
if N>-1 then Str(N:5,s);
if (Nc<>-1) and (Nc<>-2) then Str(Nc:5,s1);
if (Nm<>-1) and (Nc<>0) then
begin
Str(MiningRate(lplan,Nc,Nm):3,s3);
s2:=s3+'/'+NStrMax(Nm,2,'+');
end;
OutTextXY(MX0,y,sm+s+s1+s2);
end;
procedure WriteIncome;
var l : long;
begin
Clear(MX0+10*8,272,638,279);
l:=PlanetIncome(lplan);
if l>0 then
begin
SetColor(IIF((lplan^.when=turn) and (lplan^.when=lplan^.when0),cPInfo,cOPInfo));
OutTextXY(MX0,272,'Income : '+NStr0(l));
end;
end;
procedure WriteTaxes (tax,y:int);
var s : string[7];
begin
if tax=0 then s:='No' else s:=NStr(tax)+'%';
OutTextXY(MX0,y,' Taxes: '+s);
end;
procedure WriteActivity (var ep:epln);
var k : byte;
begin
k:=ep.activity and 7;
if k=0 then Exit;
if k>5 then k:=0;
SetColor(IIF(ep.when=turn,cPInfo,cOPInfo));
OutTextXY(MX0,224,Industry[k]);
OutTextXY(MX0,232,' industrial');
OutTextXY(MX0,240,' activity');
end;
procedure PlanetInfo;
var s : string[18];
s1 : string[8];
p : pptr;
ep : EPln;
l : long;
i,t0 : int;
number : word;
c : byte;
newpln : byte;
tsk : taskptr;
begin
if ltype<>LockP then Exit;
number:=lock and LockLo;
if (number=0) or (number>500) then Exit;
Clear(MX0,72,639,358);
SetColor(White);
OutTextXY(MX0,72,'Planet '+NStr(number));
OutTextXY(MX0,80,PlanName[number]);
SetColor(LightGray);
with TTurn^.data^ do
begin
p:=planet[number];
ep:=eplan[number];
newpln:=newplan[number];
end;
if (p=nil) and (ep.activity=0) then OutTextXY(MX0,104,'(No data)') else
if p=nil then
begin
if ep.when=turn then s:='now'
else s:=NStr(turn-ep.when)+Proper(turn-ep.when,' turn')+' ago';
OutTextXY(MX0,88,'('+s+')');
SetColor(IIF(ep.when=turn,cPInfo,cOPInfo));
if ep.owner<>0 then OutTextXY(MX0,104,'Race: '+RaceName[ep.owner]);
WriteActivity(ep);
end
else with p^ do
begin
lplan:=p;
i:=Max(when,ep.when);
t0:=when0;
if (ep.when<>0) and (ep.when<when0) then t0:=ep.when;
if i=turn then s:='now' else s:=NStr(turn-i);
s:='('+s;
if t0<>i then s:=s+' - '+NStr(turn-t0)+' trn ago'
else if t0<>turn then s:=s+Proper(turn-t0,' turn')+' ago';
s:=s+')';
OutTextXY(MX0,88,s);
if (when=turn) and (when=when0) then
begin
c:=cPInfo;
newpln:=newpln or ($FF-NP_Base);
end
else c:=cOPInfo;
if owner<>-1 then
begin
SetColor(IIF(newpln and NP_Owner=0,cOPInfo,cPInfo));
OutTextXY(MX0,104,'Race: '+RaceName[IIF(ep.owner<>0,ep.owner,owner)]);
end;
if fcode<>#$FF#$FF#$FF then
begin
i:=IIF(newpln and NP_MFD_FCode=0,cOPInfo,cPInfo);
SetColor(i);
OutTextXY(MX0,112,'FCode:');
WriteFCode(MX0+7*8,112,i,fcode);
end;
if climate<>-1 then
begin
SetColor(IIF(newpln and NP_Climate=0,cOPInfo,cPInfo));
OutTextXY(MX0,128,'Climate: '+ClimStr[ClimateType(climate)]+' '+NStrMax(100-climate,2,'+'));
end;
if Nrace<>-1 then
begin
SetColor(IIF(newpln and NP_NRace_NPop=0,cOPInfo,cPInfo));
if Nrace<>0 then
begin
OutTextXY(MX0,136,'Natives:');
OutTextXY(MX0,144,' '+NatRace[Nrace]);
if natives<>-1 then OutTextXY(MX0,160,' Pop. : '+NStr(natives)+'00');
SetColor(c);
if Ngovt<>-1 then OutTextXY(MX0,152,' '+NatGovt[Ngovt]);
WriteHChange(Yes);
if Ntax<>-1 then WriteTaxes(Ntax,168);
if Nstat<>-1 then
begin
SetColor(IIF(Nstat>=70,c,IIF(Nstat<30,LightRed,Yellow)));
OutTextXY(MX0,176,' Happy: '+NStr0(Nstat)+'%');
end;
end
else OutTextXY(MX0,144,'(no native life)');
end;
if (ep.owner<>0) and (ep.owner<>owner) and (ep.when>=when) then WriteActivity(ep)
else begin
if colonists<>-1 then
begin
SetColor(IIF(newpln and NP_CPop=0,cOPInfo,cPInfo));
if owner<>0 then
begin
OutTextXY(MX0,184,'Colonists:');
if colonists<>-1 then OutTextXY(MX0,192,' Pop. : '+NStr(colonists)+'00');
SetColor(c);
WriteHChange(No);
if Ctax<>-1 then WriteTaxes(Ctax,200);
end
else begin
OutTextXY(MX0,200,'Colonists: None');
OutTextXY(MX0,208,'( )');
end;
end;
if Cstat<>-1 then
begin
SetColor(IIF(Cstat>=70,c,IIF(Cstat<30,LightRed,Yellow)));
OutTextXY(MX0,208,' Happy: '+NStr0(Cstat)+'%');
end;
if (colonists<>-1) and (mines and factories and defense<>-1) then
begin
i:=IIF(newpln and NP_MFD_FCode=0,cOPInfo,cPInfo);
SetColor(i);
if mines<>-1 then
begin
l:=MaxPlanetStruct(p,200);
Str(mines:3,s); Str(l,s1);
OutTextXY(MX0,224,'Mines : /'+s1);
if mines>l then SetColor(Red);
OutTextXY(MX0+11*8,224,s);
SetColor(i);
end;
if factories<>-1 then
begin
l:=MaxPlanetStruct(p,100);
Str(factories:3,s); Str(l,s1);
OutTextXY(MX0,232,'Factories: /'+s1);
if factories>l then SetColor(Red);
OutTextXY(MX0+11*8,232,s);
SetColor(i);
end;
if defense<>-1 then
begin
l:=MaxPlanetStruct(p,50);
Str(defense:3,s); Str(l,s1);
OutTextXY(MX0,240,'Defense : /'+s1);
if defense>l then SetColor(Red);
OutTextXY(MX0+11*8,240,s);
SetColor(i);
end;
end
else WriteActivity(ep);
if supplies<>-1 then
begin
SetColor(IIF(newpln and NP_Supplies=0,cOPInfo,cPInfo));
{SetColor(c);}
OutTextXY(MX0,256,'Supplies: '+NStr0(supplies));
end;
if funds<>-1 then
begin
SetColor(IIF(newpln and NP_NTDM_Funds=0,cOPInfo,cPInfo));
OutTextXY(MX0,264,'Funds : '+NStr0(funds));
end;
WriteIncome;
end;
if N and T and D and M<>-1 then
begin
SetColor(IIF(newpln and NP_NTDM_Funds=0,cOPInfo,cPInfo));
OutTextXY(MX0,288,'Minerals: ');
SetLineStyle(SolidLn,0,NormWidth);
i:=IIF(Nm and Tm and Dm and Mm<>-1,639,MX0+12*8);
Line(MX0+2*8,306,i,306);
Line(MX0+2*8,316,i,316);
Line(MX0+2*8,326,i,326);
Line(MX0+2*8,336,i,336);
Line(MX0+2*8,346,i,346);
Line(MX0+2*8,307,MX0+2*8,345);
Line(MX0+12*8,307,MX0+12*8,345);
if (Nc and Tc and Dc and Mc<>-1) then
begin
Line(MX0+7*8,307,MX0+7*8,345);
OutTextXY(MX0,298,' Surf Core Extr');
end
else begin
if i=639 then s:=' Ext' else s:='';
OutTextXY(MX0,298,' Surf+Core'+s);
end;
WriteMineral($654E,308,N,Nc,Nm);
WriteMineral($7254,318,T,Tc,Tm);
WriteMineral($7544,328,D,Dc,Dm);
WriteMineral($6F4D,338,M,Mc,Mm);
end;
if build=1 then
begin
SetColor(Yellow);
OutTextXY(MX0,351,'BUILDING STARBASE');
end;
SetColor(White);
if (Nrace>0) and (Ngovt<>-1) and (natives<>-1) and (climate<>-1) then OutTextXY(MX0+8,168,'T');
if RWMode and (turn=today) and (when=today) and (distlock=0) and (owner=player) then
begin
OutTextXY(MX0,112,'F');
OutTextXY(MX0+24,200,'x');
OutTextXY(MX0,224,'M');
OutTextXY(MX0+8,232,'a');
OutTextXY(MX0,240,'D');
OutTextXY(MX0,256,'S');
if build=1 then OutTextXY(MX0,351,'B');
if (ep.activity and EP_Base=0) and (build=0) and (T>=402) and (D>=120) and (M>=340) and (funds+supplies>=900) then
begin
OutTextXY(MX0,351,'B');
SetColor(cPInfo);
OutTextXY(MX0+8,351,'uild Starbase');
end;
tsk:=FindTask(lock);
if tsk<>nil then
begin
SetColor(LightGray);
OutTextXY(640-4*8,72,'< >');
if tsk^.flag and tfDeac=0 then SetColor(White);
OutTextXY(640-3*8,72,'F8');
end;
end;
end;
lbase:=nil;
ObjList;
if (ep.owner<>0) and (ep.owner<>player) and (not IsData[ep.owner]) and
(ep.activity and EP_NoBase<>0) then
begin
SetColor(IIF(newpln and NP_Base=0,cOPInfo,cPInfo));
OutTextXY(640-9*8,ListY,'<No Base>');
end;
end;
procedure BaseStorage;
type str18 = string[18];
var s : string[7];
l,l0 : word;
i,j : byte;
sl0 : int;
myrace : int;
procedure Say (s:str18);
begin
if (l>=BL0) and (l<=BL0+BL2-BL1) then
begin
OutTextXY(MX0,BL1+l-BL0,s);
sl0:=0;
end
else if l>BL0+BL2-BL1 then bOver:=Yes;
inc(l,8);
end;
procedure SLine;
begin
if (l<>l0) and (l>=BL0+8) and (l<=BL0-BL1+BL2+8) then
begin
sl0:=BL1+l-BL0+3;
Line(MX0,sl0,639,sl0);
end;
inc(l,8); l0:=l;
end;
begin
Clear(MX0,BL1,639,BL2+15);
bOver:=No;
sl0:=0;
with lbase^ do
begin
if TrueHullByRace then myrace:=Race[owner]
else myrace:=owner;
l:=BL1; l0:=BL1;
s:='';
for i:=1 to 20 do
for j:=1 to HH[i] do
begin
if (cHl=i) and (s='') then
begin SetColor(Yellow); s:='1' end
else SetColor(cBInfo);
Say(Hulls[RaceHull[myrace,i]].name);
end;
SetColor(cBInfo);
SLine;
for i:=1 to 9 do
if EE[i]<>0 then
begin
SetColor(IIF(cEl=i,Yellow,cBInfo));
Say(NStr(EE[i])+' '+Proper(EE[i],Engines[i].name));
end;
SetColor(cBInfo);
SLine;
for i:=1 to 10 do
if WW[i]<>0 then
begin
SetColor(IIF(cWl=i,Yellow,cBInfo));
Say(NStr(WW[i])+' '+Proper(WW[i],Beams[i].name));
end;
SetColor(cBInfo);
SLine;
for i:=1 to 10 do
if LL[i]<>0 then
begin
SetColor(IIF(cTl=i,Yellow,cBInfo));
Say(NStr(LL[i])+' '+Proper(LL[i],Torps[i].name+' launcher'));
end;
SetColor(cBInfo);
SLine;
for i:=1 to 10 do
if TT[i]<>0 then Say(NStr(TT[i])+' '+Proper(LL[i],Torps[i].name+' torpedo'));
SLine;
end;
if sl0<>0 then
begin
SetColor(Black);
Line(MX0,sl0,639,sl0);
end;
SetColor(cBInfo);
l:=BL0-BL1+BL2+8; l0:=0; SLine;
SetColor(White);
if BL0>BL1 then OutTextXY(MX0,BL2+8,'Home');
if bOver then OutTextXY(640-3*8,BL2+8,'End');
end;
function CheckClone (baseId:int) : int;
{ -1 - impossible, 0 - possible but not active, 1..999 - id being cloned }
var i,x,y,k : int;
h : sptr;
begin
CheckClone:=-1;
if (not Cloning) or (CloneCost[player]=32767) then Exit;
with TTurn^.data^ do
begin
x:=xyplan[baseId,1];
y:=xyplan[baseId,2];
end;
for i:=1 to ShipN do
begin
k:=GoToShipXY(h,x,y,i);
if (h<>nil) and (h^.when=turn) and (h^.owner=player) and not OwnShipDesign(player,h^.hull) then
if h^.fcode<>'cln' then CheckClone:=0
else begin CheckClone:=k and LockLo; Exit end;
end;
end;
procedure BaseInfo;
var l : int;
number : word;
begin
if ltype<>LockP then Exit;
number:=lock and LockLo;
if (number=0) or (number>500) then Exit;
lplan:=TTurn^.data^.planet[number];
lbase:=TTurn^.data^.base[number];
if lbase=nil then Exit;
Clear(MX0,72,639,358);
SetColor(White);
OutTextXY(MX0,72,'Starbase '+NStr(number));
OutTextXY(MX0,80,PlanName[number]);
BL0:=BL1;
with lbase^ do
begin
SetColor(cBInfo);
OutTextXY(MX0,96,'Defense: '+NStr0(defense));
OutTextXY(MX0,104,'Damage:');
if damage>0 then
begin
SetColor(LightRed);
OutTextXY(MX0+10*8,104,NStr(damage)+'%');
SetColor(cBInfo);
end;
OutTextXY(MX0,112,'Fighters: '+NStr(fighters));
OutTextXY(MX0,120,'Primary order:');
OutTextXY(MX0,128,' '+BaseOrd[order]);
OutTextXY(MX0,144,'Tech. levels:');
OutTextXY(MX0,152,' Engines '+NStr(El));
OutTextXY(MX0,160,' Hulls '+NStr(Hl));
OutTextXY(MX0,168,' Weapons '+NStr(Wl));
OutTextXY(MX0,176,' Torpedoes '+NStr(Tl));
OutTextXY(MX0,192,'Base storage:');
SetLineStyle(SolidLn,0,NormWidth);
Line(MX0,203,639,203);
BaseStorage;
l:=CheckClone(number);
SetColor(Yellow);
if cHl<>0 then OutTextXY(MX0,BL2+16,'BUILDING SHIP')
else if l>0 then OutTextXY(MX0+6*8,BL2+16,'CLONING SHIP');
if fOp<>0 then
begin
if fOp=1 then OutTextXY(MX0,BL2+32,'FIXING Ship '+NStr0(fShip));
if fOp=2 then OutTextXY(MX0,BL2+32,'RECYCLING '+NStr0(fShip));
end;
if RWMode and (turn=today) and (distlock=0) then
begin
SetColor(White);
OutTextXY(MX0,96,'D');
OutTextXY(MX0+8*8,120,'o');
OutTextXY(MX0,144,'T');
OutTextXY(MX0,BL2+16,'B');
if (cHl=0) and (l<=0) then
begin
SetColor(cBInfo);
OutTextXY(MX0+8,BL2+16,'uild ship');
end;
if l>=0 then
if cHl<>0 then
begin
SetColor(White);
OutTextXY(632,BL2+16,'C');
end else
if l=0 then
begin
SetColor(cBInfo);
OutTextXY(MX0+13*8,BL2+16,'Clone');
SetColor(White);
OutTextXY(MX0+13*8,BL2+16,'C');
end
else begin
SetColor(White);
OutTextXY(MX0+6*8,BL2+16,'C');
end;
SetColor(cBInfo);
OutTextXY(MX0,BL2+24,'Buy torps/fighters');
SetColor(White);
OutTextXY(MX0+2*8,BL2+24,'y');
if fOp=0 then
begin
SetColor(cBInfo);
OutTextXY(MX0,BL2+32,'Fix ship Recycle');
SetColor(White);
OutTextXY(MX0,BL2+32,'F R');
end
else if fOp<>2 then OutTextXY(MX0,BL2+32,'F R')
else OutTextXY(MX0,BL2+32,'R F');
end;
end;
ObjList;
end;
procedure HullTypes;
const HY0 = 176;
HY1 = 344;
var i,j,l : word;
myrace : int;
procedure ScanAllHulls;
var i,k,j0 : int;
begin
k:=1; j0:=j;
for i:=1 to 105 do
begin
if HullFit(i,lship^.mass1,lship^.mass2) then
begin
if j=HY1 then
if k<ScanH then begin j:=j0; inc(k) end
else begin hOver:=Yes; Break end;
if j<HY1 then
begin
if k=ScanH then OutTextXY(MX0,j,Hulls[i].name);
inc(j,8);
end;
end;
end;
SetColor(White);
if ScanH>1 then OutTextXY(MX0,j,'Home');
if hOver then OutTextXY(640-3*8,j,'End');
end;
begin
Clear(MX0,HY0+16,639,344+7);
eAllH:=No; hOver:=No;
with lship^ do
begin
SetColor(cSInfo);
j:=HY0+16;
if AllH then ScanAllHulls
else begin
if TrueHullByRace then myrace:=Race[owner]
else myrace:=owner;
for i:=1 to 20 do
begin
l:=RaceHull[myrace,i];
if HullFit(l,mass1,mass2) then
begin
OutTextXY(MX0,j,Hulls[l].name);
inc(j,8);
end;
end;
end;
if j>=HY0+24 then
begin
SetColor(White);
OutTextXY(MX0+14*8,HY0,'A');
SetColor(IIF(AllH,cSInfo+8,DarkGray));
OutTextXY(MX0+13*8,HY0,'( ll)');
SetColor(cSInfo);
eAllH:=Yes;
end;
if j>HY0+24 then OutTextXY(MX0,HY0,'It might be:')
else if j=HY0+24 then
begin
if (not AllH) or (ScanH=1) then
OutTextXY(MX0,HY0+8,'I think it is a')
end
else begin
SetColor(Red);
OutTextXY(MX0,HY0,'This ship COUDN''T');
OutTextXY(MX0,HY0+8,'be constructed');
OutTextXY(MX0,HY0+16,'by '+RaceName[owner]);
SetColor(cSInfo);
j:=HY0+48;
ScanAllHulls;
if j>HY0+56 then OutTextXY(MX0,HY0+32,'It might be:')
else if j=HY0+56 then OutTextXY(MX0,HY0+40,'It is SURELY a');
end;
end;
end;
procedure SayMoving; { currently called for lship only }
var e,f : int;
towed : int;
s : string[2];
begin
Clear(MX0,128,639,136+7);
with lship^ do
begin
towed:=UnderTow(lock and LockLo);
if towed<>0 then
begin
SetColor(Yellow);
OutTextXY(MX0,128,'Being towed by '+NStr0(towed));
end;
SetColor(cSInfo);
if ((warp<>-1) and (warp=0)) or (wx or wy=0) then
begin if towed=0 then OutTextXY(MX0,128,'Not moving') end
else begin
if mission=-1 then
begin
if (towed=0) and (enemy<>-1) then OutTextXY(MX0,128,'Heading: '+NStr0(enemy));
end
else if warp<>-1 then
begin
if towed=0 then OutTextXY(MX0,128,'Dest: '+Location(x+wx,y+wy));
CalcMovement(lship,f,e);
if e>0 then OutTextXY(640-7*8,136,'ETA:'+NStrMax(e,3,'+'));
end;
end;
if warp<>-1 then
begin
OutTextXY(MX0,136,'Warp:');
if towed<>0 then
begin if warp>0 then SetColor(Yellow) end
else if (El<>-1) and (warp<>El) then SetColor(IIF(warp>El,LightRed,Yellow));
OutTextXY(MX0+6*8,136,NStr0(warp));
if RWMode and (turn=today) and (distlock=0) and (owner=player) then
begin
SetColor(White);
OutTextXY(MX0,136,'W');
end;
SetColor(cSInfo);
end;
end;
end;
procedure SayMission (h:sptr);
var s : str20;
mp : MITptr;
xx : int;
begin
SetColor(cSInfo);
with h^ do
begin
if mission>=0 then
begin
if mission<=15 then
begin
if mission<>9 then s:=Missions[mission]
else s:=SpecMisn[Race[owner]];
end
else begin
mp:=MIT;
while (mp<>nil) and (mp^.mission<>mission) do mp:=mp^.next;
if mp<>nil then s:=mp^.name
else s:='Mission '+NStr0(mission);
xx:=MX0+6*8;
if (mp=nil) or (mp^.param and MIT_I<>0) then
begin
OutTextXY(xx,200,'I='+NStr0(intr_ship));
inc(xx,6*8);
end;
if (mp=nil) or (mp^.param and MIT_T<>0) then
OutTextXY(xx,200,'T='+NStr0(tow_ship));
end;
if mission in [7,8] then
begin
s:=s+' '+NStr0(IIF(mission=7,tow_ship,intr_ship));
SetColor(Yellow);
if (mission=7) and (not OneEngineTow) and
(Hulls[hull].engines<2) then SetColor(LightRed);
end else
if (mission=10) and (damage>=CloakPreventDamage) and
(Sup<(damage-CloakPreventDamage+1)*5) then SetColor(LightRed);
OutTextXY(MX0+6*8,192,s);
SetColor(cSInfo);
OutTextXY(MX0,192,'Misn:');
end;
end;
end;
procedure ShipInfo;
var s : string[18];
s1 : string[4];
h : sptr;
i,j,l : int;
number : word;
b : bptr;
p : pptr;
tsk : taskptr;
begin
if ltype<>LockS then Exit;
number:=lock and LockLo;
if (number=0) or (number>999) then Exit;
Clear(MX0,72,639,358);
h:=TTurn^.data^.ship[number];
if (h=nil) or (h^.when<>turn) then Exit;
if PlanN<>0 then b:=TTurn^.data^.base[PlanN] else b:=nil;
with h^ do
begin
lship:=h;
SetColor(White);
OutTextXY(MX0,72,'Ship: '+NStr(number));
OutTextXY(MX0,80,'Race: '+RaceName[owner]);
SetColor(cSInfo);
OutTextXY(MX0,112,'at '+Location(x,y));
if name[1]<>#$FF then
begin
SetColor(LightGray);
OutTextXY(MX0,96,name);
end;
SetColor(White);
if hull<>-1 then OutTextXY(MX0,88,Hulls[hull].name);
if mass<>-1 then
if hull<>-1 then
begin
if (owner<>player) and (not IsData[owner]) and (turn=today) then OutTextXY(632,72,'F');
end
else begin
if turn<>today then SetColor(cSInfo);
OutTextXY(MX0+9*8,88,'H');
SetColor(cSInfo);
OutTextXY(MX0,88,'(unknown ull)');
AllH:=No; ScanH:=1; HullTypes;
end;
SayFuel;
SayMoving;
if mass<>-1 then
begin
if hull<>-1 then s:='' else s:='+W';
OutTextXY(MX0,160,'Mass'+s+': '+NStr0(mass)+' kt');
end;
if fcode<>#$FF#$FF#$FF then
begin
OutTextXY(MX0,168,'FCode:');
WriteFCode(MX0+7*8,168,cSInfo,fcode);
end;
if crew<>-1 then
begin
OutTextXY(MX0,176,'Crew :');
SetColor(IIF(crew<>Hulls[hull].crew,Yellow,cSInfo));
OutTextXY(MX0+7*8,176,NStr0(crew));
if (b<>nil) and (b^.fOp=1) and (b^.fShip=number) then
begin
SetColor(LightGreen);
OutTextXY(640-7*8,176,'(fixed)');
end;
SetColor(cSInfo);
end;
if damage<>-1 then
begin
OutTextXY(MX0,184,'Damage:');
if damage>0 then
begin
i:=damage;
SetColor(LightRed);
OutTextXY(MX0+8*8,184,NStr(i)+'%');
if (b<>nil) and (b^.fOp=1) and (b^.fShip=number) then i:=0
else i:=Max(i-Sup div 5-IIF((Race[owner]=6) and (mission=9),10,0),0);
if i<damage then
if i<=0 then
begin
SetColor(LightGreen);
OutTextXY(640-7*8,184,'(fixed)');
end
else begin
SetColor(Yellow);
OutTextXY(640-6*8,184,'('+NStr(i)+'%)');
end;
SetColor(cSInfo);
end;
end;
SayMission(h);
if (mission<>-1) and (enemy<>-1) then
OutTextXY(MX0,200+IIF(mission>15,8,0),'Enemy: '+RaceName[enemy]);
if (hull<>-1) and (El and Wl and Tl<>-1) then
begin
OutTextXY(MX0,215,'Equipment:');
if El<>-1 then
begin
s:='';
if (not OneEngineTow) and (Hulls[hull].engines=1) then s:='1 ';
OutTextXY(MX0,224,' '+s+Proper(Hulls[hull].engines,Engines[El].name));
end;
if (Wl<>-1) and (weapons<>-1) then
begin
if weapons=0 then OutTextXY(MX0,232,' No main weapons')
else OutTextXY(MX0,232,' '+NStr(weapons)+' '+Proper(weapons,Beams[Wl].name));
end;
if bays or launchers=0 then OutTextXY(MX0,240,' No bays/launchers')
else begin
if bays>0 then OutTextXY(MX0,240,' '+NStr(bays)+Proper(bays,' Fighter bay')) else
if launchers>0 then OutTextXY(MX0,240,' '+NStr(launchers)+Proper(launchers,' '+Torps[Tl].name+' tube'));
end;
end;
if (hull<>-1) and (colonists<>-1) and (Sup<>-1) and (credits<>-1) and
(fuel<>-1) and (T<>-1) and (D<>-1) and (M<>-1) and (TFnum<>-1) and
(CN<>-1) and (CT<>-1) and (CD<>-1) and (CM<>-1) and (CC<>-1) and (CS<>-1) and (CPl<>-1) and
(TN<>-1) and (TT<>-1) and (TD<>-1) and (TM<>-1) and (TC<>-1) and (TS<>-1) and (TSh<>-1) then
begin
OutTextXY(MX0,CY0,'Cargo: '+NStr0(colonists+Sup+T+D+M+TFnum)+'/'+NStr0(Hulls[hull].cargo)+' kt');
OutTextXY(MX0,CY0+8,'Ne: '+NStr(fuel));
OutTextXY(MX0,CY0+16,'Tr: '+NStr(T));
OutTextXY(MX0,CY0+24,'Du: '+NStr(D));
OutTextXY(MX0,CY0+32,'Mo: '+NStr(M));
OutTextXY(MX0,CY0+40,'Sp: '+NStr(Sup));
OutTextXY(MX0,CY0+48,'Cl: '+NStr(colonists));
OutTextXY(MX0,CY0+56,'$$: '+NStr(credits));
if bays or launchers<>0 then
begin
if bays=0 then s:='Tp: ' else s:='Fg: ';
OutTextXY(MX0,CY0+64,s+NStr(TFnum));
end;
if CN or CT or CD or CM or CC or CS<>0 then
begin
SetColor(cPInfo);
OutTextXY(MX0+9*8,CY0+8,NStr(CN));
OutTextXY(MX0+9*8,CY0+16,NStr(CT));
OutTextXY(MX0+9*8,CY0+24,NStr(CD));
OutTextXY(MX0+9*8,CY0+32,NStr(CM));
OutTextXY(MX0+9*8,CY0+40,NStr(CS));
OutTextXY(MX0+9*8,CY0+48,NStr(CC));
if CPl=0 then OutTextXY(MX0,CY0+88,'Jettison cargo!')
else OutTextXY(MX0,CY0+88,'Unload to '+NStr0(CPl));
end;
if TN or TT or TD or TM or TC or TS<>0 then
begin
SetColor(LightBlue);
OutTextXY(MX0+14*8,CY0+8,NStr(TN));
OutTextXY(MX0+14*8,CY0+16,NStr(TT));
OutTextXY(MX0+14*8,CY0+24,NStr(TD));
OutTextXY(MX0+14*8,CY0+32,NStr(TM));
OutTextXY(MX0+14*8,CY0+40,NStr(TS));
OutTextXY(MX0+14*8,CY0+48,NStr(TC));
OutTextXY(MX0,CY0+80,'Transfer to '+NStr0(TSh));
end;
end;
if RWMode and (turn=today) and (distlock=0) and (owner=player) then
begin
SetColor(White);
OutTextXY(632,72,'N');
OutTextXY(MX0,136,'W');
OutTextXY(MX0,168,'F');
OutTextXY(MX0,192,'M');
OutTextXY(MX0,200+IIF(mission>15,8,0),'E');
OutTextXY(MX0,CY0,'C');
if ShipN>1 then
begin
if TSh=0 then
begin
SetColor(cSInfo);
OutTextXY(MX0+8,CY0+80,'ransfer');
end;
SetColor(White);
OutTextXY(MX0,CY0+80,'T');
end;
if PlanN<>0 then
begin
p:=TTurn^.data^.planet[PlanN];
if (p<>nil) and (p^.when=turn) and (p^.owner=player) then
begin
if T+D+M+Sup+IIF(Gambling and (IsHullFunc(hull,hfGambling)<>0),0,colonists)+credits>0 then
begin
SetColor(cSInfo);
OutTextXY(MX0,CY0+88,'Unload');
SetColor(White);
OutTextXY(MX0,CY0+88,'U');
end;
if bays or launchers<>0 then
begin
if (b<>nil) and (b^.owner=player) then
begin
SetColor(cSInfo);
OutTextXY(MX0+9*8,CY0+64,'Bu more');
SetColor(White);
OutTextXY(MX0+11*8,CY0+64,'y');
end;
i:=Hulls[hull].cargo-T-D-M-Sup-colonists-TFnum;
if ((launchers>0) and (i>=3) and (p^.T>0) and (p^.D>0) and (p^.M>0) and
(MinL(p^.funds+p^.supplies,10000-credits)>=Torps[Tl].cost)) or
((Race[player] in [9..11]) and (bays>0) and
(i>=10) and (p^.T>=3) and (p^.M>=2) and (p^.supplies>=5)) then
begin
SetColor(cSInfo);
OutTextXY(640-10*8,CY0+88,'Load&Build');
SetColor(White);
OutTextXY(640-10*8,CY0+88,'L');
end;
end;
end;
if (b<>nil) and (b^.owner=player) then
begin
if (b^.fOp=2) and (b^.fShip=number) then
begin
SetColor(Yellow);
OutTextXY(MX0,351,'BEING RECYCLED');
end;
if (damage>0) or (crew<>Hulls[hull].crew) then
begin
SetColor(White);
OutTextXY(MX0+1*8,CY0+72,'i');
SetColor(Yellow);
OutTextXY(MX0,CY0+72,'F x');
if (b^.fOp=1) and (b^.fShip=number) then OutTextXY(MX0+3*8,CY0+72,'ing ship');
end;
end;
end;
tsk:=FindTask(lock);
if tsk<>nil then
begin
SetColor(LightGray);
OutTextXY(640-6*8,72,'< >');
if tsk^.flag and tfDeac=0 then SetColor(White);
OutTextXY(640-5*8,72,'F8');
end;
end;
if (owner<>player) and (not IsData[owner]) and
(mass<>-1) and (mass<>0) and ((mass<MinSM) or (mass>MaxSM) or
((hull<>-1) and (not HullFit(hull,mass,mass)))) then
begin
Clear(MX0,215,639,344+7);
SetColor(LightRed);
OutTextXY(MX0,216,'!!! ATTENTION !!!');
if (hull<>-1) and (owner<>player) then
begin
OutTextXY(MX0,224,' WRONG HULL TYPE');
OutTextXY(MX0,232,' ASSUMPTION!');
if turn=today then
begin
OutTextXY(MX0,272,'Press F to cancel');
OutTextXY(MX0,280,' this assumption');
SetColor(White);
OutTextXY(MX0+6*8,272,'F');
end;
end
else begin
OutTextXY(MX0,224,' DATA ERROR');
OutTextXY(MX0,232,' OR CHEATING!');
end;
if (mass<MinSM) or (mass>MaxSM) then OutTextXY(MX0,248,'NEITHER ship can')
else OutTextXY(MX0,248,'This ship CAN NOT');
OutTextXY(MX0,256,'have such mass');
end;
end;
if not DSdrawn then DrawPath;
if not SRdrawn then DrawShipRange;
ObjList;
end;
procedure MineInfo;
var s : string[12];
m : mptr;
i,k : int;
number : word;
nd,dd : long;
c : byte;
robot : boolean;
begin
if ltype<>LockM then Exit;
number:=lock and LockLo;
if (number=0) or (number>500) then Exit;
m:=TTurn^.data^.mines[number];
if m<>nil then
with m^ do
begin
ClearInfo;
SetColor(White);
if (web and 2=2) and (owner=12) then s:='Someone''s'
else s:=RaceName[owner];
OutTextXY(MX0,72,s);
if web and 1=0 then s:='field ' else s:='WEB ';
OutTextXY(MX0,80,'mine '+s+NStr(number));
SetColor(LightGray);
if when=turn then OutTextXY(MX0,88,'(now)')
else OutTextXY(MX0,88,'('+NStr(turn-when)+Proper(turn-when,' turn')+' ago)');
c:=RaceColor[owner,_M_];
SetColor(c);
OutTextXY(MX0,104,'Center:('+NStr0(x)+','+NStr0(y)+')');
OutTextXY(MX0,112,'Radius: '+NStr0(Trunc(Sqrt(MaxL(units,0)))));
s:=NStr00(units,'SWEPT OUT');
if (web and 2=2) and (units>0) then s:='÷'+s;
OutTextXY(MX0,120,'Units : '+s);
with TTurn^.data^ do
begin
k:=0; nd:=1000000000;
for i:=1 to 500 do
begin
if ( ((owner=player) or IsData[owner]) and ((planet[i]=nil) or (planet[i]^.when<>turn)) ) or
((eplan[i].when=turn) and (eplan[i].owner<>owner)) or
((planet[i]<>nil) and (planet[i]^.when=turn) and (planet[i]^.owner<>owner))
then Continue;
dd:=Distance2(x,y,xyplan[i,1],xyplan[i,2]);
if dd<nd then begin nd:=dd; k:=i end;
end;
if k<>0 then
begin
OutTextXY(MX0,136,'FCode planet: '+NStr(k));
with planet[k]^ do
if (planet[k]<>nil) and (when=turn) and (fcode<>#$FF#$FF#$FF) then
begin
OutTextXY(MX0,144,'FCode :');
WriteFCode(MX0+14*8,144,c,fcode);
end;
end;
k:=0;
for i:=1 to 500 do
if (eplan[i].owner=owner) and (planet[i]<>nil) and (planet[i]^.when=turn) and
(Copy(planet[i]^.fcode,1,2)='mf') then k:=i;
if k<>0 then
begin
OutTextXY(MX0,152,'UniFC planet: '+NStr(k));
OutTextXY(MX0,160,'Universal FC:');
WriteFCode(MX0+14*8,160,c,planet[k]^.fcode);
end;
end;
if units>0 then
begin
robot:=(Race[owner]=9);
OutTextXY(MX0,178,'This is equal to:');
if robot then OutTextXY(MX0,186,'(using 4X bonus)');
for i:=1 to 10 do
begin
Str(units/(i*i*IIF(robot,4,1)):9:2,s);
OutTextXY(MX0,IIF(robot,190,182)+i*8,s+' '+Torps[i].name);
end;
end;
end;
ObjList;
end;
procedure IonInfo;
var ii : iptr;
number : word;
begin
ClearInfo;
if ltype<>LockI then Exit;
number:=lock and LockLo;
if (number=0) or (number>50) then Exit;
ii:=TTurn^.data^.ion[number];
if ii<>nil then
with ii^ do
begin
SetColor(White);
OutTextXY(MX0,72,'Ion storm '+NStr(number));
OutTextXY(MX0,80,StormName[number]);
SetColor(cIInfo);
OutTextXY(MX0,104,'Center:('+NStr0(x)+','+NStr0(y)+')');
OutTextXY(MX0,112,'Radius: '+NStr0(radius));
OutTextXY(MX0,128,'Heading: '+NStr0(heading));
OutTextXY(MX0,136,'Warp : '+NStr0(warp));
OutTextXY(MX0,152,'Voltage: '+NStr0(voltage)+' meV');
OutTextXY(MX0+3*8,168,'and '+IonGrow[grow]);
SetColor(IIF(voltage<50,cmIWeak,IIF(voltage<150,cmIMod,cmIDang)));
OutTextXY(MX0+3*8,160,IonLevel[Min(voltage div 50+1,5)]);
end;
if not DSdrawn then DrawPath;
ObjList;
end;
procedure WormInfo;
var w : wptr;
number : word;
begin
ClearInfo;
if ltype<>LockW then Exit;
number:=lock and LockLo;
if (number<0) or (number>199) then Exit;
w:=TTurn^.data^.worm[number];
if w<>nil then
with w^ do
begin
SetColor(White);
OutTextXY(MX0,72,'Wormhole '+NStr0(number));
SetColor(LightGray);
if when=turn then OutTextXY(MX0,80,'(now)')
else OutTextXY(MX0,80,'('+NStr(turn-when)+Proper(turn-when,' turn')+' ago)');
SetColor(cWInfo);
OutTextXY(MX0,96, 'Center:('+NStr0(x)+','+NStr0(y)+')');
OutTextXY(MX0,104,'Mass : '+NStr0(mass));
OutTextXY(MX0,112,'Radius: '+NStr0(Round( Exp(Ln(mass)*WormPower/100)/2 )));
OutTextXY(640-byte(Stability[stable,0])*8,128,Stability[stable]);
end;
ObjList;
end;
procedure UFOInfo;
var u : uptr;
number : word;
begin
ClearInfo;
if ltype<>LockU then Exit;
number:=lock and LockLo;
if (number<1) or (number>100) then Exit;
u:=TTurn^.data^.ufo[number];
if u<>nil then
with u^ do
begin
SetColor(White);
OutTextXY(MX0,72,u^.name);
SetColor(LightGray);
if when=turn then OutTextXY(MX0,80,'(now)')
else OutTextXY(MX0,80,'('+NStr(turn-when)+Proper(turn-when,' turn')+' ago)');
SetColor(cUInfo);
OutTextXY(MX0,96, 'Center:('+NStr0(x)+','+NStr0(y)+')');
OutTextXY(MX0,104,'Radius: '+NStr0(radius));
OutTextXY(MX0,112,'Visible for:');
OutTextXY(MX0,120,'ships at '+NStr0(rangeS)+' LY');
OutTextXY(MX0,128,'planets at '+NStr0(rangeP)+' LY');
if warp=0 then OutTextXY(MX0,144,'Not moving')
else begin
OutTextXY(MX0,144,'Heading: '+NStr0(heading));
OutTextXY(MX0,152,'Warp : '+NStr(warp));
end;
if RLen(info[1])+RLen(info[2])>0 then
begin
OutTextXY(MX0,168,'Information:');
SetLineStyle(SolidLn,0,NormWidth);
Line(MX0,168+8+1,MX0+12*8-3,168+8+1);
OutTextXY(MX0,180,info[1]);
OutTextXY(MX0,188,info[2]);
end;
end;
ObjList;
end;
procedure MarkInfo;
var number : word;
a : MapMark;
begin
ClearInfo;
if ltype<>LockA then Exit;
number:=lock and LockLo;
if number=0 then Exit;
a:=TTurn^.data^.mark^[number];
DrawMark(MX0+4,80+4+MarkOffsetY(a.mtype),a.color,a.mtype);
SetColor(White);
OutTextXY(MX0+18,80,'marker');
if a.bind>0 then
begin
OutTextXY(640-3*8,80,'F3');
SetColor(LightGray);
OutTextXY(640-4*8,80,'< >');
end;
SetColor(LightGray);
if a.mtype=mrkRCircle then OutTextXY(MX0,104,'Radius: '+NStr0(a.radius)) else
if a.mtype in [mrkLine,mrkDLine] then begin end
else begin
OutTextXY(MX0,104,'Text:');
SetColor(a.color);
OutTextXY(MX0,116,GetMarkText(number));
SetColor(LightGray);
if a.text<>0 then
begin
OutTextXY(MX0,136,'Alignment:');
DrawMark(MX0+5*8-1,156+4+MarkOffsetY(a.mtype),a.color,a.mtype);
SetColor(a.color);
SetTextJustify(a.xalg,a.yalg);
OutTextXY(MX0+5*8-1+(1-a.xalg)*4,156+4+(a.yalg-1)*4,'text');
SetTextJustify(LeftText,TopText);
SetColor(LightGray);
end;
end;
if a.bind<0 then OutTextXY(MX0,184,'Bound to ship '+NStr(-a.bind));
if RWMode and (turn=today) and (distlock=0) then
begin
SetColor(White);
if a.mtype=mrkRCircle then OutTextXY(MX0,104,'R') else
if a.mtype in [mrkLine,mrkDLine] then begin end
else begin
OutTextXY(MX0,104,'T');
if a.text<>0 then OutTextXY(MX0,136,'A');
end;
end;
ObjList;
end;
procedure ObjInfo (k:int);
var h : sptr;
m : mptr;
ii : iptr;
w : wptr;
u : uptr;
a : MapMark;
begin
if DSdrawn then DrawPath;
if SRdrawn then DrawShipRange;
lship:=nil;
lbase:=nil;
if k<=0 then k:=ObjN
else if k>ObjN then k:=1;
ObjL0:=(k-1) div 10;
if k<=ShipN then
begin
lock:=GoToShipXY(h,lx,ly,k) or LockS;
ltype:=LockS;
ShipInfo;
end else
if k<=MineN then
begin
lock:=GoToMinesXY(m,lx,ly,k-ShipN) or LockM;
ltype:=LockM;
MineInfo;
end else
if k<=IonN then
begin
lock:=GoToIonXY(ii,lx,ly,k-MineN) or LockI;
ltype:=LockI;
IonInfo;
end else
if k<=WormN then
begin
lock:=GoToWormXY(w,lx,ly,k-IonN) or LockW;
ltype:=LockW;
WormInfo;
end else
if k<=UfoN then
begin
lock:=GoToUfoXY(u,lx,ly,k-WormN) or LockW;
ltype:=LockU;
UFOInfo;
end
else begin
lock:=GoToMarkXY(a,lx,ly,k-UfoN) or LockA;
ltype:=LockA;
MarkInfo;
end;
end;
procedure MouseMove;
var sx,sy : int;
begin
if lock<>0 then
begin
Abs2Scr(lx,ly,sx,sy);
if (mEv0=EvMouseMove) and StickyMouse and (Abs(MouseX-sx)<2) and (Abs(MouseY-sy)<2) then
begin MoveMouseTo(sx,sy); Exit end;
if DSdrawn then DrawPath;
if SRdrawn then DrawShipRange;
ClearInfo;
lock:=0;
ltype:=0;
lship:=nil;
lplan:=nil;
lbase:=nil;
ObjN:=0; ShipN:=0; ObjL0:=0;
end;
glx:=0; gly:=0;
WriteCoord;
if dline then DrawDistLine;
if distlock<>0 then LockDistTarget(mmx,mmy);
end;
function NearestObject (var mx,my:int) : word; { sets new mx,my }
var shift : boolean;
i,n : int;
nd,dd : long;
nx,ny : int;
lck : int;
procedure Check (x,y:int);
begin
if x=-1 then Exit;
dd:=Distance2(mx,my,x,y);
if dd<nd then
begin
nd:=dd;
nx:=x; ny:=y;
n:=i or lck;
end;
end;
begin
shift:=(showM or showI or showU or showA) and ((KbdFlags and KbdShft)<>0);
n:=0;
nd:=1000000000;
with TTurn^.data^ do
begin
if not shift then
begin
lck:=LockP;
for i:=1 to 500 do Check(xyplan[i,1],xyplan[i,2]);
lck:=LockS;
if showS or showE then
for i:=1 to 999 do
with ship[i]^ do
if (ship[i]<>nil) and (when=turn) and (splan[i]=0) and
((showS and (owner=player)) or (showE and (owner<>player))) then
Check(x,y);
if distlock<0 then
begin
lck:=0; i:=distlock;
Check(dlx,dly);
end;
end;
lck:=LockM;
if showM then
for i:=1 to 500 do
with mines[i]^ do
if mines[i]<>nil then Check(x,y);
lck:=LockI;
if showI then
for i:=1 to 50 do
with ion[i]^ do
if ion[i]<>nil then Check(x,y);
lck:=LockW;
if showU then
for i:=0 to 199 do
with worm[i]^ do
if worm[i]<>nil then Check(x,y);
lck:=LockU;
if showU then
for i:=1 to 100 do
with ufo[i]^ do
if ufo[i]<>nil then Check(x,y);
lck:=LockA;
if showA then
for i:=1 to nmark do
with mark^[i] do
if (mtype<>mrkNone) and ((not shift) or (mtype=mrkRCircle)) then
begin
Check(x,y);
if (mtype in [mrkLine,mrkDLine]) then Check(x+dx,y+dy);
end;
end;
NearestObject:=n;
if n<>0 then begin mx:=nx; my:=ny end;
end;
procedure GetObjectCoord (obj:int; var lx,ly:int);
var nn,otype : int;
h : sptr;
begin
otype:=obj and LockHi;
nn:=obj and LockLo;
if obj<0 then begin lx:=dlx; ly:=dly end else
with TTurn^.data^ do
if (otype=LockA) and (nn>0) and (nn<=nmark) and (mark^[nn].mtype<>mrkNone) then
with mark^[nn] do
begin
lx:=x; ly:=y;
end else
if (otype=LockM) and (mines[nn]<>nil) then
with mines[nn]^ do
begin
lx:=x; ly:=y;
end else
if (otype=LockI) and (ion[nn]<>nil) then
with ion[nn]^ do
begin
lx:=x; ly:=y;
end else
if (otype=LockW) and (worm[nn]<>nil) then
with worm[nn]^ do
begin
lx:=x; ly:=y;
end else
if (otype=LockU) and (ufo[nn]<>nil) then
with ufo[nn]^ do
begin
lx:=x; ly:=y;
end else
if otype=LockP then
begin
lx:=xyplan[nn,1];
ly:=xyplan[nn,2];
end else
if (otype=LockS) and (ship[nn]<>nil) then
begin
h:=ship[nn];
if h<>nil then begin lx:=h^.x; ly:=h^.y end;
end
else lx:=-1;
end;
procedure MouseLtPress;
var mx,my : int;
begin
if DSdrawn then DrawPath;
if SRdrawn then DrawShipRange;
Scr2Abs(MouseX,MouseY,lx,ly);
if force=0 then lock:=NearestObject(lx,ly)
else begin
lock:=force;
force:=0;
GetObjectCoord(lock,mx,my);
if mx=-1 then lock:=0
else begin lx:=mx; ly:=my end;
end;
ltype:=lock and LockHi;
if lock>0 then
begin
InitObjList;
case ltype of
LockA : MarkInfo;
LockM : MineInfo;
LockI : IonInfo;
LockW : WormInfo;
LockU : UFOInfo;
LockP : if lbase<>nil then BaseInfo else PlanetInfo;
LockS : ShipInfo;
else begin lock:=0; ltype:=0 end;
end;
end;
if ltype<>LockS then lship:=nil;
if ltype<>LockP then lplan:=nil;
CenterMap(lx,ly,No);
if dline then DrawDistLine;
if distlock<>0 then LockDistTarget(lx,ly);
Abs2Scr(lx,ly,mx,my);
MoveMouseTo(mx,my); WriteCoord;
if mEvent<>EvLtPress then mEvent:=0;
end;
procedure MouseRtPress;
{ var h : sptr;}
var shift : boolean;
sx1,sy1,sx2,sy2,sr,ss : int;
x00,y00 : int;
enterDM : boolean;
begin
shift:=(KbdFlags and KbdShft)<>0;
if ((lock or distlock=0) and (not shift)) or (mEvent<>0) then
begin
if (MouseX>119) and (MouseX<360) and
(MouseY>119) and (MouseY<360) then Exit;
if not MapWrap then
begin
Scr2Abs(0,0,sx1,sy2);
Scr2Abs(479,479,sx2,sy1);
sr:=(sx2-sx1) div 2;
end;
ss:=IIF(mEvent<>0,20,50);
x00:=x0; y00:=y0;
if (MouseX<120) and (MapWrap or (sx1>MapX0-sr)) then dec(x0,ss);
if (MouseX>359) and (MapWrap or (sx2<MapY0+sr)) then inc(x0,ss);
if (MouseY<120) and (MapWrap or (sy2<MapY0+sr)) then dec(y0,ss);
if (MouseY>359) and (MapWrap or (sy1>MapX0-sr)) then inc(y0,ss);
if MapWrap then
begin
if x0>MapSSize then dec(x0,MapSSize);
if x0<-MapSSize then inc(x0,MapSSize*2);
if y0>MapSSize then dec(y0,MapSSize);
if y0<-MapSSize then inc(y0,MapSSize*2);
end;
if (x0=x00) and (y0=y00) then mEvent:=0
else begin
MouseX:=Min(Max(MouseX,1),478);
MouseY:=Min(Max(MouseY,1),478);
DrawMap(Yes);
MouseMove;
end;
end
else begin
enterDM:=No;
if (lock=0) and shift then
begin
if dline then DrawDistLine;
if distlock<>0 then DrawDistLock;
distlock:=-1;
Scr2Abs(MouseX,MouseY,dlx,dly);
end
else begin
if dline then DrawDistLine;
if (lock=0) or (distlock=lock) then
begin
DrawDistLock;
force:=distlock;
ForceKey:=13;
distlock:=0;
end
else begin
if distlock<>0 then DrawDistLock;
distlock:=lock;
dlx:=lx; dly:=ly;
DrawDistLock;
enterDM:=Yes;
end;
end;
if distlock=0 then Clear(483,dll-1,639,479)
else begin
SetLineStyle(SolidLn,0,ThickWidth);
SetColor(DarkGray);
dll:=468;
if (distlock>0) and (distlock and LockHi=LockS) then
begin
dlship:=TTurn^.data^.ship[distlock and LockLo]^;
if (CloakFuelBurn=0) or (dlship.mission in [7,8]) or
((IsHullFunc(dlship.hull,hfCloak)=0) and
(IsHullFunc(dlship.hull,hfAdvCloak)=0)) then dlc:=2
else if ((dlship.mission=10) or ((Race[dlship.owner]=3) and (dlship.mission=9))) then dlc:=1
else dlc:=0;
dlf:=0;
dlt:=0;
with dlship do
begin
if hull=-1 then hull:=17; {assume LSDF}
if (El=-1) and (warp>0) then El:=warp;
if (fuel=-1) and (hull<>-1) and (mass<>-1) then fuel:=mass-Hulls[hull].mass;
if (mission=-1) and (warp>0) and (enemy>=0) then
begin
ss:=warp*warp;
if (hull<>-1) and (IsHullFunc(hull,hfGravitonic)<>0) then ss:=ss*2;
wx:=Round(Sin(enemy*Pi/180.0)*ss);
wy:=Round(Cos(enemy*Pi/180.0)*ss);
mission:=0;
end;
if (mass<>-1) and (hull<>-1) and (El<>-1) and (fuel<>-1) then dll:=360;
end;
{if dlship.owner=player then dll:=360;}
{ h:=TTurn^.data^.ship[distlock and LockLo];
dlw:=h^.warp;
if (CloakFuelBurn=0) or (h^.mission in [7,8]) or
((IsHullFunc(h^.hull,hfCloak)=0) and
(IsHullFunc(h^.hull,hfAdvCloak)=0)) then dlc:=2
else if ((h^.mission=10) or ((Race[h^.owner]=3) and (h^.mission=9))) then dlc:=1
else dlc:=0;
if h^.owner=player then dll:=360;}
end;
Clear(483,354,639,479);
Line(482,dll,639,dll);
end;
if enterDM and (ltype=LockS) then
{with TTurn^.data^.ship[lock and LockLo]^ do}
with dlship do
if mission<>-1 then
begin
sx2:=x+wx; sy2:=y+wy;
MouseMove; {changes dlship.wx and wy, sets glx=gly=0}
glx:=sx2; gly:=sy2;
CenterMap(glx,gly,No);
Abs2Scr(glx,gly,sx1,sy1);
MoveMouseTo(sx1,sy1);
WriteCoord;
forceDL:=Yes; LockDistTarget(glx,gly);
end;
end;
end;
function MouseGetTarget (lcolor,lstyle:byte; ctrl:boolean) : boolean; { sets mmx,mmy }
var ch,mEv0 : word;
mdis0 : boolean;
lock0,glx0,gly0,lx0,ly0 : int;
x0,y0,x1,y1 : int;
ack : word;
procedure DrawLine;
begin
if lcolor=0 then Exit;
MouseOff;
SetWriteMode(XORPut);
SetColor(lcolor);
Line(x0,y0,x1,y1);
SetWriteMode(NormalPut);
MouseOn;
end;
procedure NewPoint;
begin
DrawLine;
WriteCoord;
x1:=MouseX; y1:=MouseY;
DrawLine;
end;
procedure LockObj;
var mx,my : int;
begin
lx:=mmx; ly:=mmy;
lock:=NearestObject(lx,ly);
Abs2Scr(lx,ly,mx,my);
MoveMouseTo(mx,my);
end;
begin
ack:=IIF(ctrl,10,13);
lock0:=lock; lock:=0;
lx0:=lx; lx:=0;
ly0:=ly; ly:=0;
glx0:=glx; glx:=0;
gly0:=gly; gly:=0;
mdis0:=MouseDisabled;
MouseDisabled:=No;
Abs2Scr(mmx,mmy,x0,y0);
SetLineStyle(lstyle,0,NormWidth);
x1:=x0; y1:=y0;
ch:=0;
DrawLine;
repeat
if KeyPressed then
begin
ch:=ReadKey;
case ch of
{left} $4B00 : if MouseX>0 then MoveMouseTo(MouseX-Max(1,ratio2 div ratio1),MouseY);
{right} $4D00 : if MouseX<479 then MoveMouseTo(MouseX+Max(1,ratio2 div ratio1),MouseY);
{up} $4800 : if MouseY>0 then MoveMouseTo(MouseX,MouseY-Max(1,ratio2 div ratio1));
{down} $5000 : if MouseY<479 then MoveMouseTo(MouseX,MouseY+Max(1,ratio2 div ratio1));
{~lt} $9B00 : if MouseX>9 then MoveMouseTo(MouseX-10,MouseY);
{~rt} $9D00 : if MouseX<470 then MoveMouseTo(MouseX+10,MouseY);
{~up} $9800 : if MouseY>9 then MoveMouseTo(MouseX,MouseY-10);
{~dn} $A000 : if MouseY<470 then MoveMouseTo(MouseX,MouseY+10);
13 : begin LockObj; if ctrl then NewPoint end;
end;
NewPoint;
if (ch<>13) and (ch<>ack) then lock:=0;
end;
if mEvent<>0 then
begin
mEv0:=mEvent; mEvent:=0;
if mEv0=EvMouseMove then begin NewPoint; lock:=0 end;
if mEv0=EvLtPress then
if (not ctrl) or (KbdFlags and KbdCtrl<>0) then ch:=ack
else begin LockObj; NewPoint end;
if mEv0=EvRtPress then ch:=27;
mEv0:=0;
end;
until (ch=ack) or (ch=27);
DrawLine;
MouseDisabled:=mdis0;
lock:=lock0;
lx:=lx0; ly:=ly0;
glx:=glx0; gly:=gly0;
MouseGetTarget:=(ch=ack);
end;
const mtype0 : MarkType = mrkFlag;
mcolor0 : byte = LightRed;
procedure SetMark;
var t : MarkType;
c : byte;
dx,dy : int;
ch : word;
a : MapMark;
s : string[4];
bind : word;
const MDX = (640-MX0) div 15;
procedure DrawS (c:byte);
var x,y : int;
begin
x:=MX0+MDX*(mcolor0-Blue);
y:=88-12+ord(mtype0)*12;
SetColor(c);
SetLineStyle(SolidLn,0,NormWidth);
Rectangle(x,y,x+MDX-1,y+11);
end;
begin
if turn<>today then Exit;
{MouseOff;} {suspendmouse;}
MouseDisabled:=True;
bind:=IIF(ltype=LockS,lock and LockLo,0);
if DSdrawn then DrawPath;
if SRdrawn then DrawShipRange;
lock:=0;
ltype:=0;
lship:=nil;
lplan:=nil;
lbase:=nil;
ClearInfo;
SetColor(White);
OutTextXY(MX0,72,'Choose marker type:');
if bind<>0 then
begin
OutTextXY(MX0,120+ord(LastMark)*12+32,'The marker will be');
OutTextXY(MX0,120+ord(LastMark)*12+32+8,'bound to ship '+NStr(bind));
end;
for t:=MarkType(ord(mrkNone)+1) to LastMark do
begin
dx:=MarkOffsetX(t);
dy:=MarkOffsetY(t);
{if t=mrkFlag then begin dx:=-1; dy:=3 end
else begin dx:=0; dy:=0 end;}
for c:=Blue to White do
DrawMark(MX0+MDX div 2+MDX*(c-Blue)+dx,88-12+6+ord(t)*12+dy,c,t);
end;
repeat
DrawS(White);
ch:=ReadKey;
DrawS(Black);
case ch of
$4B00 : begin dec(mcolor0); if mcolor0<Blue then mcolor0:=White end;
$4D00 : begin inc(mcolor0); if mcolor0>White then mcolor0:=Blue end;
$4800 : begin dec(mtype0); if mtype0=mrkNone then mtype0:=LastMark end;
$5000 : begin inc(mtype0); if mtype0>LastMark then mtype0:=MarkType(ord(mrkNone)+1) end;
end;
until (ch=13) or (ch=27);
{resumemouse;} {MouseOff;}
if ch=13 then
begin
a.x:=mmx;
a.y:=mmy;
a.mtype:=mtype0;
a.color:=mcolor0;
a.bind:=-bind;
a.text:=0;
if mtype0=mrkRCircle then
begin
SetColor(White);
OutTextXY(MX0,88+ord(LastMark)*12+16,'Radius (LY):');
SetColor(LightGray);
OutTextXY(MX0+13*8,88+ord(LastMark)*12+16,NStr0(radius0));
s:=GetStr(MX0+13*8,88+ord(LastMark)*12+16,4);
if GetStrKey<>13 then a.mtype:=mrkNone
else begin
a.radius:=Value(s);
if (a.radius<0) and (radius0=0) then a.mtype:=mrkNone else
if a.radius=0 then a.radius:=radius0 else radius0:=a.radius;
end;
end else
if mtype0 in [mrkLine,mrkDLine] then
begin
SetColor(White);
OutTextXY(MX0,88+ord(LastMark)*12+16,'Move cursor to the');
OutTextXY(MX0,88+ord(LastMark)*12+24,'end point and use');
OutTextXY(MX0,88+ord(LastMark)*12+32,'Ctrl-click or');
OutTextXY(MX0,88+ord(LastMark)*12+40,'Ctrl-Enter');
if not MouseGetTarget(mcolor0,IIF(mtype0=mrkLine,SolidLn,DashedLn),Yes) then a.mtype:=mrkNone
else begin
dx:=mmx; dy:=mmy;
if MapWrap then WrapWayPoint(a.x,a.y,dx,dy);
a.dx:=dx-a.x;
a.dy:=dy-a.y;
end;
end;
if a.mtype<>mrkNone then
begin
lock:=CreateMark(a) or LockA;
ltype:=LockA;
if lock and LockLo=0 then
begin
ClearInfo;
SetColor(LightRed);
OutTextXY(MX0,72,'No more markers');
OutTextXY(MX0,80,' available!');
end
else begin
DataChg:=Yes;
DrawMap(No);
end;
end;
end;
if lock and LockLo=0 then begin lock:=0; ltype:=0 end;
if lock=0 then begin ClearInfo; ObjList end
else begin
lx:=mmx; ly:=mmy;
InitObjList;
MarkInfo;
end;
MouseDisabled:=False;
{MouseOn;}
end;
procedure ClearMark;
var i,xx,yy : int;
s : string[1];
begin
if (turn<>today) or (ltype<>LockA) then Exit;
i:=lock and LockLo;
with TTurn^.data^.mark^[i] do
begin
if bind>0 then Exit;
{MouseOff;}
EraseMark(i);
DataChg:=Yes;
MouseMove;
end;
DrawMap(Yes);
InitObjList; ObjList;
{MouseOn;}
end;
procedure AssignMarkText;
var s0 : string;
s : str20;
number : word;
begin
if (turn<>today) or (ltype<>LockA) then Exit;
number:=lock and LockLo;
with TTurn^.data^ do
begin
if mark^[number].mtype in [mrkRCircle..mrkDLine] then Exit;
{MouseOff;}
MouseDisabled:=True;
s0:=GetMarkText(number);
{Clear(MX0,116,639,116+7);}
s:=GetStr(MX0,116,20);
{MouseOff;}
if (GetStrKey<>27) and (s<>s0) then
begin
if mark^[number].text=0 then
begin
mark^[number].xalg:=MarkXAlg;
mark^[number].yalg:=MarkYAlg;
end;
SetMarkText(number,s);
DrawMap(Yes);
MarkInfo;
DataChg:=Yes;
end
else begin
Clear(MX0,116,639,116+7);
SetColor(mark^[number].color);
OutTextXY(MX0,116,s0);
end;
MouseDisabled:=False;
{MouseOn;}
end;
end;
procedure MarkAlignment;
var number : word;
a : MapMark;
xa,ya : byte;
ch : word;
procedure DrawA (c:byte);
begin
SetColor(c);
SetTextJustify(xa,ya);
OutTextXY(MX0+5*8-1+(1-xa)*4,156+4+(ya-1)*4,'text');
SetTextJustify(LeftText,TopText);
end;
begin
if (turn<>today) or (ltype<>LockA) then Exit;
number:=lock and LockLo;
a:=TTurn^.data^.mark^[number];
if a.mtype in [mrkRCircle..mrkDLine] then Exit;
if a.text=0 then Exit;
{MouseOff;}
MouseDisabled:=True;
SetColor(Yellow);
OutTextXY(640-2*8,156-8,#24);
OutTextXY(640-3*8,156,#27' '#26);
OutTextXY(640-2*8,156+8,#25);
xa:=a.xalg; ya:=a.yalg;
repeat
DrawA(a.color);
ch:=ReadKey;
DrawA(Black);
case ch of
$4B00 : begin inc(xa); if (xa=1) and (ya=1) then inc(xa); if xa>2 then xa:=0 end;
$4D00 : begin dec(xa); if (xa=1) and (ya=1) then dec(xa); if xa>2 then xa:=2 end;
$4800 : begin dec(ya); if (xa=1) and (ya=1) then dec(ya); if ya>2 then ya:=2 end;
$5000 : begin inc(ya); if (xa=1) and (ya=1) then inc(ya); if ya>2 then ya:=0 end;
end;
until (ch=13) or (ch=27);
{MouseOff;}
if ch=27 then begin xa:=a.xalg; ya:=a.yalg end;
Clear(640-3*8,156-8,639,156+8+7);
DrawA(a.color);
if (xa<>a.xalg) or (ya<>a.yalg) then
with TTurn^.data^.mark^[number] do
begin
xalg:=xa;
yalg:=ya;
MarkXAlg:=xalg;
MarkYAlg:=yalg;
DataChg:=Yes;
DrawMap(Yes);
end;
MouseDisabled:=False;
{MouseOn;}
end;
procedure SetMarkRadius;
var number : word;
a : MapMark;
s : string[4];
begin
if (turn<>today) or (ltype<>LockA) then Exit;
number:=lock and LockLo;
a:=TTurn^.data^.mark^[number];
if a.mtype<>mrkRCircle then Exit;
{MouseOff;}
MouseDisabled:=True;
{Clear(MX0+8*8,104,639,104+7);}
s:=GetStr(MX0+8*8,104,4);
{MouseOff;}
if GetStrKey=13 then
begin
a.radius:=Value(s);
if (a.radius>0) or (radius0>0) then
begin
if a.radius>0 then radius0:=a.radius else a.radius:=radius0;
TTurn^.data^.mark^[number].radius:=a.radius;
DataChg:=Yes;
DrawMap(Yes);
end;
end;
MarkInfo;
MouseDisabled:=False;
{MouseOn;}
end;
{procedure NextPoint;
var h : sptr;
d,dd : int;
mx,my : int;
begin
if ((dlx=mmx) and (dly=mmy)) or (dlw=0) then Exit;
mx:=mmx; my:=mmy;
if MapWrap then WrapWayPoint(dlx,dly,mx,my);
if (dlx=mx) and (dly=my) then Exit;
h:=TTurn^.data^.ship[Abs(distlock) and LockLo];
if (h=nil) or (h^.warp=-1) then Exit;
dd:=Trunc(Sqrt(Distance2(dlx,dly,mx,my)));
d:=dlw*dlw;
if IsHullFunc(h^.hull,hfGravitonic)<>0 then d:=d*2;
DrawDistLine;
DrawDistLock;
if dd<=d then
begin dlx:=mx; dly:=my end
else begin
dlx:=dlx+Round((mx-dlx)/dd*d);
dly:=dly+Round((my-dly)/dd*d);
end;
if MapWrap then WrapXY(dlx,dly);
if distlock>0 then begin dlf:=0; dlt:=0 end;
inc(dlf,dlf0); inc(dlt);
distlock:=-Abs(distlock);
if Gravity and (dlw>1) then
begin
Location(dlx,dly);
if LocationPlanet<>0 then
begin
dlx:=LocationX;
dly:=LocationY;
force:=LocationPlanet or LockP;
ForceKey:=13;
Exit;
end;
end;
LockDistTarget(mmx,mmy);
end;}
procedure NextPoint;
var mx,my : int;
f0 : int;
begin
if ((dlx=mmx) and (dly=mmy)) or (dlship.warp<1) then Exit;
mx:=mmx; my:=mmy;
if MapWrap then WrapWayPoint(dlx,dly,mx,my);
if (dlx=mx) and (dly=my) then Exit;
DrawDistLine;
DrawDistLock;
dlship.wx:=mx-dlx;
dlship.wy:=my-dly;
f0:=dlship.fuel;
CalcMove(dlship,Yes);
if MapWrap then WrapXY(dlship.x,dlship.y);
dlx:=dlship.x;
dly:=dlship.y;
inc(dlf,f0-dlship.fuel);
inc(dlt);
distlock:=-Abs(distlock);
LocationPlanet:=PSearchXY(dlx,dly);
if LocationPlanet<>0 then { CalcMove calls Location() }
begin
force:=LocationPlanet or LockP;
ForceKey:=13;
Exit;
end;
LockDistTarget(mmx,mmy);
end;
procedure AlignWayPoint;
var h : sptr;
number : word;
px,py : int;
dx,dy : int;
dl : long;
nomore : boolean;
function Check : boolean;
var x,y : int;
d : long;
begin
Check:=No;
x:=glx+dx;
y:=gly+dy;
d:=Distance2(dlx,dly,x,y);
if d>=dl then Exit;
if RoundWells and (Distance2(px,py,x,y)<=GravityRange*GravityRange) or
(not RoundWells) and (Abs(px-x)<=GravityRange) and (Abs(py-y)<=GravityRange) then
begin
Check:=Yes;
inc(glx,dx);
inc(gly,dy);
end;
end;
begin
if (turn<>today) or (distlock=0) or (not Gravity) or (ltype<>LockP) then Exit;
with TTurn^.data^ do
begin
px:=xyplan[lock and LockLo,1];
py:=xyplan[lock and LockLo,2];
end;
MouseMove;
glx:=lx; gly:=ly;
if MapWrap then
begin
WrapWayPoint(dlx,dly,px,py);
WrapWayPoint(dlx,dly,glx,gly);
end;
repeat
nomore:=Yes;
dl:=Distance2(dlx,dly,glx,gly);
for dx:=-2 to 2 do
begin
for dy:=-2 to 2 do
if Check then begin nomore:=No; Break end;
if not nomore then Break;
end;
until nomore;
if MapWrap then WrapXY(glx,gly);
Abs2Scr(glx,gly,px,py);
MoveMouseTo(px,py);
WriteCoord;
LockDistTarget(glx,gly);
end;
procedure SetWayPoint;
var h : sptr;
dl : single;
mx,my : int;
l : long;
number : word;
cloaked : boolean;
begin
if (turn<>today) or (distlock<0) or (distlock and LockHi<>LockS) then Exit;
number:=distlock and LockLo;
h:=TTurn^.data^.ship[number];
if (h=nil) or (h^.owner<>player) or (h^.when<>turn) then Exit;
if Gravity and AutoUseGravity and (h^.warp<>1) and
((not HyperDrive) or (IsHullFunc(h^.hull,hfHyperDrive)=0) or (h^.fcode<>'HYP')) then
begin
Location(h^.x,h^.y);
if LocationPlanet<>lock and LockLo then AlignWayPoint;
end;
if lock or glx or gly=0 then begin MouseMove; mx:=mmx; my:=mmy end
else if lock<>0 then begin mx:=lx; my:=ly; MouseMove end
else begin mx:=glx; my:=gly; MouseMove end;
with h^ do
begin
if MapWrap then WrapWayPoint(x,y,mx,my);
dl:=Sqrt(Distance2(x,y,mx,my));
if dl>3000 then
begin
l:=mx-x; mx:=x+Trunc(l*3000/dl);
l:=my-y; my:=y+Trunc(l*3000/dl);
end;
cloaked:=(mission=10) or ((player=3) and (mission=9));
if (x+wx<>mx) or (y+wy<>my) or (warp<>dlship.warp) or ( (dlc=1) xor cloaked ) then
begin
wx:=mx-x;
wy:=my-y;
warp:=dlship.warp;
if warp=0 then warp:=El;
if (dlc=1) and (not cloaked) then mission:=IIF(player=3,9,10) else
if (dlc=0) and cloaked then mission:=5;
ChangeData(Sh,number);
end;
MouseRtPress;
if showT then DrawMap(Yes);
force:=number or LockS;
ForceKey:=13;
end;
end;
procedure SetTaxes (nat:boolean; var tax:int); { M.O.T. }
var y,tax0 : int;
ch : word;
begin
if (lplan=nil) or (lplan^.when<>today) or (nat and (lplan^.Nrace=0)) then Exit;
{MouseOff;}
MouseDisabled:=True;
SetLineStyle(SolidLn,0,NormWidth);
y:=IIF(nat,168,200);
Clear(MX0+11*8,y,639,y+7);
tax0:=tax;
repeat
WriteHChange(nat);
Clear(MX0+8*8,y,MX0+12*8-1,y+7);
WriteTaxes(tax,y);
repeat ArrowBlink(624,y) until KeyPressed;
ch:=ReadKey;
case ch of
$4B00 : if tax>0 then
begin
if KbdFlags and KbdShft=0 then dec(tax) else tax:=0;
WriteIncome;
end;
$4D00 : if tax<100 then
begin
if KbdFlags and KbdShft=0 then inc(tax) else tax:=100;
WriteIncome;
end;
$7300 : if tax>=10 then
begin
dec(tax,10);
WriteIncome;
end;
$7400 : if tax<=90 then
begin
inc(tax,10);
WriteIncome;
end;
$3B00 : begin
helpscr:=5;
Help;
helpscr:=0;
DrawMap(Yes);
end;
end;
until (ch=13) or (ch=27);
{if ch=27 then tax:=tax0;}
if tax<>tax0 then ChangeData(Pl,lock and LockLo);
Clear(MX0+8*8,y,639,y+7);
WriteHChange(nat);
WriteTaxes(tax,y);
SetColor(White);
if nat then OutTextXY(MX0+8,168,'T')
else OutTextXY(MX0+24,200,'x');
WriteIncome;
MouseDisabled:=False;
{MouseOn;}
end;
{procedure FindFirst;
var i,k,sx,sy : int;
p : pptr;
l : long;
begin
k:=0; l:=0;
for i:=1 to 500 do
begin
p:=TTurn^.data^.planet[i];
if (p<>nil) and (p^.when=turn) and
(p^.owner=player) and (p^.colonists>l) then
begin k:=i; l:=p^.colonists end;
end;
l:=0;
for i:=1 to 500 do
begin
p:=TTurn^.data^.planet[i];
if (p<>nil) and (p^.when=turn) and (p^.owner=player) and
(TTurn^.data^.eplan[i].activity and EP_Base<>0) and (p^.colonists>l) then
begin k:=i; l:=p^.colonists end;
end;
if k=0 then Exit;
Abs2Scr(Planets[k].x,Planets[k].y,sx,sy);
MoveMouseTo(sx,sy);
end;}
{$IFDEF DEBUG}
procedure TurnsInMemory;
var y,i : int;
t : tptr;
m : long;
begin
MouseMove;
WriteFreeMem;
ClearInfo;
SetColor(White);
OutTextXY(MX0,72,'Turns in memory:');
y:=88;
t:=TRoot;
while t<>nil do
begin
if t^.data<>nil then
begin
m:=SizeOf(TurnData);
with t^.data^ do
begin
for i:=1 to 999 do
begin
if (i<=500) and (planet[i]<>nil) then inc(m,SizeOf(PRec));
if (i<=500) and (base[i]<>nil) then inc(m,SizeOf(BRec));
if ship[i]<>nil then inc(m,SizeOf(SRec));
if (i<=500) and (mines[i]<>nil) then inc(m,SizeOf(MRec));
if (i<=50) and (ion[i]<>nil) then inc(m,SizeOf(IRec));
end;
inc(m,nmark*SizeOf(MapMark));
inc(m,mtsize);
end;
OutTextXY(MX0,y,'turn '+NStr(t^.turn)+' = '+NStr(m));
inc(y,8);
end;
t:=t^.next;
end;
OutTextXY(MX0,y+8,'MaxAvail = '+NStr0(MaxAvail));
end;
{$ENDIF}
procedure ResetMouseAndVideo;
begin
MouseMove;
asm
mov ax,3
int 10h
mov ax,12h
int 10h
end;
ResetMouse;
DrawRightScreen;
DrawMap(Yes);
end;
procedure Main;
begin
mt0:=Timer;
LastActivityTime:=mt0;
repeat
if (ForceKey<>0) or KeyPressed then
begin
if ForceKey<>0 then begin ch:=ForceKey; ForceKey:=0 end
else ch:=ReadKey;
if MousePresent and (lock<>0) and (distlock=0) then
case ch of
$4800 : ch:=$8D00; { Up -> ^Up }
$5000 : ch:=$9100; { Dn -> ^Dn }
$4B00 : ch:=$7300; { Lt -> ^Lt }
$4D00 : ch:=$7400; { Rt -> ^Rt }
end;
case ch of
{esc} 27 : MouseMove;
{left} $4B00 : if MouseX>0 then begin MoveMouseTo(MouseX-Max(1,ratio2 div ratio1),MouseY); MouseMove end;
{right} $4D00 : if MouseX<479 then begin MoveMouseTo(MouseX+Max(1,ratio2 div ratio1),MouseY); MouseMove end;
{up} $4800 : if MouseY>0 then begin MoveMouseTo(MouseX,MouseY-Max(1,ratio2 div ratio1)); MouseMove end;
{down} $5000 : if MouseY<479 then begin MoveMouseTo(MouseX,MouseY+Max(1,ratio2 div ratio1)); MouseMove end;
{~lt} $9B00 : if MouseX>9 then begin MoveMouseTo(MouseX-10,MouseY); MouseMove end;
{~rt} $9D00 : if MouseX<470 then begin MoveMouseTo(MouseX+10,MouseY); MouseMove end;
{~up} $9800 : if MouseY>9 then begin MoveMouseTo(MouseX,MouseY-10); MouseMove end;
{~dn} $A000 : if MouseY<470 then begin MoveMouseTo(MouseX,MouseY+10); MouseMove end;
{^up} $8D00 : if ObjN>0 then ObjInfo(Obj0-1);
{^dn} $9100 : if ObjN>0 then ObjInfo(Obj0+1);
{^lt} $7300 : if (ltype=LockS) and showS then NextShip(-1)
else if ltype=LockP then
if lbase=nil then NextPlanet(-1) else NextBase(-1)
else if (ltype=LockM) and showM then NextMines(-1)
else if (ltype=LockI) and showI then NextIon(-1)
else if (ltype=LockW) and showU then NextWorm(-1)
else if (ltype=LockU) and showU then NextUFO(-1);
{^rt} $7400 : if (ltype=LockS) and showS then NextShip(1)
else if ltype=LockP then
if lbase=nil then NextPlanet(1) else NextBase(1)
else if (ltype=LockM) and showM then NextMines(1)
else if (ltype=LockI) and showI then NextIon(1)
else if (ltype=LockW) and showU then NextWorm(1)
else if (ltype=LockU) and showU then NextUFO(1);
{enter} 13 : MouseLtPress;
{^ent} 10 : if RWMode then SetWayPoint;
{space} ord(' '): MouseRtPress;
{tab} 9 : Zoom(1);
{_tab} $0F00 : Zoom(255);
{^tab} $9400 : Zoom(0);
{~1..0} $7800,$7900,$7A00,$7B00,$7C00,$7D00,$7E00,$7F00,$8000,$8100 :
SetScreenPos(Hi(ch)-$77);
{-} ord('-'): TimeShift(-1);
{+} ord('+'): TimeShift(1);
{^-} $8E00 : if turn<>TRoot^.turn then begin SetTurn(TRoot^.turn); TimeShift(0) end;
{^+} $9000 : if turn<>today then begin SetTurn(today); TimeShift(0) end;
{0..9} ord('0')..ord('9'):
if (turn=today) and (Abs(distlock) and LockHi=LockS) then
begin {dlw}dlship.warp:=ch-ord('0'); forceDL:=Yes; LockDistTarget(mmx,mmy) end
else ObjInfo(ObjL0*10+IIF(ch=ord('0'),ord('9')+1,ch)-ord('0'));
{pgup} $4900 : if ObjL0>0 then
begin
dec(ObjL0);
ObjInfo(Max(Obj0-10,1));
end;
{pgdn} $5100 : if (ObjN>0) and (ObjL0<(ObjN-1) div 10) then
begin
inc(ObjL0);
ObjInfo(Min(Obj0+10,ObjN));
end;
{ins} $5200 : if showA then SetMark;
{del} $5300 : if ltype=LockA then ClearMark;
{home} $4700 : if (lbase<>nil) and (BL0>BL1) then begin dec(BL0,BL2-BL1+8); BaseStorage end
else
if (ltype=LockS) and (lship^.hull=-1) and
eAllH and AllH and (ScanH>1) then
begin dec(ScanH); HullTypes end;
{end} $4F00 : if (lbase<>nil) and bOver then begin inc(BL0,BL2-BL1+8); BaseStorage end
else
if (ltype=LockS) and (lship^.hull=-1) and
eAllH and AllH and hOver then
begin inc(ScanH); HullTypes end;
{_a} ord('A'): begin showA:=not showA; WriteShows; MouseMove; DrawMap(not showA) end;
{~a} $1E00 : if showA then begin
CurMarkMask := (CurMarkMask+1) mod (LastMarkMask+1);
DrawMap(Yes);
end;
{_e} ord('E'): begin showE:=not showE; WriteShows; MouseMove; DrawMap(No) end;
{_i} ord('I'): begin showI:=not showI; WriteShows; MouseMove; DrawMap(No) end;
{_m} ord('M'): begin showM:=not showM; WriteShows; MouseMove; DrawMap(No) end;
{_p} ord('P'): begin showP:=not showP; WriteShows; MouseMove;
if ratioN>=PNRatio then DrawMap(not showP) end;
{_s} ord('S'): begin showS:=not showS; WriteShows; MouseMove; DrawMap(No) end;
{_t} ord('T'): begin showT:=not showT; WriteShows; MouseMove; DrawMap(No) end;
{_u} ord('U'): begin showU:=not showU; WriteShows; MouseMove; DrawMap(No) end;
{_r} ord('R'): ResetMouseAndVideo;
{a} ord('a'): if RWMode and (ltype=LockP) and (lplan<>nil) and (lbase=nil) then BuildStructures(_Factory)
else if (ltype=LockS) and (lship^.hull=-1) and
(lship^.mass<>-1) and eAllH then
begin AllH:=not AllH; HullTypes end
else if (ltype=LockA) and RWMode and (turn=today) and
(distlock=0) then MarkAlignment;
{b} ord('b'): if (ltype=LockS) and (splan[lock and LockLo]<>0) then
begin
force:=splan[lock and LockLo];
lbase:=TTurn^.data^.base[force];
force:=force or LockP;
MouseLtPress;
end
else if ltype=LockP then
if RWMode and (TTurn^.data^.eplan[lock and LockLo].activity and EP_Base=0) then BuildBase
else if RWMode and (lplan^.build=1) then CancelBase
else if lbase=nil then BaseInfo else Exit;
{c} ord('c'): if RWMode and (turn=today) then
if (ltype=LockS) and (distlock=0) then TransferCargo(Pl)
else if (Abs(distlock) and LockHi=LockS) and (dlc<>2) then
begin dlc:=dlc xor 1; forceDL:=Yes; LockDistTarget(mmx,mmy) end
else if (ltype=LockP) and (lbase<>nil) and
(CheckClone(lock and LockLo)>=0) and BuildClone then Exit;
{d} ord('d'): if RWMode and (ltype=LockP) and (lplan<>nil) then
if lbase=nil then BuildStructures(_Defense) else IncreaseBaseDefense;
{e} ord('e'): if RWMode and (distlock=0) and (ltype=LockS) then SetEnemy;
{f} ord('f'): if RWMode and (ltype=LockP) and (lplan<>nil) then
if lbase=nil then SetFCode(Pl,No) else FixOrRecycle(1)
else if (ltype=LockS) then
if (lship^.hull<>-1) and (lship^.owner<>player) and
(not IsData[lship^.owner]) then ForgetShip
else if RWMode and (distlock=0) and
(lship^.owner=player) then SetFCode(Sh,No);
{^f} 6 : if RWMode and ((ltype=LockP) or (ltype=LockS)) then
if (ltype=LockP) and (lplan<>nil) and (lbase=nil) then SetFCode(Pl,No)
else if (distlock=0) and (lship<>nil) and (lship^.owner=player) then SetFCode(Sh,No);
{g} ord('g'): AlignWayPoint;
{h} ord('h'): if (ltype=LockS) and (lship^.hull=-1) and (lship^.mass<>-1) then InputHull;
{^h} 8 : if KbdFlags and KbdCtrl<>0 then DrawHYPCircles;
{i} ord('i'): if RWMode and (turn=today) and (distlock=0) and (ltype=LockS) and (PlanN<>0) and
((lship^.damage>0) or (lship^.crew<>Hulls[lship^.hull].crew)) then
FixOrRecycleShip(PlanN,1,lock and LockLo);
{l} ord('l'): if RWMode and (distlock=0) and (ltype=LockS) then LoadForBuild;
{m} ord('m'): if RWMode and (ltype=LockP) and (lplan<>nil) and (lbase=nil) then BuildStructures(_Mine)
else if RWMode and (distlock=0) and (ltype=LockS) then SetMission;
{n} ord('n'): if Abs(distlock) and LockHi=LockS then NextPoint
else if RWMode and (distlock=0) and (ltype=LockS) then SetName;
{o} ord('o'): if RWMode and (ltype=LockP) and (lbase<>nil) then SetBaseOrder;
{p} ord('p'): if (lock>0) and (PlanN<>0) then
begin lbase:=nil; force:=PlanN or LockP; MouseLtPress end;
{~p} $1900 : if RWMode then ChangePassword;
{r} ord('r'): if RWMode and (ltype=LockP) and (lplan<>nil) then
if lbase=nil then SetFCode(Pl,Yes) else FixOrRecycle(2)
else if RWMode and (ltype=LockS) and
(lship<>nil) and (distlock=0) then SetFCode(Sh,Yes)
else if (ltype=LockA) and RWMode and (turn=today) and
(distlock=0) then SetMarkRadius;
{^r} 18 : if RWMode and ((ltype=LockP) or (ltype<=LockS)) then
if (ltype=LockP) and (lplan<>nil) and (lbase=nil) then SetFCode(Pl,Yes)
else if (distlock=0) and (lship<>nil) and (lship^.owner=player) then SetFCode(Sh,Yes);
{~r} $1300 : if RWMode and (ltype=LockP) and (lplan<>nil) and (lbase=nil) then RandAllPCodes;
{s} ord('s'): if RWMode and (ltype=LockP) and (lplan<>nil) and (lbase=nil) then SellSupp;
{t} ord('t'): if (ltype=LockP) and (lplan<>nil) then
begin
if lbase<>nil then begin if RWMode then UpgradeBaseTech end
else
if RWMode and (turn=today) and (lplan^.owner=player)
then SetTaxes(Yes,lplan^.Ntax)
else CalcTaxes;
end
else if (ltype=LockA) and RWMode and (turn=today) and
(distlock=0) then AssignMarkText
else if RWMode and (turn=today) and (distlock=0) and
(ltype=LockS) and
(ShipN>1) then TransferCargo(Sh);
{^t} 20 : if (ltype=LockP) and (lplan<>nil) and (lbase=nil) then CalcTaxes;
{$IFDEF DEBUG}
{~t} $1400 : TurnsInMemory;
{$ENDIF}
{u} ord('u'): if RWMode and (distlock=0) and (ltype=LockS) then UnloadShip(lock and LockLo);
{~u} $1600 : if RWMode and (ltype=LockP) and (lplan<>nil) and (lbase=nil) then UnloadAllShips;
{w} ord('w'): if RWMode and (distlock=0) and (ltype=LockS) then SetWarp;
{x} ord('x'): if (ltype=LockP) and (lplan<>nil) and (lbase=nil) then
if RWMode and (turn=today) and (lplan^.owner=player)
then SetTaxes(No,lplan^.Ctax);
{~x} $2D00 : Exit;
{y} ord('y'): if RWMode then
if (distlock=0) and (ltype=LockS) then BuyShipTF
else if (ltype=LockP) and (lbase<>nil) then BuyBaseTF;
{z} ord('z'): CenterMap(mmx,mmy,Yes);
{f1} $3B00 : Exit;
{_f1 $5400 : Exit;}
{^f1 $5E00 : ShipList;}
{f2} $3C00 : Exit;
{f3} $3D00 : Exit;
{_f3} $5600 : if RWMode and (lock<>0) then Exit;
{f4} $3E00 : Exit;
{~f4} $6B00 : Exit;
{f5} $3F00 : Exit;
{f6 is reserved for planet sim}
{f7} $4100 : FindPlanet;
{_f7} $5A00 : FindShip;
{f8 $4200 : if (ltype=LockP) or (ltype=LockS) then Exit;}
{f9} $4300 : DrawUserCircle;
{_f9} $5C00 : DrawMineCircle;
{f10} $4400 : Exit;
end;
LastActivityTime:=Timer;
end;
while mEvent<>0 do
begin
ch:=0;
mEv0:=mEvent; mEvent:=0;
if AutoScroll and
((MouseX<2) or (MouseX>477) or (MouseY<2) or (MouseY>477)) then
begin mEv0:=EvRtPress; mEvent:=EvRtPress end;
if (mEv0<>EvMouseMove) and (mEvent=0) then MouseOff;
case mEv0 of
EvMouseMove : if (Timer<mt0) or (Timer>=mt0+5) then MouseMove;
EvLtPress : begin
if RWMode and
( (KbdFlags and KbdCtrl<>0) or
((Timer>=mt1) and (Timer<=mt1+5)) )
then begin SetWayPoint; mEvent:=0 end
else MouseLtPress;
mt0:=Timer;
mt1:=mt0;
end;
EvRtPress : if (Timer<mt0) or (Timer>=mt0+2) then
begin MouseRtPress; mt0:=Timer end;
EvCtPress : begin
if KbdFlags and KbdShft<>0 then Zoom(255) else
if KbdFlags and KbdCtrl<>0 then Zoom(0) else Zoom(1);
mt0:=Timer
end;
end;
if (mEv0<>EvMouseMove) and (mEvent=0) then MouseOn;
mEv0:=0;
LastActivityTime:=Timer;
end;
if (ScreenSaverTime>0) and (Timer>LastActivityTime+ScreenSaverTime) then
begin ch:=13; Exit end;
until False;
end;
End.