program SPACE_ADVENTURE;

                     (****** UNIT SPECIFICATIONS ******)
uses
	Crt,Graph3,Graph,Globals,Title,Ending,Evalu,Misc;

                (**** PROCEDURE AND FUNCTION DECLARATIONS ****)

																						 (***** MESSAGE PROCESSING *****)
procedure Message (Txt:Str80);
begin
  SetColor(3);
  SetTextJustify (CenterText,BottomText);
  OutTextXY (160,166,Txt);
  SetTextJustify (LeftText,TopText);
  SetColor(0);
end;

procedure ClearMessage;
begin
  Black (1,159,318,168);
end;

                                         (**** WEAPON & LIFE SUPPORT ****)
procedure DrawBar (Length,Ypos:word; Danger:boolean);
begin
  SetLineStyle (0,0,ThickWidth);
  MoveTo (0,Ypos);
  if Danger then begin
    SetColor(2);
    if Length>0 then Line(0,Ypos,Lowest(40,Length),Ypos);
    MoveTo(Lowest(40,Length),Ypos);
  end;
  if Length>GetX then begin
    SetColor(3);
    Line (GetX,Ypos,Length,Ypos);
  end;
  SetLineStyle (0,0,NormWidth);
  SetColor(0);
end;

procedure UsePpack (var Support:integer; Ypos:word);
begin
  if Ppacks>0 then begin
    Support:=Lowest(300,Support+230);
    for Ctr:=1 to 700 do Sound (Ctr*2);     { Whoooouuuuiiiiiipp (!) }
    NoSound;
    DrawBar (Support,Ypos,Ypos=178);
    Black (255+Ppacks*10,146,260+Ppacks*10,152);
    Dec (Ppacks);             { Packs used is a penalty when calculating }
    Inc (PpacksUsed);         { the total score }
  end;
end;

procedure DecSupport (var Support:integer; Penalty,Ypos:word);
var NewSupp:integer;
begin
  NewSupp:=Support-Penalty;
  if NewSupp<0 then NewSupp:=0;
  Black (NewSupp,Ypos-1,Support,Ypos+1);
  Support:=NewSupp;
end;

procedure SelectWeapon (NewWeapon:WeapTyp);
begin
  if NewWeapon<>Weapon then begin
    SetColor(1); TextSize (9,10,4,5);
    Black (0,181+(Ord(Weapon)*10),34,185+(Ord(Weapon)*10));
    if Weapon=Phaser then begin
                            OutTextXY(0,179,'PHASER');
                            BulSound := 600;
                          end
                     else begin
                            OutTextXY(0,189,'BLASTER');
                            BulSound := 90;
                          end;
    Weapon:=NewWeapon;
    SetFillStyle (1,3); SetColor (0);
    Bar (0,181+(Ord(Weapon)*10),34,185+(Ord(Weapon)*10));
    if Weapon=Phaser then OutTextXY(0,179,'PHASER')
                     else OutTextXY(0,189,'BLASTER');
    TextSize(1,1,1,1);
  end;
end;
                                            (***** LOAD ICONS *****)
procedure LoadIcons;
var
  Ctr,Ctr2,Size:integer;
  X,x1,Y,y1,d:byte;
  FilVar:file of byte;
begin
  Assign (FilVar,SAdir+'ICONS.DAT');
	Reset (FilVar);
	for Ctr:=1 to NoofIcons do begin
		for Ctr2:=1 to 4 do
			Read (FilVar,Icon[Ctr,Ctr2]);
		Size:=ImageSize(0,0,Icon[Ctr,2]*256+Icon[Ctr,1],Icon[Ctr,4]*256+Icon[Ctr,3]);
		for Ctr2:=5 to Size do begin        { Icons are of variable sizes, }
			Read (FilVar,Icon[Ctr,Ctr2]);     { therefore the complicated stuff }
		end;
	end;
  Close (FilVar);
end;
																				 (***** LOAD SHIP & PUT ObjektS ****)
procedure PutObjekt(Obj:byte);
var
  l,x,y,Room:byte;
  Found:boolean;
begin
  if Obj>=Crystal then repeat
    Room:=Random(10)+1;
    l:=OneWay[Room,1]; x:=OneWay[Room,2]; y:=OneWay[Room,3];
	until (Ship[l,x,y].Objekt=0)
  else repeat
    l:=Random(3)+1; x:=Random(13)+2; y:=Random(3)+1;
    with Ship[l,x,y] do
			Found:=not ((Objekt>0) or
                 ((x>3) and (x<9) and (y<>2)) or
                 ((x=12) and (y=2)));
  until Found;
	Ship[l,x,y].Objekt:=Obj;
end;

procedure InitShip;
begin
  Assign (ShipFile,SAdir+'SHIP.DAT');
  Reset (ShipFile);
  Read (ShipFile, Ship);
  Close (ShipFile);
	for Ctr:=0 to 3 do begin      { Put the 'takeable' Objekts at random }
		PutObjekt(Key+Ctr);
		PutObjekt(Crystal+Ctr);
  end;
  for Ctr:=1 to 13+Skill*2 do
		PutObjekt(Ppack);
end;
                                                  (***** MAP PROCESSING *****)
procedure UpdateMap (l,x,y:byte; Outstand:boolean);
var Rx,Ry:word;

  procedure Tri(Typ:byte);
  begin
    case Typ of
      1: begin MoveTo(Rx,Ry+3); LineRel(3,-3); LineRel (0,6); LineRel (-3,-3);
           MoveRel(1,0); LineRel(1,1); LineRel(0,-2); end;
      2: begin MoveTo(Rx+4,Ry+3); LineRel(2,-2); LineRel (0,4); LineRel (-1,-1);
           LineRel(0,-1); end;
      3: begin MoveTo(Rx+1,Ry+6); LineRel(5,-5); LineRel (0,5); LineRel (-4,0);
           LineRel(3,-3); LineRel(0,2); LineRel(-1,0); end;
      4: begin MoveTo(Rx+5,Ry+6); LineRel(-5,-5); LineRel (0,5); LineRel (4,0);
           LineRel(-3,-3); LineRel(0,2); LineRel(1,0); end;
      5: begin MoveTo(Rx+5,Ry); LineRel(-5,5); LineRel (0,-5); LineRel (4,0);
           LineRel(-3,3); LineRel(0,-2); LineRel(1,0); end;
      6: begin MoveTo(Rx+1,Ry); LineRel(5,5); LineRel (0,-5); LineRel (-4,0);
           LineRel(3,3); LineRel(0,-2); LineRel(-1,0); end;
    end;
  end;

  procedure Room;
  begin
    Rectangle (Rx,Ry,Rx+6,Ry+6);
    if Outstand then SetColor(3) else SetColor(0);
    with Ship[l,x,y] do begin
      if (Interior and North)>0 then Line (Rx+2,Ry,Rx+4,Ry);
      if (Interior and South)>0 then Line (Rx+2,Ry+6,Rx+4,Ry+6);
      if (Interior and West)>0 then Line (Rx,Ry+2,Rx,Ry+4);
      if (Interior and East)>0 then Line (Rx+6,Ry+2,Rx+6,Ry+4);
    end;
    SetColor(1);
    if (y=2) and ((x=1) or (x=12)) then begin
      Line(Rx+2,Ry+2,Rx+4,Ry+2); Line(Rx+3,Ry+2,Rx+3,Ry+4);
    end;
  end;

begin
  Rx:=MapX+x*7; Ry:=MapY+y*7;
  if Outstand then SetFillStyle(1,3) else SetFillStyle(1,0);
  Bar(Rx+1,Ry+1,Rx+5,Ry+5); SetColor (1);
  if (l=2) and (y=1) and ((x>4) and (x<8)) then begin
    SetColor (2); case x of
      5:Tri(2);
      6:Room;
      7:Tri(1);
    end;
  end
  else if (y in [1,3]) and (x<15) then case y of
    1:case x of
           1,8:Tri(3);
             4:Tri(4);
        0,5..7:Black(Rx,Ry,Rx+6,Ry+6);
        else Room;
      end;
    3:case x of
           1,8:Tri(6);
             4:Tri(5);
        0,5..7:Black(Rx,Ry,Rx+6,Ry+6);
        else Room;
      end;
  end
  else if x=15 then Tri(1)
  else if (y=2) and (x=0) then Tri(2)
  else Room;
  SetColor (0);
end;

procedure DrawMap (Level:byte);
begin
  Black(32,152,57,156);
  for Ctr2:=0 to 15 do
    for Ctr:=1 to 3 do
      UpdateMap (Level,Ctr2,Ctr,False);
  SetColor (3);
  TextSize (2,3,2,3);
  OutTextXY (32,151,'Level '+St(Level));
  TextSize (1,1,1,1);
end;
                                                    (***** INITIALIZE *****)
procedure Initialize;
begin
  CheckBreak := not Debug;
  FindFile ('ICONS.DAT');                       { Check for essential files }
  FindFile ('SHIP.DAT');
  FindFile ('TITLE.DAT');
  Randomize;
  Gd := CGA;
  Gm := CGAC2;                     { Init graph mode }
  InitGraph(Gd, Gm, '');
  GraphColorMode;
  BkColor:=1; GraphBackground (BkColor);
  Palette (Gm);
  SetTextJustify (CenterText,CenterText);
  OutTextXY (160,100,'Please Wait ...');
	Assign (TitleFile,SAdir+'TITLE.DAT');          { Load title screens }
  Reset (TitleFile);                             { (Permanently) }
  Read (TitleFile, Tit1, Tit2);
  Close (TitleFile);
  for Ctr:=1 to 16240 do begin
    Dec (Tit1 [Ctr],25);
    Dec (Tit2 [Ctr],25);
  end;
  ShwTitle:=False;
  LoadIcons;
  LoadHiScores;                      { If hiscores exist, load them }
  Pause := 0; TempPause := Pause;
  Noise := True;
  Quit := False;
end;

procedure InitGame;
begin
  ClearDevice;
  TextSize (2,1,2,1);
  SetTextJustify (CenterText,CenterText); SetColor (1);
  OutTextXY (160,6,'SPACE ADVENTURE');
  TextSize (1,1,9,10);
  OutTextXY (160,19,'VERSION 2.01 RELEASE 2');
  TextSize (1,1,4,5);
             { The name of the author is coded so that patchers get problems }
  OutTextXY (160,187,DeCode('¨Ã© ÃÏÐÙÒÉÇÈÔ ±¹¸¸ ÆÉÒÅÂÁÌÌ ÓÏÆÔ×ÁÒÅ ÌÔÄ®'));
  OutTextXY (160,195,DeCode('ÐÒÏÇÒÁÍÍÉÎÇ¬ ÇÒÁÐÈÉÃÓ ÁÎÄ ÓÏÕÎÄ ÂÙ ÒÏÂÅÒÔ ÓÃÈÍÉÄÔ'));

  SetTextJustify (LeftText,TopText); SetColor (3);
  TextSize (1,1,1,1);
  PutImage (120,100,Icon[16],0);             { Show some characters and ... }
  PutImage (117,110,Icon[17],0);
  PutImage (115,120,Icon[18],0);
  PutImage (115,136,Icon[4],0);
  for Ctr:=0 to 3 do
    PutImage (117-Ctr*15,160,Icon[6+Ctr*2],0);
                                             { ... their identifications }
  OutTextXY (135,97,'- Power Pack'); OutTextXY (135,108,'- Electronic Key');
  OutTextXY (135,120,'- Crystal'); OutTextXY (135,141,'- You');
  OutTextXY (135,165,'- Alien Androids');

  TextSize (4,3,1,1);
  OutTextXY (45,27,'Please choose your skill level :');
  SetColor (2);
  OutTextXY (87,45,'1) Novice Beginner');
  OutTextXY (85,55,'2) Experienced Explorer');
  OutTextXY (85,65,'3) Space Warrior');
  OutTextXY (85,75,'Q) Quit Space Adventure');
  repeat
    K1 := ReadKey;
    Val (K1,Skill,Code);
  until (Skill in [1..3]) or (K1 in ['Q','q']);
  if K1 in ['Q','q'] then begin                          { Player quits }
    SaveHiScores;                                        { Save scores }
    CloseGraph;
    TextMode (Co80);
    Writeln ('Cliche time: May the force be with you!');
    Halt;
  end;
  TextSize (1,1,1,1);
  ClearDevice;
  InitShip;
  SetColor(2);                               { Put up information part }
  Rectangle (0,158,319,169);
  OutTextXY (123,134,'Keys');
  OutTextXY (183,134,'Crystals');
  OutTextXY (250,134,'Power Packs');
  LifeSupp:=230; WSupp[Phaser]:=230; WSupp[Blaster]:=230;
  SetColor(1); TextSize (9,10,4,5);
  OutTextXY (0,169,'LIFE SUPPORT'); OutTextXY (100,169,'(F1 CHARGE)');
  OutTextXY (0,179,'PHASER'); OutTextXY (100,179,'(F3 CHARGE)'); OutTextXY (210,179,'(F4 SELECT)');
  OutTextXY (0,189,'BLASTER'); OutTextXY (100,189,'(F5 CHARGE)'); OutTextXY (210,189,'(F6 SELECT)');
  Weapon:=Blaster; SelectWeapon (Phaser);
  DrawBar (LifeSupp,178,True);
  DrawBar (WSupp[Phaser],188,False);
  DrawBar (WSupp[Blaster],198,False);
  SetColor(3); TextSize (1,1,1,1);
  for Ctr:=0 to 3 do begin
    OutTextXY (115+12*Ctr,145,St(Ctr+1));
    KeyCarried[Ctr]:=False;
  end;
  Level:=2; ShipX:=6; ShipY:=1;                        { Init game variables }
  Xm:=154; Ym:=55; Xd:=0; Yd:=0; Xod:=-1; Yod:=0;
  Xb:=0; Yb:=0; Xbd:=0; Ybd:=0; Bul:=False;
  Man:=1; Walk:=False; WlkC:=0;
  Crystals:=0; Ppacks:=0; Keys:=0;
  K1:=#0; K3:=#0;
  MessCnt:=0;
  Ox:=0; Oy:=0;
  RobotsKilled := 0;
  PpacksUsed := 0;
  Rooms := 0;
  DrawMap (Level);                                { Map of start level (2) }
  Pause := TempPause;
end;


                                              (**** BULLET PROCESSING ****)
procedure Bullet(x,y,xd,yd,c:word);
begin
  SetColor (c);
  Line (x,y,x+xd,y+yd);
end;

function BulletValid(x,y,xd,yd:word):boolean;
begin
  BulletValid := ((GetPixel(x,y)=0) and (GetPixel(x+xd,y+yd)=0) and
                  (x<317) and (x>2) and (y<Swall+1) and (y>3));
end;
                                                   (**** MOVE A ROBOT ****)
procedure PutRobot(No:word);
var Xdif,Ydif:integer;
begin
  with Robot[No] do begin
    if Xr>0 then PutImage (Xr,Yr,Icon[5+Typ*2+Ord(Xr<=Xm)],NormalPut);
    if (not Bl) and (Xr>0) then begin
      if Random(50-(10*Skill)-(3*Crystals))=1 then begin
        if Xm<Xr then Xrb:=Xr-1 else Xrb:=Xr+11;
        Yrb:=Yr+8;
        Xdif:=Xm-Xr; Ydif:=Ym-Yr;
        if Xdif<>0 then Xrbd:=Xdif div Abs(Xdif);
        if Ydif<>0 then Yrbd:=Ydif div Abs(Ydif);
        if Abs(Ydif)<Abs(Xdif div 3) then Yrbd:=0;
        if Abs(Xdif)<Abs(Ydif div 3) then Xrbd:=0;
        if BulletValid(Xrb,Yrb,Xrbd,Yrbd) then begin
          Sound (600);
          Bl:=True;
          Bullet (Xrb,Yrb,Xrbd,Yrbd,3);
        end;
      end;
    end else begin
      Bullet (Xrb,Yrb,Xrbd,Yrbd,0);
      Inc (Xrb,Xrbd*2); Inc (Yrb,Yrbd*2);
      if not BulletValid(Xrb,Yrb,Xrbd,Yrbd) then begin
        Bl:=False;
        if (Xrb>=Xm-1) and (Xrb<=Xm+13) and
           (Yrb>=Ym-1) and (Yrb<=Ym+21) then begin
          PutImage(Xm,Ym,Icon[Man+Ord(Walk and ((Xd<>0) or (Yd<>0)))],NotPut);
          Sound (900);
          DecSupport(LifeSupp,5,178);
        end;
      end else Bullet (Xrb,Yrb,Xrbd,Yrbd,3);
    end;
  end;
  SetColor (0); NoSound;
end;

procedure HitRobot;
begin
  Hit:=0;
  NoSound;
  Inc (Xb,Xbd*2); Inc (Yb,Ybd*2);
  for Ctr:=1 to Robots do with Robot[Ctr] do if Xr>0 then
    if (Xb>=Xr-1) and (Xb<=Xr+11) and
       (Yb>=Yr-1) and (Yb<=Yr+21) then Hit:=Ctr;
  if Hit>0 then with Robot[Hit] do begin
    PutImage(Xr,Yr,Icon[5+Typ*2+Ord(Xr<=Xm)],NotPut);
    Sound (850); Delay (4);
    Dec(Power,2+Ord(Weapon)*2);
    if (Power=0) or (Power>250) then begin
      NoSound;
      Delay (200);
      for Ctr:=1 to 1000 do begin
        Sound (Random (1000-Ctr));
        PutPixel (Xr+Random(11),Yr+Random(21),0);
        Sound (10000);
      end;
      Black(Xr,Yr,Xr+10,Yr+20);
      Xr:=0; Dec (RobotsLeft);
      Inc (RobotsKilled);
    end;
    NoSound;
  end;
end;
                                               (***** DRAW CURRENT ROOM ****)
procedure InitRoom(Interior:word; Obj,Robs:byte; Visited:boolean);
var x,y:byte;
    Crash:boolean;
begin
  UpdateMap (Level,ShipX,ShipY,True);
  if not Visited then Inc (Rooms);
  SetLineStyle(0,0,3); SetColor (3);
  Rectangle (1,1,318,Swall+3); SetColor (0);
  if (Interior and North)>0 then Line (160-30,2,160+30,2);
  if (Interior and South)>0 then Line (160-30,Swall+2,160+30,Swall+2);
  if (Interior and West)>0 then Line (2,66-19,2,66+19);
  if (Interior and East)>0 then Line (317,66-19,317,66+19);

  if (Interior and Shield)>0 then begin
    PutImage (160-35-15,66-15,Icon[13],0);
    PutImage (160+35,66-15,Icon[14],0);
  end;
  if (Interior and Block)>0 then for x:=0 to 1 do for y:=0 to 1 do
    PutImage (85+x*141,30+y*62,Icon[15],0);
  SetColor (3);
  if (Interior and Pform)>0 then for y:=0 to 1 do
    PutImage (160-20,37+y*54,Icon[20],0);
  SetLineStyle (0,0,0); SetColor (0);
  if (Interior and Panel)>0 then PutImage (160-40,49,Icon[19],0);

  CurrObj:=Obj; if Obj>0 then begin
    Obx:=Icon[ObjIcon[Obj]][1] div 2; Oby:=Icon[ObjIcon[Obj]][3] div 2;
    PutImage (160-Obx,65-Oby,Icon[ObjIcon[Obj]],0);
  end;

  PutImage (Xm,Ym,Icon[Man+Ord(Walk and ((Xd<>0) or (Yd<>0)))],0);

  RobotsLeft:=0; Robots:=0;
  if (not Visited) and (Robs>0) then begin
    Robots:=Robs; RobotsLeft:=Robs;
    for Ctr:=1 to Robots do
      with Robot[Ctr] do begin
        repeat
          Crash:=False;
          Xr:=Random(300)+3;
          Yr:=Random(Swall-25)+3;
          if (Interior>15) or (Obj>0) then if (Xr>65) and (Xr<240) and (Yr>8) and (Yr<115) then Crash:=True;
          if Ctr>1 then for Ctr2:=1 to Ctr-1 do
            if (Xr+13>=Robot[Ctr2].Xr) and (Xr<=Robot[Ctr2].Xr+13) and
              (Yr+21>=Robot[Ctr2].Yr) and (Yr<=Robot[Ctr2].Yr+21) then Crash:=True;
          if (Xr+15>=Xm) and (Xr<=Xm+15) and (Yr+21>=Ym) and (Yr<=Ym+21) then Crash:=True;
        until (not Crash);
        Xrd:=Random(3)-1; Yrd:=Random(3)-1;
        Typ:=Random (4);
        Power:=6+Skill+Crystals+Typ*2;
        Bl:=False;
      end;
    for Ctr:=0 to 750 do begin
      for Ctr2:=1 to Robots do with Robot[Ctr2] do
        PutPixel (Xr+Random(11),Yr+Random(21),Random(4));
      Sound (Random(Ctr*2));
    end;
    for Ctr:=1 to Robots do PutRobot(Ctr);
  end;
end;

procedure TakeObjekt;
begin
  if CurrObj>Ord((CurrObj=1) and (Ppacks=4)) then
    if (Xm+12+Xd>=160-Obx) and (Xm+Xd<=161+Obx) and
       (Ym+20+Yd>=65-Oby) and (Ym+Yd<=66+Oby) then begin
         Black(160-Obx,65-Oby,161+Obx,66+Oby);
				 Ship[Level,ShipX,ShipY].Objekt:=0;
         case ObjIcon[CurrObj] of
           16: begin
                 Inc(Ppacks);
                 PutImage(255+Ppacks*10,146,Icon[16],0);
               end;
           17: begin
                 KeyCarried[CurrObj-Key]:=True;
                 PutImage(114+(CurrObj-Key)*12,147,Icon[17],0);
                 Inc (Keys);
               end;
           18: begin
                 PutImage(175+Crystals*16,145,Icon[18],0);
                 Inc (Crystals);
                 if Crystals=4 then begin
                   Message ('Good job! Now return to your ship!');
                   MessCnt := 1;
                 end;
               end;
         end;
         Play ('t255 l8 o5 c>c<c>c<c>c<c');
         CurrObj:=0;
       end;
end;
                                                     (**** LOCKED DOOR? ****)
procedure CheckLockedDoor;
var BehindDoor:byte;
begin
	BehindDoor:=Ship[Level,ShipX,ShipY].Objekt;
  if BehindDoor>=Crystal then
    if KeyCarried[BehindDoor-Crystal] then begin
      if MessCnt>0 then ClearMessage;
      Message ('Electronic key #'+St(BehindDoor-Crystal+1)+' opens the door');
      MessCnt:=1;
    end else begin
      Message ('This door is locked ! Requires electronic key #'+St(BehindDoor-Crystal+1));
      MessCnt:=1;
      ShipX:=Ox; ShipY:=Oy;
    end;
end;
                                              (**** MOVEMENT PROCESSING ****)
procedure Gun (x,y:integer);
begin
  if (x<>0) and (y<>0) then PutPixel (Xm+(12*Ord(Man=3)),Ym+10,0);
  PutPixel (Xm+(12*Ord(Man=3)),Ym+10+y,1);
end;

procedure Dir(x,y:integer);
begin
  if (x<>0) or (y<>0) then begin
    Xod:=x; Yod:=y;
  end;
  Xd:=x; Yd:=y;
  if Xd<0 then Man:=1;
  if Xd>0 then Man:=3;
end;

function Stop(x,y,xd,yd:word):boolean;
var x1,y1:word;
begin
  Stop:=False;
  if xd<>0 then begin
    x1:=x+xd+(Width*ord(xd=1));
    for y1:=y+yd to y+20+yd do
      if GetPixel(x1,y1)>0 then Stop:=True;
  end;
  if yd<>0 then begin
    y1:=y+yd+(20*ord(yd=1));
    for x1:=x+xd to x+Width+xd do
      if GetPixel(x1,y1)>0 then Stop:=True;
  end;
end;
                                                (**** MOVE MAN ****)
procedure MoveMan;
begin
  if KeyPressed then begin
    K1:=ReadKey;
    case K1 of
      #0 : if KeyPressed then begin
             K2:=ReadKey;
             if K2=K3 then begin
               Dir (0,0); K3:=#0;
             end else begin
               case K2 of
                 'G': Dir (-1,-1);
                 'H': Dir (0,-1);
                 'I': Dir (+1,-1);
                 'K': Dir (-1,0);
                 'M': Dir (+1,0);
                 'O': Dir (-1,+1);
                 'P': Dir (0,+1);
                 'Q': Dir (+1,+1);

                 ';': UsePpack (LifeSupp,178);
                 '=': UsePpack (WSupp[Phaser],188);
                 '>': SelectWeapon (Phaser);
                 '?': UsePpack (WSupp[Blaster],198);
                 '@': SelectWeapon (Blaster);

                 'Z': Inc (Pause,3);
                 'A': Dec (Pause,3);

                 'B': begin
                        Noise := not Noise;
                        Sound (700);
                        Delay (70);
                      end;

                 'C': begin
                        Inc (Gm);
                        if Gm>3 then Gm:=0;
                        Palette (Gm);
                      end;
                 'D': begin
                        Inc (BkColor);
                        if BkColor>15 then BkColor:=0;
                        GraphBackground (BkColor);
                      end;
               end;
               if K2 in ['G'..'Q'] then K3:=K2;
               if Pause<0 then Pause:=0;
               if Pause>100 then Pause:=100;
             end;
           end;
      #32: if (not Bul) and (RobotsLeft>0) and (WSupp[Weapon]>0) then begin
             if Man=1 then Xb:=Xm else Xb:=Xm+12;
             Xb:=Xb+Xod;
             Yb:=Ym+10+2*Yod;
             Xbd:=Xod; Ybd:=Yod; Code:=0;
             if Weapon = Phaser then Sound (3000);
             Sound (BulSound);
             if BulletValid(Xb,Yb,Xbd,Ybd) then begin
               Bul:=True; Dist :=0;
               Bullet (Xb,Yb,Xbd,Ybd,3);
             end else HitRobot;
             if Weapon=Phaser then DecSupport (WSupp[Phaser],4,188)
                              else DecSupport (WSupp[Blaster],8,198);
           end;
      #27: begin
             ClearMessage;
             Message ('Really want to end this game? (Y/N)');
             repeat K2:=UpCase(ReadKey); until K2 in ['Y','N'];
             ClearMessage;
             if k2='N' then K1:=#0;
           end;
    end;
  end;
  if Bul then begin
    Bullet (Xb,Yb,Xbd,Ybd,0);
    Inc (Xb,Xbd*2);
    Inc (Yb,Ybd*2);
    if Dist<3000 then begin
      Inc (Dist,150);
      if Weapon = Phaser then Sound (3000-Dist)
                         else Sound (Dist);
      Sound (BulSound);
    end;
    if not BulletValid(Xb,Yb,Xbd,Ybd) then begin
      Bul:=False;
      HitRobot;
    end else Bullet (Xb,Yb,Xbd,Ybd,3);
    SetColor (0);
  end;
  NoSound;
  if not Stop(Xm,Ym,Xd,Yd) then begin
    case Xd of
      -1: Line (Xm+12,Ym,Xm+12,Ym+20);
      +1: Line (Xm,Ym,Xm,Ym+20);
    end;
    case Yd of
      -1: Line (Xm,Ym+20,Xm+12,Ym+20);
      +1: Line (Xm,Ym,Xm+12,Ym);
    end;
    Xm:=Xm+Xd; Ym:=Ym+Yd;
    Inc(WlkC);
    if WlkC>15 then begin
      Walk:=not Walk;
      WlkC:=0;
    end;
	end else TakeObjekt;
  PutImage (Xm,Ym,Icon[Man+Ord(Walk and ((Xd<>0) or (Yd<>0)))],0);
  Gun (Xod,Yod);
end;
                                               (***** MOVE ROBOTS ****)
procedure MoveRobots;
var stp:boolean;
begin
  Width:=10;
  for Ctr:=1 to Robots do
  with Robot[Ctr] do if (Xr>0) or Bl then begin
    if Xr>0 then begin
      stp:=Stop(Xr,Yr,Xrd,Yrd);
      if not Stp then begin
        case Xrd of
          -1: Line (Xr+10,Yr,Xr+10,Yr+20);
          +1: Line (Xr,Yr,Xr,Yr+20);
        end;
        case Yrd of
          -1: Line (Xr,Yr+20,Xr+10,Yr+20);
          +1: Line (Xr,Yr,Xr+10,Yr);
        end;
        Xr:=Xr+Xrd; Yr:=Yr+Yrd;
      end;
      if Random(30-Ord(Stp)*20-Skill*3)=0 then begin
        Xrd:=Random (3)-1; Yrd:=Random (3)-1;
      end;
    end;
    PutRobot (Ctr);
  end;
  Width:=12;
end;

procedure Game;
begin
  repeat
    Teleport := ((ShipX in [1,12]) and (ShipY=2)) and Leave;
    Xm:=Xm+15*Ord(Teleport)*Xd;
    if (ShipX<>Ox) or (ShipY<>Oy) then with Ship[Level,ShipX,ShipY] do
			InitRoom(Interior,Objekt,Random(3+Ord(Skill=3)),Visited);
                                                         (**** TELEPORT ****)
    if Teleport then begin
      PutImage (Xm,Ym,Icon[Man],0);
      Message ('Teleport room. Which level ? (1-3)');
      repeat Val(Readkey,NewLevel,Code); until (NewLevel>0) and (NewLevel<4);
      ClearMessage;
      UpdateMap(Level,ShipX,ShipY,False);
      if NewLevel=Level then ShipX:=Ord(ShipX=12)+Ord(ShipX=1)*12
        else DrawMap (NewLevel);
      Level:=NewLevel; Leave:=False;
      UpdateMap(Level,ShipX,ShipY,False);
    end else begin
                                                   (***** MAIN LOOP *****)
      repeat
        MoveMan;
        MoveRobots;
        if MessCnt>0 then begin
          Inc(MessCnt); if MessCnt=80 then begin
            ClearMessage; MessCnt:=0; end;
        end;
        Crt.Delay(Pause);
        Leave:=((Xm<=1) or (Xm>=306) or (Ym<=1) or (Ym+17>=Swall)) and (RobotsLeft=0);
        Dead:=(LifeSupp=0) or (K1=#27) or
              ((WSupp[Phaser]=0) and (WSupp[Blaster]=0) and (Ppacks=0) and
               (CurrObj<>Ppack) and (RobotsLeft>0));
        Done:=((Crystals=4) and (Level=2) and (ShipX=6) and (ShipY=1));
      until Leave or Dead or Done;

      if Leave then begin
        Ox:=ShipX; Oy:=ShipY;
        Ship[Level,ShipX,ShipY].Visited:=True;
        ShipX:=ShipX+Ord(Xm>=306)-Ord(Xm<=1);
        ShipY:=ShipY+Ord(Ym+21>=Swall)-Ord(Ym<=1);

        CheckLockedDoor;

        if (ShipX<>Ox) or (ShipY<>Oy) then begin
          if Xm<=1 then Xm:=305 else if Xm>=306 then Xm:=2;
          if Ym<=1 then Ym:=SWall-18 else if Ym+17>=Swall then Ym:=2;
          Bul:=False;
          UpdateMap (Level,Ox,Oy,False);
        end;
      end;
    end;                                 (**** CLEAR ROOM ****)
    if ((ShipX<>Ox) or (ShipY<>Oy)) and not (Dead or Done) then
      if PCCompatible then begin
        FillChar (Scr,5440,0);
        FillChar (Scr2,5440,0);
      end else Black (0,0,319,150);
  until Dead or Done;
end;

procedure Finish;
var Txt:str80;
begin
  TempPause := Pause;
  Pause := 0;
  if Dead then begin
    PutImage (Xm,Ym,Icon[Man+Ord(Walk and ((Xd<>0) or (Yd<>0)))],NotPut);
    Delay (600);
    for Ctr:=1 to 1700 do begin
      Sound (1750-Ctr); Delay (1);
      Sound (Ctr);
      PutPixel (Xm+Random(13),Ym+Random(21),0);
    end;
  end;
  NoSound;
  Black(Xm,Ym,Xm+12,Ym+20);
  if Done then begin
    PutImage (154,55,Icon[1],NormalPut);
    Delay (600);
    TheEnd;
  end else begin
    Message ('You failed completing SPACE ADVENTURE! Press a key.');
    while KeyPressed do K1:=ReadKey;
    K1:=ReadKey;
  end;
  Score := Evaluation;
  ShowHiScores (Score);
end;


        (******************  M A I N    P R O G R A M  *****************)

begin
  Initialize;
  repeat
    ShowTitle;
    InitGame;
		Game;
    Finish;
  until False = True;
end.
