home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / TROFFII.ZIP / TROFF-2.PAS < prev   
Pascal/Delphi Source File  |  1990-07-31  |  53KB  |  1,382 lines
  1. { TROFF II --- UFP Software --- 1990 }
  2.  
  3. uses
  4.     Graph,
  5.     Crt;
  6.  
  7. label 1, 2, 3, 4;
  8.  
  9. const
  10.     TLCor = 1;  Hor = 5;
  11.     TRCor = 2;  Ver = 6;
  12.     BLCor = 3;
  13.     BRCor = 4;
  14.     ML = 1;  IBML = 2;  W = 3;  MW = 4; Bl = 5;
  15.     SB = 1;  LB = 2;  PS = 3;   Sp = 0;
  16.     You = 1; IBM = 2; incr = 1; decr =2;
  17.  
  18. type
  19.     PlayField = array[0..78,0..48] of byte;
  20.  
  21. var
  22.     { Images }
  23.     LineIm    : array[1..4,1..6] of pointer;
  24.     BallIm    : array[1..2,1..4]  of pointer;
  25.     Sib, Null :                 pointer;
  26.     Note      :                 pointer;
  27.     Numbers   : array[0..9]  of pointer;
  28.  
  29.     PF        : PlayField; { Playfield }
  30.     Gd, Gm    : integer;   { EGAsetup }
  31.     OldPal    : PaletteType;
  32.     Scr,Bonus : array[1..2] of longint;
  33.     Lng,Lplus : array[1..2] of integer;
  34.     Trn       : array[1..2] of byte;
  35.     Pntr      : array[1..2] of integer;
  36.     Snk       : array[1..2,1..200] of record x:byte; y:byte ;end;
  37.     MaxTrn, Code, OldCode, OldestCode, SaveCode : byte;
  38.     Xdir,Ydir : array[1..2] of integer;
  39.     Ch        : char;
  40.     ObN       : byte;
  41.     ShowTurnsFlag   : boolean;
  42.     ShowScoreFlag, ShowLenFlag : array[1..2] of boolean;
  43.     Gold      : array[1..3] of
  44.                 record
  45.                  Class : byte;
  46.                     gx : byte;
  47.                     gy : byte;
  48.                   Size : byte;
  49.                    Dir : byte;
  50.                 end; { Gold }
  51.     MoveWallFlag : boolean;
  52.     Mow          : array[1..35] of record
  53.                                    mwx : byte;
  54.                                    mwy : byte;
  55.                     end; { Mow }
  56.     MWInfo       : record    mwxdir : integer;
  57.                              mwydir : integer;
  58.                              mwleng : byte;
  59.                              mwpntr : byte;
  60.                     end; { MWData }
  61.     Tune,Counter : byte;
  62.     MaxCounter   : byte;
  63.     ToggleSound  : boolean;
  64.     Message      : array[1..20] of string;
  65.     MessageFlag  : integer;
  66.     Speed        : byte;
  67.     EndFlag      : array[1..2] of boolean;
  68.     EnemyToggle  : boolean;
  69.     MWallToggle  : integer;
  70.     LenToWin     : byte;
  71.     g            : integer;
  72.     GameNo       : byte;
  73.     Hisco,Losco  : longint;
  74.     HiPla,Lopla  : byte;
  75.     FirstGameFlag: boolean;
  76.     QuitFlag     : boolean;
  77.     ExitFlag     : boolean;
  78.  
  79. procedure GetImages;
  80.   var i, j, x, c1, c2 :integer;
  81.       size : word;
  82.   begin
  83.   for i:=0 to 15 do SetPalette(i,0);
  84.   { Numbers }
  85.   SetColor(Red);
  86.   Line(3,1,6,1);Line(3,18,6,18);Line(2,2,2,3);Line(7,2,7,3);
  87.   Line(1,4,1,15);Line(8,4,8,15);Line(2,16,2,17);Line(7,16,7,17);
  88.   Line(4,5,5,5);Line(4,14,5,14); {0}
  89.   MoveTo(16,1);LineTo(16,15);LineTo(18,15);LineTo(18,18);
  90.   LineTo(11,18);LineTo(11,15);LineTo(13,15);LineTo(13,5);LineTo(11,7);
  91.   LineTo(11,3);LineTo(12,2);LineTo(13,2);LineTo(13,1);LineTo(16,1); {1}
  92.   MoveTo(21,3);LineTo(23,1);LineTo(26,1);LineTo(28,3);LineTo(28,10);
  93.   LineTo(24,14);LineTo(24,15);LineTo(28,15);LineTo(28,18);LineTo(21,18);
  94.   LineTo(21,14);LineTo(25,10);LineTo(25,4);LineTo(23,4);LineTo(21,6);
  95.   LineTo(21,3); {2}
  96.   MoveTo(31,6);LineTo(31,3);LineTo(33,1);LineTo(36,1);LineTo(38,3);
  97.   LineTo(38,8);Line(37,9,37,10);MoveTo(38,11);LineTo(38,16);LineTo(36,18);
  98.   LineTo(33,18);LineTo(31,16);LineTo(31,13);LineTo(33,15);LineTo(34,15);LineTo(35,14);
  99.   LineTo(35,11);LineTo(33,10);LineTo(33,9);LineTo(35,8);LineTo(35,5);
  100.   LineTo(34,4);LineTo(33,4);LineTo(31,6); {3}
  101.   MoveTo(48,1);LineTo(48,18);LineTo(45,18);LineTo(45,11);LineTo(41,11);
  102.   LineTo(41,5);LineTo(45,1);LineTo(48,1);MoveTo(45,5);LineTo(45,8);
  103.   LineTo(43,8);LineTo(43,6);LineTo(45,5); {4}
  104.   MoveTo(58,1);LineTo(51,1);LineTo(51,10);LineTo(55,10);LineTo(55,15);
  105.   LineTo(54,15);LineTo(51,12);LineTo(51,15);LineTo(54,18);LineTo(55,18);
  106.   LineTo(58,15);LineTo(58,9);LineTo(56,7);LineTo(54,7);LineTo(54,4);
  107.   LineTo(58,4);LineTo(58,1); {5}
  108.   MoveTo(68,1);LineTo(63,1);LineTo(61,3);LineTo(61,17);LineTo(62,18);
  109.   LineTo(66,18);LineTo(68,16);LineTo(68,9);LineTo(66,7);LineTo(64,7);
  110.   LineTo(64,4);LineTo(68,4);LineTo(68,1);Rectangle(63,10,66,15); {6}
  111.   MoveTo(71,1);LineTo(78,1);LineTo(78,7);LineTo(76,9);LineTo(76,18);
  112.   LineTo(73,18);LineTo(73,9);LineTo(75,7);LineTo(75,4);LineTo(73,4);
  113.   LineTo(73,6);LineTo(71,6);LineTo(71,1); {7}
  114.   MoveTo(83,1);LineTo(86,1);LineTo(88,3);LineTo(88,7);LineTo(86,9);
  115.   LineTo(88,11);LineTo(88,16);LineTo(86,18);LineTo(83,18);LineTo(81,16);
  116.   LineTo(81,11);LineTo(83,9);LineTo(81,7);LineTo(81,3);LineTo(83,1);
  117.   MoveTo(83,5);LineTo(84,4);LineTo(85,4);LineTo(86,5);LineTo(85,6);
  118.   LineTo(84,6);MoveTo(84,12);LineTo(85,12);LineTo(86,13);LineTo(86,14);
  119.   LineTo(85,15);LineTo(84,15);LineTo(83,14);LineTo(83,13); {8}
  120.   MoveTo(93,1);LineTo(97,1);LineTo(98,2);LineTo(98,16);LineTo(96,18);
  121.   LineTo(91,18);LineTo(91,15);LineTo(95,15);LineTo(95,12);LineTo(93,12);
  122.   LineTo(91,10);LineTo(91,3);LineTo(93,1);Rectangle(93,4,96,9); {9}
  123.   SetColor(Yellow);
  124.   Line(2,4,2,15);Line(3,2,3,17);Line(6,2,6,17);Line(7,4,7,15);
  125.   SetFillStyle(SolidFill,Yellow);Bar(4,2,5,4);Bar(4,15,5,17);
  126.   SetFillStyle(SolidFill,Yellow);FloodFill(14,2,Red);FloodFill(22,3,Red);
  127.   FloodFill(32,3,Red);FloodFill(45,2,Red);FloodFill(57,2,Red);
  128.   FloodFill(67,2,Red);Line(63,10,63,15);Line(66,10,66,15);
  129.   FloodFill(72,2,Red);FloodFill(83,2,Red);
  130.   FloodFill(97,2,Red);Line(93,4,93,9);Line(96,4,96,9);
  131.   { Snakes & Walls }
  132.   for i:=1 to 4 do
  133.     begin
  134.     x:=i*30-30;
  135.     case i of
  136.    1 : begin c1:=LightGreen;c2:=Green;end; 2 : begin c1:=LightMagenta;c2:=Magenta;end;
  137.    3 : begin c1:=LightBlue;c2:=Blue;end; 4 : begin c1:=LightGray;c2:=DarkGray;end;
  138.       end; {case i}
  139.     SetColor(c2);
  140.     MoveTo(x+2,30); LineTo(x+18,30); LineTo(x+20,32); LineTo(x+20,48);
  141.     LineTo(x+18,50); LineTo(x+2,50); LineTo(x,48); LineTo(x,32);
  142.     LineTo(x+2,30); Rectangle(x+6,36,x+14,44);
  143.     for j:=0 to 8 do
  144.       begin
  145.       Line(x+3+j*2,31,x+3+j*2,30); Line(x+3+j*2,49,x+3+j*2,50);
  146.       Line(x+1,33+j*2,x,33+j*2);   Line(x+19,33+j*2,x+20,33+j*2);
  147.       end;
  148.     for j:=0 to 5 do
  149.       begin
  150.       Line(x+5+j*2,35,x+5+j*2,35); Line(x+5+j*2,45,x+5+j*2,45);
  151.       Line(x+5,35+j*2,x+5,35+j*2); Line(x+15,35+j*2,x+15,35+j*2);
  152.       end;
  153.     Line(x+1,33,x+3,31); Line(x+17,31,x+19,33);
  154.     Line(x+1,47,x+3,49); Line(x+17,49,x+19,47);
  155.     SetFillStyle(SolidFill,c1);FloodFill(x+4,31,c2);
  156.     SetColor(c1);
  157.     Line(x+1,32,x+2,31);Line(x+18,31,x+19,32);
  158.     Line(x+1,48,x+2,49);Line(x+18,49,x+19,48);
  159.     end;
  160.   { Golds }
  161.   for i:=0 to 1 do
  162.     begin
  163.     case i of
  164.     0 : begin c1:=LightCyan;c2:=Cyan;end;
  165.     1 : begin c1:=White;c2:=LightGray;end;
  166.     end; {case i} SetFillStyle(SolidFill,c1);
  167.     SetColor(c2);Line(3,92+i*10,3,94+i*10);Line(2,93+i*10,4,93+i*10);PutPixel(3,93+10*i,c1);
  168.     SetColor(c1);Bar(12,92+10*i,14,94+10*i);SetColor(c2);
  169.     MoveTo(13,91+i*10);LineTo(15,93+i*10);LineTo(13,95+i*10);LineTo(11,93+i*10);LineTo(13,91+i*10);
  170.     MoveTo(23,90+i*10);LineTo(26,93+i*10);LineTo(23,96+i*10);LineTo(20,93+i*10);LineTo(23,90+i*10);
  171.     FloodFill(23,91+i*10,c2);
  172.     Line(30,92+i*10,32,90+i*10);Line(34,90+i*10,36,92+i*10);Line(30,94+i*10,32,96+i*10);Line(34,96+i*10,36,94+i*10);
  173.     SetColor(c1);MoveTo(30,93+i*10);LineTo(33,90+i*10);LineTo(36,93+i*10);
  174.     LineTo(33,96+i*10);LineTo(30,93+i*10);FloodFill(33,93+i*10,c1);
  175.     end;
  176.   SetColor(Yellow);MoveTo(0,111);LineTo(1,110);LineTo(5,110);LineTo(6,111);LineTo(6,115);
  177.   LineTo(5,116);LineTo(1,116);LineTo(0,115);LineTo(0,111);Line(2,110,2,116);
  178.   PutPixel(1,113,Yellow);PutPixel(4,112,Yellow);
  179.   { Get Images }
  180.   for i:=0 to 9 do
  181.     begin
  182.     Size:=ImageSize(10*i,0,10*i+9,19);GetMem(Numbers[i],Size);
  183.     GetImage(10*i,0,10*i+9,19,Numbers[i]^); end;
  184.   Size:=ImageSize(0,30,6,36);
  185.   for i:=1 to 4 do
  186.     begin
  187.     x:=30*i-30;
  188.     for j:=1 to 6 do GetMem(LineIm[i,j],Size);
  189.     GetImage(x,30,x+6,36,LineIm[i,TLCor]^);
  190.     GetImage(x+14,30,x+20,36,LineIm[i,TRCor]^);
  191.     GetImage(x,44,x+6,50,LineIm[i,BLCor]^);
  192.     GetImage(x+14,44,x+20,50,LineIm[i,BRCor]^);
  193.     GetImage(x+7,30,x+13,36,LineIm[i,Hor]^);
  194.     GetImage(x,37,x+6,43,LineIm[i,Ver]^);
  195.     end;
  196.   for i:=1 to 2 do
  197.     begin
  198.     for j:=1 to 4 do
  199.       begin
  200.       GetMem(BallIm[i,j],Size);
  201.       x:=10*j-10;
  202.       GetImage(x,80+i*10,x+6,86+i*10,BallIm[i,j]^);
  203.       end;
  204.     end;
  205.   GetMem(Null,Size);GetMem(Sib,Size);
  206.   GetImage(0,70,6,76,Null^);GetImage(0,110,6,116,Sib^);
  207.   SetColor(LightGray);
  208.   Line(631,9,631,11);
  209.   for i:=632 to 634 do Line(i,8,i,12);
  210.   for i:=635 to 636 do Line(i,0,i,11);
  211.   MoveTo(637,0);LineTo(639,0);LineTo(639,1);
  212.   MoveTo(637,3);LineTo(639,3);LineTo(639,4);
  213.   GetMem(Note,ImageSize(631,0,639,12));
  214.   GetImage(631,0,639,12,Note^);
  215.   end;
  216.  
  217. procedure DrawScoreWindow;
  218.   begin
  219.   SetColor(Magenta);
  220.   MoveTo(565,0);LineTo(629,0);LineTo(634,10);LineTo(634,329);LineTo(629,339);
  221.   LineTo(565,339);LineTo(560,329);LineTo(560,10);LineTo(565,0);
  222.   SetFillStyle(InterleaveFill,Magenta);FloodFill(566,1,Magenta);
  223.   SetColor(Red);
  224.   MoveTo(634,329);LineTo(629,339);LineTo(634,349);LineTo(639,339);LineTo(634,329);
  225.   SetFillStyle(SolidFill,Brown);FloodFill(634,339,Red);
  226.   SetColor(Brown);
  227.   MoveTo(629,0);LineTo(639,20);LineTo(639,339);LineTo(634,329);LineTo(634,10);
  228.   MoveTo(560,329);LineTo(570,349);LineTo(634,349);LineTo(629,339);LineTo(565,339);
  229.   SetFillStyle(InterleaveFill,Brown);FloodFill(635,20,Brown);FloodFill(570,340,Brown);
  230.   SetColor(Black);SetFillStyle(InterleaveFill,DarkGray);Bar(565,270,626,291);Bar(565,300,626,321);
  231.   Bar(565,58,590,263);Bar(601,58,626,263);Bar(565,19,590,50);Bar(601,19,626,50);
  232.   SetColor(Brown);
  233.   MoveTo(565,50);LineTo(565,19);LineTo(590,19);
  234.   MoveTo(601,50);LineTo(601,19);LineTo(626,19);
  235.   Line(565,20,590,20);Line(601,20,626,20);
  236.   MoveTo(565,263);LineTo(565,58);LineTo(590,58);Line(565,59,590,59);
  237.   MoveTo(601,263);LineTo(601,58);LineTo(626,58);Line(601,59,626,59);
  238.   MoveTo(565,291);LineTo(565,270);LineTo(626,270);Line(565,271,626,271);
  239.   MoveTo(565,321);LineTo(565,300);LineTo(626,300);Line(565,301,626,301);
  240.   SetFillStyle(SolidFill,Black);SetColor(Magenta);
  241.   FillEllipse(577,10,5,5);FillEllipse(613,10,5,5);FillEllipse(596,330,5,5);
  242.   end;
  243.  
  244. procedure DrawPlayField;
  245.   var i,j,Room,Barrier : integer;
  246.   procedure DW(ax,by,img : byte);
  247.     begin
  248.     PutImage(7*ax,7*by,LineIm[W,img]^,NormalPut);
  249.     PF[ax,by]:=W;
  250.     end;
  251.   begin
  252.    if trn[1]+1=MaxTrn then begin
  253.      SetFillStyle(SolidFill,LightGreen);FloodFill(577,10,Magenta);end;
  254.    if trn[2]+1=MaxTrn then begin
  255.      SetFillStyle(SolidFill,LightRed);FloodFill(613,10,Magenta);end;
  256.   for i:=0 to 78 do for j:=0 to 48 do PF[i,j]:=Sp;
  257.   for i:=0 to 78 do begin pf[i,0]:=W;pf[i,48]:=W;PutImage(7*i,0,LineIm[W,Hor]^,NormalPut);
  258.                           PutImage(7*i,336,LineIm[W,Hor]^,NormalPut);end;
  259.   for j:=1 to 47 do begin pf[0,j]:=W;pf[78,j]:=w;PutImage(0,7*j,LineIm[W,Ver]^,NormalPut);
  260.                           PutImage(546,7*j,LineIm[W,Ver]^,NormalPut);end;
  261.   PutImage(0,0,LineIm[W,TLCor]^,NormalPut);PutImage(546,0,LineIm[W,TRCor]^,NormalPut);
  262.   PutImage(0,336,LineIm[W,BLCor]^,NormalPut);PutImage(546,336,LineIm[W,BRCor]^,NormalPut);
  263.   Barrier:=Random(5)+1;
  264.   repeat
  265.     Room:=Random(11)+1;Barrier:=Barrier-1;
  266.     case Room of
  267.       1: begin
  268.          DW(1,1,BRCor); DW(77,1,BLCor); DW(1,47,TRCor); DW(77,47,TLCor);
  269.          end;
  270.       2: begin
  271.          for i:=35 to 43 do begin DW(i,1,Hor); DW(i,47,Hor); end;
  272.          end;
  273.       3: begin
  274.          for i:=21 to 27 do begin DW(1,i,Ver); DW(77,i,Ver); end;
  275.          end;
  276.       4: begin
  277.          for i:=11 to 14 do begin DW(i,5,Hor); DW(i,43,Hor); end;
  278.          for i:=64 to 67 do begin DW(i,5,Hor); DW(i,43,Hor); end;
  279.          for i:=6  to 9  do begin DW(10,i,Ver); DW(68,i,Ver); end;
  280.          for i:=39 to 42 do begin DW(10,i,Ver); DW(68,i,Ver); end;
  281.          DW(10,5,TLCor); DW(68,5,TRCor);
  282.          DW(10,43,BLCor); DW(68,43,BRCor);
  283.          end;
  284.       5: begin
  285.          for i:=15 to 19 do begin DW(i,5,Hor); DW(i,43,Hor); end;
  286.          for i:=59 to 63 do begin DW(i,5,Hor); DW(i,43,Hor); end;
  287.          for i:=10 to 14 do begin DW(10,i,Ver); DW(68,i,Ver); end;
  288.          for i:=34 to 38 do begin DW(10,i,Ver); DW(68,i,Ver); end;
  289.          end;
  290.       6: begin
  291.          for i:=21 to 27 do DW(39,i,Ver);
  292.          end;
  293.       7: begin
  294.          for i:=16 to 20 do DW(39,i,Ver);
  295.          for i:=28 to 32 do DW(39,i,Ver);
  296.          end;
  297.       8: begin
  298.          for i:=35 to 43 do DW(i,24,Hor);
  299.          end;
  300.       9: begin
  301.          for i:=30 to 34 do DW(i,24,Hor);
  302.          for i:=44 to 48 do DW(i,24,Hor);
  303.          end;
  304.      10: begin
  305.          for i:=35 to 43 do begin DW(i,7,Hor); DW(i,41,Hor); end;
  306.          end;
  307.      11: begin
  308.          for i:=30 to 34 do begin DW(i,7,Hor); DW(i,41,Hor); end;
  309.          for i:=44 to 48 do begin DW(i,7,Hor); DW(i,41,Hor); end;
  310.          end;
  311.       end; { case Room }
  312.     until Barrier=0;
  313.   end;
  314.  
  315. procedure ClearVariables;
  316.   var i,j : integer;
  317.   begin
  318.   for i:=1 to 2 do
  319.     begin lng[i]:=0; lplus[i]:=20; pntr[i]:=1; EndFlag[i]:=False;
  320.           ydir[i]:=0; xdir[i]:=3-i*2; showturnsflag:=true;
  321.           showscoreflag[i]:=true; showlenflag[i]:=true;
  322.           for j:=1 to 200 do begin snk[i,j].x:=0;snk[i,j].y:=0; end;
  323.           end;
  324.   snk[1,1].y:=24;snk[2,1].y:=24;snk[1,1].x:=8;snk[2,1].x:=70;
  325.   OldCode:=77;OldestCode:=77;Code:=77;
  326.   for i:=1 to 3 do
  327.     with Gold[i] do
  328.       begin class:=0;gx:=0;gy:=0;size:=0;dir:=0; end;
  329.   MoveWallFlag:=False;
  330.   MWInfo.mwxdir:=0; MWInfo.mwydir:=0;
  331.   MWInfo.mwleng:=0; MWInfo.mwpntr:=1;
  332.   for i:=1 to 35 do begin Mow[i].mwx:=0; Mow[i].mwy:=0; end;
  333.   ExitFlag:=False;
  334.   end;
  335.  
  336. procedure ShowScore;
  337.   var k : longint;
  338.       b : word;
  339.       i : integer;
  340.   procedure WRN(x,y,n : integer);
  341.     begin PutImage(x,y,Numbers[n]^,NormalPut); end;
  342.   begin
  343.     if scr[1]>scr[2] then setfillstyle(1,10) else
  344.     if scr[2]>scr[1] then setfillstyle(1,12) else
  345.                           setfillstyle(1,0);
  346.     FloodFill(596,330,Magenta);
  347.     for i:=1 to 2 do
  348.       begin
  349.      if ShowScoreFlag[i]=True then
  350.       begin
  351.       b:=242+30*i; k:=scr[i];
  352.       if k>999999 then begin k:=k-999999;SetPalette(Yellow,Random(63)+1);end;
  353.       WRN(566,b,k div 100000);k:=k mod 100000;
  354.       WRN(576,b,k div 10000) ;k:=k mod 10000;
  355.       WRN(586,b,k div 1000)  ;k:=k mod 1000;
  356.       WRN(596,b,k div 100)   ;k:=k mod 100;
  357.       WRN(606,b,k div 10)    ;k:=k mod 10;
  358.       WRN(616,b,k);
  359.       ShowScoreFlag[i]:=False;
  360.       end;
  361.      if ShowTurnsFlag=True then
  362.       begin
  363.       b:=569+36*(i-1); k:=trn[i];
  364.       WRN(b-1,26,k div 10);k:=k mod 10;WRN(b+10,26,k);
  365.       if i=2 then ShowTurnsFlag:=False;
  366.       end;
  367.      if ShowLenFlag[i]=True then
  368.       begin
  369.       b:=570+36*(i-1);k:=lng[i];
  370.       if LenToWin=150 then k:=Round(k*1.34);
  371.       if LenToWin=100 then k:=k*2;
  372.       SetFillStyle(InterLeaveFill,DarkGray);Bar(565+(i-1)*36,58,590+(i-1)*36,263);
  373.       SetFillStyle(SolidFill,8+i*2);SetColor(i*2);Bar3D(b,262-k,b+14,262,2,True);
  374.       Line(b+15,262-k,b+15,262);
  375.       ShowLenFlag[i]:=False;
  376.       if (lng[i]<2) and (lplus[i]=0) then EndFlag[i]:=True;
  377.       if lng[i]>LenToWin-1 then EndFlag[3-i]:=True;
  378.       end else delay(8);
  379.      end;
  380.   end;
  381.  
  382. procedure PauseGame;
  383.   var c : char;
  384.   begin
  385.   nosound;
  386.   SetTextStyle(SmallFont,HorizDir,4);SetColor(White);
  387.   OutTextXY(10,341,'Game Paused --- Press F4 to continue');
  388.   repeat
  389.     if keypressed then c:=readkey;
  390.     if c=#0 then c:=readkey;
  391.   until ord(c)=62;
  392.   SetFillStyle(1,0);SetColor(0);Bar(10,342,225,349);
  393.   end;
  394.  
  395. procedure Change(ObjNum : byte);
  396.   begin
  397.   with Gold[ObjNum] do
  398.     begin
  399.     if Size=0 then
  400.       begin
  401.       if random(25)=0 then begin Class:=PS; Tune:=10; end else
  402.          if random(2)=0 then Class:=SB else Class:=LB;
  403.       Dir:=incr; Size:=1;
  404.       repeat
  405.         gx:=random(79);gy:=random(49);
  406.       until (PF[gx,gy]=Sp);
  407.       PF[gx,gy]:=Bl;
  408.       if Class<>PS then PutImage(gx*7,gy*7,BallIm[Class,Size]^,NormalPut)
  409.                    else PutImage(gx*7,gy*7,Sib^,NormalPut);
  410.       end
  411.     else
  412.       begin
  413.       if (Size=4) and (Dir=incr) then Dir:=decr;
  414.       if (Size=1) and (Dir=decr) then
  415.         begin Size:=0;if Class=PS then Tune:=11;
  416.         Class:=0;Dir:=0;if PF[gx,gy]=Bl then begin
  417.         PutImage(gx*7,gy*7,Null^,NormalPut);PF[gx,gy]:=Sp;end; end
  418.       else
  419.         begin
  420.         if Dir=incr then Size:=Size+1;
  421.         if Dir=decr then Size:=Size-1;
  422.         if (Class=SB) or (Class=LB) then
  423.              PutImage(gx*7,gy*7,BallIm[Class,Size]^,NormalPut);
  424.         end; {else 2}
  425.       end; {else 1}
  426.     end; {with}
  427.   end;   {proc}
  428.  
  429. procedure MoveSib(ObjNum : byte);
  430.   var zx,zy : byte;
  431.   begin
  432.   zx:=Gold[ObjNum].gx+(Random(3)-1);
  433.   zy:=Gold[ObjNum].gy+(Random(3)-1);
  434.   if PF[zx,zy]=Sp then
  435.     begin
  436.     PF[Gold[ObjNum].gx,Gold[ObjNum].gy]:=Sp;
  437.     PutImage(Gold[ObjNum].gx*7,Gold[ObjNum].gy*7,Null^,NormalPut);
  438.     Gold[ObjNum].gx:=zx;
  439.     Gold[ObjNum].gy:=zy;
  440.     PutImage(zx*7,zy*7,Sib^,NormalPut);
  441.     PF[zx,zy]:=Bl;
  442.     end;
  443.   end;
  444.  
  445. procedure MoveYou;
  446.   var nx,ny,ox,oy,tx,ty,c : byte;
  447.       tail : integer;
  448.  
  449.   procedure GetBall(aa,bb: byte);
  450.     var bonusl,bonuss : byte;
  451.     i, ObN: integer;
  452.     begin
  453.     BonusS:=0; BonusL:=0;
  454.     for i:=1 to 3 do
  455.       with Gold[i] do begin
  456.         if (aa=gx) and (bb=gy) and (size>0) then ObN:=i;
  457.         end;
  458.     with Gold[ObN] do
  459.       begin
  460.       if Class=SB then begin BonusS:=Size*20;
  461.                              BonusL:=0; Tune:=1; end;
  462.       if Class=LB then begin BonusL:=Size*2;
  463.                              BonusS:=0; Tune:=2; end;
  464.       if Class=PS then begin BonusS:=100;
  465.                              BonusL:=10; Tune:=3; end;
  466.       Lplus[You]:=Lplus[You]+BonusL;
  467.       if BonusS>0 then begin scr[You]:=scr[You]+BonusS;
  468.                              ShowScoreFlag[You]:=True; end;
  469.       Gx:=0; Gy:=0; Size:=0; Class:=0;
  470.       end;
  471.     end;
  472.  
  473.   begin
  474.   OX:=snk[You,Pntr[You]].x; OY:=snk[You,Pntr[You]].y;
  475.   NX:=OX+XDir[1]          ; NY:=OY+YDir[1]          ;
  476.   Tail:=Pntr[You]-lng[You]; if Tail<1 then Tail:=Tail+200;
  477.   TX:=snk[You,Tail].x     ; TY:=snk[You,Tail].y     ;
  478.   case OldestCode of
  479.     72 : if Code=72 then PutImage(OX*7,OY*7,LineIm[ML,Ver]^,NormalPut) else
  480.          if Code=77 then PutImage(OX*7,OY*7,LineIm[ML,TLCor]^,NormalPut) else
  481.          if Code=75 then PutImage(OX*7,OY*7,LineIm[ML,TRCor]^,NormalPut);
  482.     80 : if Code=80 then PutImage(OX*7,OY*7,LineIm[ML,Ver]^,NormalPut) else
  483.          if Code=77 then PutImage(OX*7,OY*7,LineIm[ML,BLCor]^,NormalPut) else
  484.          if Code=75 then PutImage(OX*7,OY*7,LineIm[ML,BRCor]^,NormalPut);
  485.     77 : if Code=72 then PutImage(OX*7,OY*7,LineIm[ML,BRCor]^,NormalPut) else
  486.          if Code=80 then PutImage(OX*7,OY*7,LineIm[ML,TRCor]^,NormalPut) else
  487.          if Code=77 then PutImage(OX*7,OY*7,LineIm[ML,Hor]^,NormalPut);
  488.     75 : if Code=72 then PutImage(OX*7,OY*7,LineIm[ML,BLCor]^,NormalPut) else
  489.          if Code=80 then PutImage(OX*7,OY*7,LineIm[ML,TLCor]^,NormalPut) else
  490.          if Code=75 then PutImage(OX*7,OY*7,LineIm[ML,Hor]^,NormalPut);
  491.     end; { case OldestCode }
  492.   c:=PF[NX,NY];
  493.   if c=Bl then GetBall(nx,ny);
  494.   if (c=W) or (c=MW) or (c=ML) or (c=IBML) then
  495.     begin
  496.     lng[you]:=lng[you]-1;Tune:=7;
  497.     ShowLenFlag[you]:=True;
  498.     end
  499.   else begin
  500.   Pntr[You]:=Pntr[You]+1; if Pntr[You]>200 then Pntr[You]:=1;
  501.   snk[You,Pntr[You]].x:=NX;snk[You,Pntr[You]].y:=NY;
  502.   PF[NX,NY]:=ML;
  503.   if (Code=72) or (Code=80) then PutImage(NX*7,NY*7,LineIm[ML,Ver]^,NormalPut)
  504.     else PutImage(NX*7,NY*7,LineIm[ML,Hor]^,NormalPut);
  505.   end; {else}
  506.   if Lplus[You]>0 then
  507.       begin Lplus[You]:=Lplus[You]-1;Lng[You]:=Lng[You]+1;
  508.         ShowLenFlag[you]:=True; end
  509.   else
  510.     begin
  511.     PF[TX,TY]:=Sp;
  512.     PutImage(TX*7,TY*7,Null^,NormalPut);
  513.     end;
  514.   end;
  515.  
  516. procedure MoveIBM;
  517.   var ox,oy,nx,ny,tx,ty : byte;
  518.       gex,gey      : byte;
  519.       LoWa              : array[0..3] of byte;
  520.       Dngr              : array[0..3] of boolean;
  521.       j,Tail            : integer;
  522.       IBMFindsGem       : boolean;
  523.       DeadEnd           : boolean;
  524.       NewDir,OldDir     : byte;
  525.  
  526.   function Best(wx,wy: byte): byte;
  527.     var Up,Down,Left,Right,a,b : integer;
  528.     function Dist(ddx,ddy: integer): byte;
  529.       var ij: integer;
  530.       begin
  531.       ij:=0;
  532.       while (PF[a,b]=Sp) or (PF[a,b]=Bl)
  533.          do begin ij:=ij+1;a:=a+ddx;b:=b+ddy; end;
  534.       Dist:=ij;
  535.       end;
  536.     begin
  537.     a:=wx;b:=wy-1;Up:=Dist(0,-1);
  538.     a:=wx;b:=wy+1;Down:=Dist(0,1);
  539.     a:=wx-1;b:=wy;Left:=Dist(-1,0);
  540.     a:=wx+1;b:=wy;Right:=Dist(1,0);
  541.     if (Up>=Down) and (Up>=Left) and (Up>=Right) then Best:=0;
  542.     if (Down>=Up) and (Down>=Left) and (Down>=Right) then Best:=1;
  543.     if (Left>=Up) and (Left>=Down) and (Left>=Right) then Best:=2;
  544.     if (Right>=Up) and (Right>=Down) and (Right>=Left) then Best:=3;
  545.     end;
  546.  
  547.   procedure IBMGetsGold(aa,bb : byte);
  548.     var bonusl,bonuss : byte;
  549.     i, ObN : integer;
  550.     begin
  551.     ObN:=0; BonusL:=0; BonusS:=0;
  552.     for i:=1 to 3 do
  553.      if (aa=Gold[i].gx) and (bb=Gold[i].gy) and (Gold[i].size>0) then ObN:=i;
  554.     if ObN>0 then
  555.       begin
  556.       if Gold[ObN].Class=SB then begin BonusS:=Gold[ObN].Size*20;
  557.                              BonusL:=0;Tune:=4;end;
  558.       if Gold[ObN].Class=LB then begin BonusL:=Gold[ObN].Size*2;
  559.                              BonusS:=0;Tune:=5;end;
  560.       if Gold[ObN].Class=PS then begin BonusS:=100;
  561.                              BonusL:=10;Tune:=6;end;
  562.       Lplus[IBM]:=Lplus[IBM]+BonusL;
  563.       if BonusS>0 then begin scr[IBM]:=scr[IBM]+BonusS;
  564.                              ShowScoreFlag[IBM]:=True; end;
  565.       PF[Gold[ObN].gx,Gold[ObN].gy]:=Sp;
  566.       Gold[ObN].size:=0; Gold[ObN].Class:=0;
  567.       end;
  568.     end;
  569.  
  570.   begin
  571.     OX:=snk[IBM,Pntr[IBM]].x; OY:=snk[IBM,Pntr[IBM]].y;
  572.     Tail:=Pntr[IBM]-lng[IBM]; if Tail<1 then Tail:=Tail+200;
  573.     TX:=snk[IBM,Tail].x;      TY:=snk[IBM,Tail].y;
  574.     if XDir[IBM]=0 then
  575.       if YDir[IBM]=-1 then OldDir:=0 else OldDir:=1;
  576.     if YDir[IBM]=0 then
  577.       if XDir[IBM]=-1 then OldDir:=2 else OldDir:=3;
  578.     LoWa[0]:=PF[ox,oy-1]; LoWa[1]:=PF[ox,oy+1];
  579.     LoWa[2]:=PF[ox-1,oy]; LoWa[3]:=PF[ox+1,oy];
  580.     for j:=0 to 3 do
  581.       if (Lowa[j]=W) or (Lowa[j]=MW) or (Lowa[j]=ML) or (Lowa[j]=IBML)
  582.       then Dngr[j]:=True
  583.       else Dngr[j]:=False;
  584.     if (Dngr[0]=True) and (Dngr[1]=True) and
  585.        (Dngr[2]=True) and (Dngr[3]=True)
  586.     then begin ShowLenFlag[IBM]:=True; DeadEnd:=True; end
  587.     else
  588.       begin
  589.       IBMFindsGem:=False; DeadEnd:=False;
  590.       for j:=1 to 3 do if Gold[j].size>0 then
  591.         begin
  592.         GeX:=Gold[j].gx; Gey:=Gold[j].gy;
  593.         if (OX=Gex) and (OY>Gey) and (Dngr[0]=False)
  594.           then begin NewDir:=0; IBMFindsGem:=True; end;
  595.         if (OX=Gex) and (OY<Gey) and (Dngr[1]=False)
  596.           then begin NewDir:=1; IBMFindsGem:=True; end;
  597.         if (OX>Gex) and (OY=Gey) and (Dngr[2]=False)
  598.           then begin NewDir:=2; IBMFindsGem:=True; end;
  599.         if (OX<Gex) and (OY=Gey) and (Dngr[3]=False)
  600.           then begin NewDir:=3; IBMFindsGem:=True; end;
  601.         end;
  602.       if IBMFindsGem=False then
  603.         if (Random(30)=1) or
  604.            (Dngr[OldDir]=True)
  605.         then
  606.           if Random(7)<>1 then NewDir:=Best(OX,OY)
  607.           else repeat NewDir:=Random(4) until Dngr[NewDir]=False;
  608.       case NewDir of
  609.         0: begin
  610.            case OldDir of
  611.            0: PutImage(OX*7,OY*7,LineIm[IBML,Ver]^,NormalPut);
  612.            2: PutImage(OX*7,OY*7,LineIm[IBML,BLCor]^,NormalPut);
  613.            3: PutImage(OX*7,OY*7,LineIm[IBML,BRCor]^,NormalPut);
  614.               end;
  615.            XDir[IBM]:=0; YDir[IBM]:=-1;
  616.            end;
  617.         1: begin
  618.            case OldDir of
  619.            1: PutImage(OX*7,OY*7,LineIm[IBML,Ver]^,NormalPut);
  620.            2: PutImage(OX*7,OY*7,LineIm[IBML,TLCor]^,NormalPut);
  621.            3: PutImage(OX*7,OY*7,LineIm[IBML,TRCor]^,NormalPut);
  622.               end;
  623.            XDir[IBM]:=0; YDir[IBM]:=1 ;
  624.            end;
  625.         2: begin
  626.            case OldDir of
  627.            0: PutImage(OX*7,OY*7,LineIm[IBML,TRCor]^,NormalPut);
  628.            1: PutImage(OX*7,OY*7,LineIm[IBML,BRCor]^,NormalPut);
  629.            2: PutImage(OX*7,OY*7,LineIm[IBML,Hor]^,NormalPut);
  630.               end;
  631.            XDir[IBM]:=-1;YDir[IBM]:=0 ;
  632.            end;
  633.         3: begin
  634.            case OldDir of
  635.            0: PutImage(OX*7,OY*7,LineIm[IBML,TLCor]^,NormalPut);
  636.            1: PutImage(OX*7,OY*7,LineIm[IBML,BLCor]^,NormalPut);
  637.            3: PutImage(OX*7,OY*7,LineIm[IBML,Hor]^,NormalPut);
  638.               end;
  639.            XDir[IBM]:=1; YDir[IBM]:=0 ;
  640.            end;
  641.         end; { case NewDir }
  642.      if (IBMFindsGem=True) and (Lowa[NewDir]=Bl)
  643.           then IBMGetsGold(OX+XDir[IBM],OY+YDir[IBM]);
  644.     NX:=OX+XDir[IBM]; NY:=OY+YDir[IBM];
  645.     Pntr[IBM]:=Pntr[IBM]+1;if Pntr[IBM]>200 then Pntr[IBM]:=Pntr[IBM]-200;
  646.     snk[IBM,Pntr[IBM]].x:=NX; snk[IBM,Pntr[IBM]].y:=NY;
  647.     PF[NX,NY]:=IBML;
  648.     if XDir[IBM]=0 then PutImage(NX*7,NY*7,LineIm[IBML,Ver]^,NormalPut)
  649.        else PutImage(NX*7,NY*7,LineIm[IBML,Hor]^,NormalPut);
  650.     end; { if no danger }
  651.     if Lplus[IBM]>0 then
  652.       begin Lplus[IBM]:=LPlus[IBM]-1;
  653.             if DeadEnd=False then Lng[IBM]:=Lng[IBM]+1;
  654.             ShowLenFlag[IBM]:=True; end
  655.       else
  656.       begin
  657.       PF[TX,TY]:=sp;
  658.       PutImage(TX*7,TY*7,Null^,NormalPut);
  659.       if DeadEnd=True then begin lng[IBM]:=lng[IBM]-1;Tune:=8;
  660.                                  ShowLenFlag[IBM]:=True;end;
  661.       end;
  662.   end;
  663.  
  664. procedure SetMoveWall;
  665.   var mwdir : byte;
  666.       x0,y0 : byte;
  667.   begin
  668.   MoveWallFlag:=True; Tune:=9;
  669.   MWInfo.mwpntr:=1;
  670.   MWDir:=random(4);
  671.   if (MWDir=0) and (snk[You,Pntr[You]].y>44) then MWDir:=1;
  672.   if (MWDir=1) and (snk[You,Pntr[You]].y<4 ) then MWDir:=0;
  673.   if (MWDir=2) and (snk[You,Pntr[You]].x<5 ) then MWDir:=3;
  674.   if (MWDir=3) and (snk[You,Pntr[You]].x>73) then MWDir:=2
  675.   ;
  676.   case MWDir of
  677.     0: begin MWInfo.mwxdir:=0 ; MWInfo.mwydir:=-1; end;
  678.     1: begin MWInfo.mwxdir:=0 ; MWInfo.mwydir:=1 ; end;
  679.     2: begin MWInfo.mwxdir:=-1; MWInfo.mwydir:=0 ; end;
  680.     3: begin MWInfo.mwxdir:=1 ; MWInfo.mwydir:=0 ; end;
  681.     end; {case MWDir}
  682.   if MWInfo.mwxdir=0 then MWInfo.mwleng:=Random(22)+3
  683.                      else MWInfo.mwleng:=Random(29)+7;
  684.   case MWDir of
  685.     0: begin x0:=Random(69)+5; y0:=48; end;
  686.     1: begin x0:=Random(69)+5; y0:=0 ; end;
  687.     2: begin x0:=78; y0:=Random(41)+4; end;
  688.     3: begin x0:=0 ; y0:=Random(41)+4; end;
  689.     end; {case MWDir}
  690.   Mow[1].mwx:=x0; Mow[1].mwy:=y0;
  691.   end;
  692.  
  693. procedure MoveWall;
  694.   var OX,OY,NX,NY,TX,TY,pix : byte;
  695.       Tail,i                : integer;
  696.   begin
  697.   OX:=Mow[MWInfo.mwpntr].mwx; OY:=Mow[MWInfo.mwpntr].mwy;
  698.   NX:=OX+MWInfo.mwxdir    ; NY:=OY+MWInfo.mwydir    ;
  699.   Tail:=MWInfo.mwpntr-MWinfo.mwleng+1;
  700.   if Tail<1 then Tail:=Tail+35;
  701.   if Tail>35 then Tail:=Tail-35;
  702.   TX:=Mow[Tail].mwx         ; TY:=Mow[Tail].mwy         ;
  703.   Pix:=PF[NX,NY];
  704.   if Pix<>Sp then MWInfo.mwleng:=MWInfo.mwleng-1
  705.     else
  706.       begin
  707.       PF[nx,ny]:=MW;
  708.       MWInfo.mwpntr:=MWInfo.mwpntr+1;
  709.       if MWInfo.mwpntr>35 then MWInfo.mwpntr:=1;
  710.       Mow[MWInfo.mwpntr].mwx:=NX;
  711.       Mow[MWInfo.mwpntr].mwy:=NY;
  712.       if MWInfo.mwxdir=0 then PutImage(NX*7,NY*7,LineIm[MW,Ver]^,NormalPut)
  713.                          else PutImage(NX*7,NY*7,LIneIm[MW,Hor]^,NormalPut);
  714.       end;
  715.   if (TX>0) and (TX<78) and (TY>0) and (TY<48) and (PF[tx,ty]=MW) then
  716.     begin
  717.     PF[TX,TY]:=Sp;
  718.     PutImage(TX*7,TY*7,Null^,NormalPut);
  719.     end;
  720.   if MWInfo.mwleng=0 then
  721.     begin
  722.     MoveWallFlag:=False;
  723.     for i:=1 to 30 do begin Mow[i].mwx:=0;Mow[i].mwy:=0;end;
  724.     end;
  725.   end;
  726.  
  727. procedure Play(Music: byte);
  728.   var i: integer;
  729.   begin
  730.   case Music of
  731.     1: Sound(1000+Counter*100);
  732.     2: Sound(500 +Counter*100);
  733.     3: case Counter of
  734.        0: sound(1000); 1: sound(500); 2: sound(1500);
  735.        3: sound(750);  4: sound(1250);5: sound(1000);
  736.        end;
  737.     4: Sound(1500-Counter*100);
  738.     5: Sound(1000-Counter*100);
  739.     6: case Counter of
  740.        0: sound(500); 1: sound(300); 2: sound(700);
  741.        3: sound(400); 4: sound(600); 5: sound(500);
  742.        end;
  743.     7: sound(300+Random(100));
  744.     8: sound(100+Random(100));
  745.     9: case Counter of 0: sound(100); 1: sound(120); 2: sound(100);
  746.        3: sound(120); 4: sound(100); 5: sound(120); end;
  747.    10: sound(1600+10*Counter);
  748.    11: sound(1650-300*Counter);
  749.    12: case Counter of 0: sound(600); 1: sound(800); 2: sound(400);
  750.        3: sound(800); 4: sound(200); 5: sound(800); 6: sound(750);
  751.        7: sound(700); 8: sound(650); 9: sound(600); end;
  752.    13: case Counter of 0: sound(100); 1: sound(50); 2: sound(100);
  753.        3: sound(50); 4: sound(200); 5: sound(175); 6: sound(150);
  754.        7: sound(125); 8: sound(100); 9: sound(50); end;
  755.   end; { case }
  756.   Counter:=Counter+1;
  757.   if Counter>MaxCounter then begin Counter:=0; Tune:=0; nosound; end;
  758.   end;
  759.  
  760. procedure GlobalInit;
  761.   begin
  762.   Message[1]:='YOU WILL BE DESTROYED!';
  763.   Message[2]:='TRUST YOUR FEELINGS!';
  764.   Message[3]:='MAY THE FORCE BE WITH YOU!';
  765.   Message[4]:='USE THE FORCE, LUKE!';
  766.   Message[5]:='WAKE UP! IT''S TIME TO DIE!';
  767.   Message[6]:='WORKERS OF ALL COUNTRIES, UNITE!';
  768.   Message[7]:='LIFE IS LIVE, TROFF IS TROFF ...';
  769.   Message[8]:='WELCOME TO MY NIGHTMARE (NIGHTWARE OR SOFTMARE) !';
  770.   Message[9]:='MEOW !';
  771.   Message[10]:='YOU''D BETTER PLAY SIERRA GAMES!';
  772.   Message[11]:='YOU ARE SO BRIGHT!';
  773.   Message[12]:='YOU''LL BE THE HERO OF THE SOVIET UNION!';
  774.   Message[13]:='TRY TO WRITE "TROFF - 3" IF YOU''RE SO CLEVER!';
  775.   Message[14]:='GRATEFUL PEOPLE WILL BUILD A STATUE OF YOU!';
  776.   Message[15]:='SEE YOU LATER. TERMINATOR.';
  777.   Message[16]:='IT''S A CATASTROFF!';
  778.   Message[17]:='HAVE A NICE DEATH!';
  779.   Message[18]:='TROFF IS TOO HARD FOR YOU. TRY TO PLAY CLIPPER';
  780.   Message[19]:='TROFF II IS FOR ABSTINENTS ONLY';
  781.   Message[20]:='NO CHANCE!';
  782.   MessageFlag:=0;
  783.   scr[1]:=0; scr[2]:=0;
  784.   trn[1]:=0; trn[2]:=0;
  785.   Tune:=0; Counter:=0;
  786.   ToggleSound:=True;
  787.   MaxTrn:=3;
  788.   Speed:=30;
  789.   MaxCounter:=5;
  790.   EnemyToggle:=True;
  791.   MWallToggle:=100;
  792.   LenToWin:=200;
  793.   Bonus[1]:=0; Bonus[2]:=0;
  794.   GameNo:=0;
  795.   Hisco:=0; Losco:=0; Hipla:=2; Lopla:=2;
  796.   end;
  797.  
  798. procedure PrintMessage(MN : byte);
  799.   begin
  800.     SetColor(Cyan);SetTextStyle(SmallFont,HorizDir,4);
  801.     OutTextXY(550-TextWidth(Message[MN]),341,Message[MN]);
  802.   end;
  803.  
  804. procedure Destroy(Player : byte);
  805.   var p, st, en : byte;
  806.       tail : integer;
  807.   begin
  808.   en:=Pntr[Player];
  809.   Tail:=en-lng[Player]-1;
  810.   if Tail<1 then Tail:=Tail+200;
  811.   st:=Tail;
  812.   p:=st;
  813.   repeat
  814.     p:=p+1; if p>200 then p:=1;
  815.     if ToggleSound=True then sound(Random(500)+Player*500);Delay(10);
  816.     PutImage(snk[Player,p].x*7,snk[Player,p].y*7,Null^,NormalPut);
  817.   until p=en;
  818.   nosound;
  819.   end;
  820.  
  821. procedure ShowNote;
  822.   begin
  823.   PutImage(631,0,Note^,XORPut);
  824.   end;
  825.  
  826. procedure DeleteScreen;
  827.   var i : integer;
  828.   begin SetColor(1+Random(15)); nosound;
  829.   for i:=0 to 319 do Rectangle(i,i-145,639-i,494-i);
  830.   SetColor(Black);
  831.   for i:=0 to 319 do Rectangle(i,i-145,639-i,494-i);
  832.   end;
  833.  
  834. procedure CalcBonus;
  835.   var i : integer;
  836.   begin
  837.   Bonus[1]:=0; Bonus[2]:=0;
  838.   for i:=1 to 2 do if EndFlag[3-i]=True then
  839.     begin
  840.     Bonus[i]:=lng[i];
  841.     case MWallToggle of
  842.       300: Bonus[i]:=Bonus[i]+25;
  843.       100: Bonus[i]:=Bonus[i]+50;
  844.         0: Bonus[i]:=Bonus[i]+100;
  845.         end; {case}
  846.     Bonus[i]:=Bonus[i]+(50-Speed)*4;
  847.     if EnemyToggle=True then Bonus[i]:=Round(Bonus[i]*3);
  848.     end;
  849.   end;
  850.  
  851. procedure ShowHighScore;
  852.   function st(l:longint):string;
  853.     var s: string;
  854.     begin
  855.     str(l,s);
  856.     case length(s) of
  857.       1: st:='0000000'+s; 2: st:='000000'+s; 3: st:='00000'+s;
  858.       4: st:='0000'+s; 5: st:='000'+s; 6: st:='00'+s; 7: st:='0'+s;
  859.       8: st:=s; end;
  860.     end;
  861.   procedure Pr(xi,yi: word; strn: string; s1,c1,s2,c2: byte; fo,si: word);
  862.     var u,v : integer;
  863.     begin
  864.     SetColor(c1); SetTextStyle(fo,HorizDir,si);
  865.     for u:=xi-s1 to xi+s1 do
  866.       for v:=yi-s1 to yi+s1 do
  867.         OutTextXY(u,v,strn);
  868.     SetColor(c2);
  869.     for u:=xi-s2 to xi do
  870.       for v:=yi-s2 to yi+s2 do
  871.         OutTextXY(u,v,strn);
  872.     end;
  873.   begin
  874.     Pr(235,10,'Troff II',5,LightBlue,4,Blue,SmallFont,15);
  875.     SetFillStyle(SolidFill,Brown);SetColor(Yellow);
  876.     Bar3D(0,10,180,55,5,True); Bar3D(450,10,630,55,5,True);
  877.     SetTextStyle(SmallFont,HorizDir,7);SetColor(LightRed);
  878.     OutTextXY(32,9,'High Score');OutTextXY(490,9,'Low Score');
  879.     SetColor(Yellow);
  880.     OutTextXY(31,10,'High Score');OutTextXY(489,10,'Low Score');
  881.     SetTextStyle(SmallFont,HorizDir,5);
  882.     if Hipla=1 then
  883.       Pr((180-TextWidth(st(Hisco))) div 2 -15,26,st(Hisco),1,0,0,10,1,3)
  884.       else Pr((180-TextWidth(st(Hisco))) div 2 -15,26,st(Hisco),1,0,0,12,1,3);
  885.     if Lopla=1 then
  886.       Pr(455+((180-TextWidth(st(Losco))) div 2),26,st(Losco),1,0,0,10,1,3)
  887.       else Pr(455+((180-TextWidth(st(Losco))) div 2),26,st(Losco),1,0,0,12,1,3);
  888.   end;
  889.  
  890. procedure PressSpaceBar;
  891.   var chch : char;
  892.   begin
  893.   SetTextStyle(SmallFont,HorizDir,4);
  894.   SetUserCharSize(1,1,1,1);
  895.   SetColor(White);
  896.   OutTextXY(522,325,'Press Space Bar ...');
  897.   repeat
  898.     chch:=ReadKey;
  899.   until chch=#32;
  900.   end;
  901.  
  902. procedure StatusScreen;
  903.   var Mes: array[1..10] of string;
  904.         w: integer;
  905.   function ss1(l:longint):string;
  906.     var s:string;begin str(l,s);
  907.     if length(s)=1 then ss1:='0'+s else ss1:=s;end;
  908.   function ss2(l:longint):string;var s:string;begin str(l,s);ss2:=s;end;
  909.   procedure Pri(xi,yi:word;stri:string;ci1,ci2:word);
  910.     begin
  911.     SetColor(ci2);
  912.     OutTextXY(xi+2,yi-2,stri);OutTextXY(xi+1,yi-1,stri);
  913.     SetColor(ci1);
  914.     OutTextXY(xi,yi,stri);
  915.     end;
  916.   begin
  917.   Mes[1]:='Turns to win'; Mes[2]:='Enemy Snake';
  918.   Mes[3]:='Moving walls'; Mes[4]:='Max.Snake Length';
  919.   Mes[5]:='Speed'       ; Mes[6]:='Sound';
  920.   Mes[7]:='Winner :'    ; Mes[8]:='Score:';
  921.   Mes[9]:='Bonus:'      ; Mes[10]:='Total:';
  922.   ShowHighScore;
  923.   SetLineStyle(0,0,3);
  924.   SetColor(DarkGray); Rectangle(4,62,638,335);
  925.   SetColor(LightGray);Rectangle(0,65,634,338);
  926.   GameNo:=GameNo+1;
  927.   SetTextStyle(SansSerifFont,HorizDir,2);
  928.   pri(280,67,'Game '+ss1(GameNo),Yellow,Brown);
  929.   SetUserCharSize(2,1,1,1);
  930.   pri(140,67,ss1(trn[1]),LightGreen,Green);
  931.   pri(440,67,ss1(trn[2]),LightRed,Red);
  932.   SetUserCharSize(1,1,1,2);
  933.   SetColor(Brown);Line(262,92,382,92);
  934.   SetColor(Yellow);Line(260,94,380,94);
  935.   SetLineStyle(0,0,1);
  936.   for w:=1 to 6 do
  937.     pri(300-TextWidth(Mes[w]),80+w*20,Mes[w],LightGray,DarkGray);
  938.   pri(340,100,ss1(MaxTrn),13,5);
  939.   if EnemyToggle=True then pri(340,120,'On',13,5)
  940.                       else pri(340,120,'Off',13,5);
  941.   case MWallToggle of
  942.     -1: pri(340,140,'Off',13,5);
  943.    300: pri(340,140,'Seldom',13,5);
  944.    100: pri(340,140,'Often',13,5);
  945.      0: pri(340,140,'Always',13,5);
  946.      end;
  947.   pri(340,160,ss1(LenToWin),13,5);
  948.   pri(340,180,ss1(Speed),13,5);
  949.     case Speed of
  950.     0: pri(390,180,'(Madness)',13,5);
  951.     1..10: pri(390,180,'(Very Fast)',13,5);
  952.     11..20: pri(390,180,'(Fast)',13,5);
  953.     21..30: pri(390,180,'(Normal)',13,5);
  954.     31..40: pri(390,180,'(Slow)',13,5);
  955.     41..50: pri(390,180,'(Very Slow)',13,5);
  956.     end;
  957.   if ToggleSound=True then pri(340,200,'On',13,5)
  958.                       else pri(340,200,'Off',13,5);
  959.   SetTextStyle(GothicFont,HorizDir,3);SetUserCharSize(2,1,1,1);
  960.   pri(300-TextWidth(Mes[7]),220,Mes[7],LightCyan,Cyan);
  961.   if EndFlag[IBM]=True then pri(340,220,'You',LightGreen,Green);
  962.   if EndFlag[You]=True then pri(340,220,'mr.Troff',LightRed,Red);
  963.   SetTextStyle(SansSerifFont,HorizDir,3); SetUserCharSize(1,1,1,2);
  964.   for w:=8 to 10 do pri(40,100+w*20,Mes[w],Black,Brown);
  965.   for w:=1 to 2 do begin
  966.     pri(75+175*w,260,ss2(scr[w]),8+2*w,2*w);
  967.     pri(75+175*w,280,ss2(bonus[w]),8+2*w,2*w);
  968.     scr[w]:=scr[w]+bonus[w];
  969.     pri(75+175*w,300,ss2(scr[w]),8+2*w,2*w);
  970.     end;
  971.     PressSpaceBar;
  972.   end;
  973.  
  974. procedure GameOver;
  975. var i,xj,yj,cj: integer;
  976.     mess : array[1..6] of string;
  977.     hsc,lsc : longint;
  978.     hpl,lpl : byte;
  979.   function ss3(l:longint):string;
  980.     var s:string;
  981.     begin str(l,s);
  982.     if length(s)=1 then ss3:='0'+s else ss3:=s;
  983.     end;
  984.   function ss4(l:longint):string;
  985.     var s,n:string;
  986.     begin str(l,s);
  987.     n:='00000000';
  988.     if length(s)=8 then ss4:=s else
  989.       ss4:=copy(n,1,8-length(s))+s;
  990.     end;
  991.   procedure prin(xl,yl:word;strin:string;cl1,cl2,cl3:word);
  992.     begin
  993.     SetColor(cl3);OutTextXY(xl+2,yl-2,strin);
  994.     SetColor(cl2);OutTextXY(xl+1,yl-1,strin);
  995.     SetColor(cl1);OutTextXY(xl,yl,strin);
  996.     end;
  997.   begin
  998.   mess[1]:='GAME OVER'; mess[2]:='You'; mess[3]:='mr.Troff';
  999.   mess[4]:='The Winner:'; mess[5]:='New High Score'; mess[6]:='New Low Score';
  1000.   for i:=0 to 500 do begin cj:=Random(15)+1;SetColor(cj);
  1001.     xj:=Random(640);yj:=Random(350);
  1002.     if Random(20)=1 then begin Line(xj-2,yj,xj+2,yj);Line(xj,yj-2,xj,yj+2);end;
  1003.     if Random(10)=1 then begin Line(xj-1,yj,xj+1,yj);Line(xj,yj-1,xj,yj+1);end;
  1004.     PutPixel(xj,yj,cj);end;
  1005.   SetTextStyle(SansSerifFont,HorizDir,5);SetColor(Yellow);
  1006.   OutTextXY(195,100,mess[1]);
  1007.   for i:=1 to 2 do begin SetColor(8+2*i);
  1008.     SetTextStyle(TriplexFont,HorizDir,5);
  1009.     OutTextXY(220-TextWidth(mess[1+i]),130+40*i,mess[1+i]);
  1010.     SetTextStyle(GothicFont,HorizDir,5);
  1011.     prin(250,130+40*i,ss3(trn[i]),Yellow,Brown,Red);
  1012.     SetTextStyle(SmallFont,HorizDir,12);
  1013.     prin(330,135+40*i,ss4(scr[i]),8+2*i,Black,2*i);
  1014.     end;
  1015.     SetTextStyle(SmallFont,HorizDir,14);
  1016.     prin(185,260,mess[4],White,LightGray,DarkGray);
  1017.     if Trn[You]=MaxTrn then prin(270,300,mess[2],Cyan,LightCyan,Cyan)
  1018.        else prin(220,300,mess[3],Magenta,LightMagenta,Magenta);
  1019.     if scr[You]>=scr[IBM] then
  1020.       begin hsc:=scr[You]; lsc:=scr[IBM];
  1021.             hpl:=You; lpl:=IBM; end
  1022.     else
  1023.       begin hsc:=scr[IBM]; lsc:=scr[You];
  1024.             hpl:=IBM; lpl:=You; end;
  1025.     SetTextStyle(SmallFont,HorizDir,4);
  1026.     if hsc>=hisco then
  1027.       begin hisco:=hsc; hipla:=hpl;
  1028.       prin(540,145+42*hpl,mess[5],LightCyan,LightBlue,Blue);end;
  1029.     if (FirstGameFlag=True) or (lsc<=losco) then
  1030.       begin FirstGameFlag:=False;
  1031.       losco:=lsc; lopla:=lpl;
  1032.       prin(540,145+42*lpl,mess[6],LightCyan,LightMagenta,Magenta);end;
  1033.     ShowHighScore;
  1034.     PressSpaceBar;
  1035.   end;
  1036.  
  1037. procedure SetGameOptions;
  1038.   label 224;
  1039.   var MS : array[1..8] of string;
  1040.        i : integer;
  1041.      chx : char;
  1042.       cd : byte;
  1043.   procedure print(prx,pry:word;prs:string;prc1,prc2:word);
  1044.     begin
  1045.     SetColor(prc2);
  1046.     OutTextXY(prx+3,pry-3,prs); OutTextXY(prx+2,pry-2,prs); OutTextXY(prx+1,pry-1,prs);
  1047.     SetColor(prc1);
  1048.     OutTextXY(prx,pry,prs);
  1049.     end;
  1050.   function ss0(l:integer):string;
  1051.     var s:string;begin str(l,s);ss0:=s;end;
  1052.   procedure enter(fld: byte);
  1053.     var j: integer;
  1054.     begin
  1055.     case fld of
  1056.       1: begin SetColor(White);
  1057.          for j:=1 to 12 do begin
  1058.          Rectangle(240+j*25,84,264+j*25,110);
  1059.          if j<=MaxTrn then SetFillStyle(InterLeaveFill,LightRed)
  1060.                       else SetFillStyle(InterLeaveFill,DarkGray);
  1061.          FloodFill(241+j*25,85,White);
  1062.          end; end;
  1063.       2: if EnemyToggle=True then
  1064.            begin print(290,110,'On',LightRed,Red);
  1065.                  print(370,110,'Off',DarkGray,DarkGray);end
  1066.          else
  1067.            begin print(290,110,'On',DarkGray,DarkGray);
  1068.                  print(370,110,'Off',LightRed,Red);end;
  1069.       3: begin
  1070.          print(290,140,'Off',DarkGray,DarkGray);
  1071.          print(370,140,'Easy',DarkGray,DarkGray);
  1072.          print(450,140,'Med.',DarkGray,DarkGray);
  1073.          print(530,140,'Hard',DarkGray,DarkGray);
  1074.          case MWallToggle of
  1075.            -1: print(290,140,'Off',LightRed,Red);
  1076.           300: print(370,140,'Easy',LightRed,Red);
  1077.           100: print(450,140,'Med.',LightRed,Red);
  1078.             0: print(530,140,'Hard',LightRed,Red);end;
  1079.          end;
  1080.       4: for j:=0 to 2 do
  1081.            if LenToWin=100+j*50 then
  1082.                 print(370+80*j,170,ss0(100+50*j),LightRed,Red)
  1083.            else print(370+80*j,170,ss0(100+50*j),DarkGray,DarkGray);
  1084.       5: begin SetColor(White);SetFillStyle(InterLeaveFill,LightRed);
  1085.          Bar(299,207,601,227);Rectangle(299,207,601,227);
  1086.          SetFillStyle(InterLeaveFill,DarkGray);
  1087.          if Speed>0 then Bar(600-Speed*6,208,600,226);
  1088.          end;
  1089.       6: if ToggleSound=True then begin
  1090.            print(290,230,'On',LightRed,Red);
  1091.            print(370,230,'Off',DarkGray,DarkGray); end
  1092.          else begin
  1093.            print(290,230,'On',DarkGray,DarkGray);
  1094.            print(370,230,'Off',LightRed,Red); end;
  1095.     end; end;
  1096.   procedure Chan(fld:byte);
  1097.     begin
  1098.     case fld of
  1099.       1:begin if (chx=#75) and (MaxTrn>1) then MaxTrn:=MaxTrn-1;
  1100.               if (chx=#77) and (MaxTrn<12) then MaxTrn:=MaxTrn+1;end;
  1101.       2:EnemyToggle:=not EnemyToggle;
  1102.       3:if (chx=#75) then begin
  1103.           if MWallToggle=300 then MWallToggle:=-1;
  1104.           if MWallToggle=100 then MWallToggle:=300;
  1105.           if MWallToggle=0   then MWallToggle:=100; end
  1106.         else begin
  1107.           if MWallToggle=100 then MWallToggle:=0;
  1108.           if MWallToggle=300 then MWallToggle:=100;
  1109.           if MWallToggle=-1  then MWallToggle:=300; end;
  1110.       4: begin if (chx=#75) and (LenToWin>100) then LenToWin:=LenToWin-50;
  1111.           if (chx=#77) and (LenToWin<200) then LenToWin:=LenToWin+50; end;
  1112.       5: begin if (chx=#75) and (Speed<50) then Speed:=Speed+1;
  1113.           if (chx=#77) and (Speed>0) then Speed:=Speed-1; end;
  1114.       6: ToggleSound:=not ToggleSound;
  1115.     end;end;
  1116.   begin
  1117.     ShowHighScore;
  1118.     SetFillStyle(InterLeaveFill,DarkGray);SetColor(LightGray);
  1119.     Bar3D(0,70,633,349,5,True);
  1120.     MS[1]:='Turns To Win';
  1121.     MS[2]:='Enemy Snake';
  1122.     MS[3]:='Moving Walls';
  1123.     MS[4]:='Max.Snake Length';
  1124.     MS[5]:='Speed';
  1125.     MS[6]:='Sound';
  1126.     MS[7]:='Start Game';
  1127.     MS[8]:='Quit';
  1128.     SetTextStyle(SansSerifFont,HorizDir,4);
  1129.     for i:=1 to 8 do print(50,50+i*30,MS[i],LightGray,DarkGray);
  1130.     for i:=1 to 8 do enter(i);
  1131.     i:=7;
  1132. 224:print(50,50+i*30,MS[i],LightGreen,Green);
  1133.     chx:=ReadKey;
  1134.     if chx=#0 then
  1135.       begin
  1136.       chx:=ReadKey;
  1137.       if (chx=#72) or (chx=#80) then print(50,50+i*30,MS[i],LightGray,DarkGray);
  1138.       if (chx=#72) and (i>1) then i:=i-1;
  1139.       if (chx=#80) and (i<8) then i:=i+1;
  1140.       if (chx=#77) or (chx=#75) then begin Chan(i);Enter(i);end;
  1141.       end;
  1142.     if chx<>#13 then goto 224;
  1143.     if i<7 then goto 224;
  1144.   if i=8 then QuitFlag:=True;
  1145.   end;
  1146.  
  1147.   procedure SQ(q1,w1,q2,w2,q3,w3,q4,w4,cc:word);
  1148.    var square: array[1..4] of PointType;
  1149.    begin square[1].x:=q1;square[1].y:=w1;square[2].x:=q2;square[2].y:=w2;
  1150.          square[3].x:=q3;square[3].y:=w3;square[4].x:=q4;square[4].y:=w4;
  1151.    SetColor(cc);SetFillStyle(SolidFill,cc);
  1152.    FillPoly(sizeof(square) div sizeof(pointtype),square);end;
  1153.  
  1154. procedure TroffTitle;
  1155.   label 129;
  1156.   var i,j: integer;
  1157.       chx:char;
  1158.    cn,cd: array[1..8] of word;
  1159.   procedure LLine(q1,w1,q2,w2,q3,w3,q4,w4,q5,w5,q6,w6:word);
  1160.    begin MoveTo(q1,w1);LineTo(q2,w2);LineTo(q3,w3);LineTo(q4,w4);
  1161.    LineTo(q5,w5);LineTo(q6,w6);end;
  1162.   begin
  1163.   cn[1]:=8;cn[2]:=7;cn[3]:=5;cn[4]:=13;cn[5]:=2;cn[6]:=10;cn[7]:=6;cn[8]:=12;
  1164.   cd[1]:=57;cd[2]:=59;cd[3]:=57;cd[4]:=1;cd[5]:=57;cd[6]:=59;cd[7]:=57;cd[8]:=1;
  1165.   SetLineStyle(0,0,3);SetColor(Blue);
  1166.   LLine(220,140,220,200,420,200,420,140,380,140,380,180);
  1167.   LLine(380,180,260,180,260,140,220,140,220,140,220,140);
  1168.   LLine(273,170,273,130,220,130,220,110,273,110,273,90);
  1169.   LLine(273,90,220,90,220,70,313,70,313,170,273,170);
  1170.   LLine(327,170,327,70,420,70,420,130,367,130,367,170);
  1171.   LLine(367,170,327,170,327,170,327,170,327,170,327,170);
  1172.   Circle(380,100,20);Line(380,86,380,115);Line(360,100,380,100);
  1173.   Line(390,94,390,96);SetLineStyle(0,0,1);
  1174.   SetTextStyle(TriplexFont,Horizdir,4);SetColor(LightBlue);
  1175.   OutTextXY(220,200,'UFP software');
  1176.   PressSpaceBar;
  1177.   cleardevice;
  1178.   SetColor(white);SetLineStyle(0,0,3);
  1179.   LLine(77,40,107,10,197,10,167,40,152,40,152,115);
  1180.   LLine(152,115,137,130,122,115,122,40,77,40,77,40);
  1181.   LLine(182,40,212,10,242,10,272,40,272,70,242,100);
  1182.   LLine(242,100,272,130,242,130,212,100,167,100,167,70);
  1183.   LLine(167,70,227,70,242,55,227,40,182,40,182,40);
  1184.   LLine(287,40,317,10,347,10,377,40,377,100,347,130);
  1185.   LLine(347,130,317,130,287,100,287,40,287,40,287,40);
  1186.   LLine(332,40,347,55,347,85,332,100,317,85,317,55);
  1187.   LLine(317,55,332,40,332,40,332,40,332,40,332,40);
  1188.   LLine(362,10,437,10,467,40,392,40,362,10,362,10);
  1189.   LLine(392,55,422,55,437,70,422,85,392,85,392,55);
  1190.   LLine(452,10,527,10,557,40,482,40,452,10,452,10);
  1191.   LLine(452,55,512,55,527,70,512,85,482,85,482,115);
  1192.   LLine(482,115,467,130,452,115,452,55,452,55,452,55);
  1193.   SetLineStyle(0,0,1);
  1194.   sq(125,170,155,190,275,190,305,170,White);
  1195.   sq(125,260,185,260,215,280,155,280,White);
  1196.   sq(215,280,245,260,305,260,275,280,White);
  1197.   sq(335,170,515,170,485,190,365,190,White);
  1198.   sq(335,260,395,260,425,280,365,280,White);
  1199.   sq(425,280,455,260,515,260,485,280,White);
  1200.   sq(155,190,215,190,185,210,125,210,Blue);
  1201.   sq(215,190,275,190,305,210,245,210,Blue);
  1202.   sq(125,300,155,281,275,282,305,300,Blue);
  1203.   sq(365,190,425,190,405,210,335,210,Blue);
  1204.   sq(425,190,485,190,515,210,445,210,Blue);
  1205.   sq(335,300,365,280,485,280,515,300,Blue);
  1206.   sq(125,170,155,190,125,210,125,210,Cyan);
  1207.   sq(125,260,155,280,125,300,125,300,Cyan);
  1208.   sq(185,210,215,190,215,280,185,260,Cyan);
  1209.   sq(335,170,365,190,335,210,335,210,Cyan);
  1210.   sq(335,260,365,280,335,300,335,300,Cyan);
  1211.   sq(395,210,425,190,425,280,395,260,Cyan);
  1212.   sq(275,190,305,170,305,210,305,210,LightBlue);
  1213.   sq(275,280,305,260,305,300,305,300,LightBlue);
  1214.   sq(215,190,245,210,245,260,215,280,LightBlue);
  1215.   sq(485,190,515,170,515,210,515,210,LightBlue);
  1216.   sq(485,280,515,260,515,300,515,300,LightBlue);
  1217.   sq(425,190,455,210,455,260,425,280,LightBlue);
  1218.   SetFillStyle(SolidFill,Red);
  1219.   FloodFill(137,15,White);FloodFill(227,15,White);
  1220.   FloodFill(332,15,White);FloodFill(392,15,White);
  1221.   FloodFill(400,60,White);FloodFill(512,15,White);
  1222.   FloodFill(467,58,White);SetColor(Yellow);
  1223.   SetTextStyle(SmallFont,HorizDir,6);
  1224.   OutTextXY(263,217,' Written by');
  1225.   OutTextXY(263,234,'N.Soumarokov');
  1226.   for i:=1 to 8 do setpalette(cn[i],cd[i]);
  1227.   sq(557,20,557,40,562,35,562,35,DarkGray);
  1228.   sq(557,40,562,35,577,40,577,40,LightGray);
  1229.   sq(557,40,577,40,562,45,562,45,Magenta);
  1230.   sq(557,40,562,45,557,70,557,70,LightMagenta);
  1231.   sq(557,40,557,70,552,45,552,45,Green);
  1232.   sq(557,40,552,45,537,40,537,40,LightGreen);
  1233.   sq(557,40,537,40,552,35,552,35,Brown);
  1234.   sq(557,40,552,35,557,20,557,20,LightRed);
  1235.   129: repeat
  1236.   i:=cd[8];
  1237.   for j:=8 downto 2 do begin setpalette(cn[j],cd[j-1]); cd[j]:=cd[j-1]; end;
  1238.   setpalette(cn[1],i); cd[1]:=i;
  1239.   delay(75);
  1240.   until keypressed;
  1241.   chx:=Readkey; if chx<>' ' then goto 129;
  1242.   end;
  1243.  
  1244. procedure BossKey;
  1245.   label 115;
  1246.   var i,j,h:integer;
  1247.           s:string;
  1248.         chx:char;
  1249.   begin
  1250.   SetActivePage(1);cleardevice;SetVisualPage(1);nosound;
  1251.   if Random(10)>0 then
  1252.   begin
  1253.   DrawScoreWindow;for i:=1 to 2 do begin SetFillStyle(SolidFill,8+i*2);
  1254.   SetColor(i*2);BAR3d(570+36*(i-1),70,584+36*(i-1),262,2,True);
  1255.   Line(585+36*(i-1),70,585+36*(i-1),262);end;
  1256.   SetColor(White);SetTextStyle(SmallFont,HorizDir,7);
  1257.   OutTextXY(568,25,'89');OutTextXY(604,25,'90');
  1258.   SetTextStyle(SmallFont,HorizDir,4);
  1259.   OutTextXY(573,277,'Business');OutTextXY(573,306,'Graphics');
  1260.   for i:=1 to 2 do
  1261.   for j:=0 to 11 do begin SetColor(i*2);SetFillStyle(SolidFill,8+i*2);h:=Random(100)+20;
  1262.     Bar3d(120-30*i+j*30,200+20*i,145-30*i+j*30,200+20*i-h,20,True);
  1263.     SetFillStyle(SolidFill,i*2);
  1264.     sq(120-30*i+j*30,200+20*i-h,145-30*i+j*30,200+20*i-h,165-30*i+j*30,185+20*i-h,140-30*i+j*30,185+20*i-h,2*i);
  1265.     sq(145-30*i+j*30,200+20*i-h,165-30*i+j*30,185+20*i-h,165-30*i+j*30,185+20*i,145-30*i+j*30,200+20*i,1+2*i);
  1266.     SetColor(White);SetTextStyle(SmallFont,VertDir,6);end;
  1267.     OutTextXY(67,240,'Jan');OutTextXY(97,240,'Feb');OutTextXY(127,240,'Mar');
  1268.     OutTextXY(157,240,'Apr');OutTextXY(187,240,'May');OutTextXY(217,240,'Jun');
  1269.     OutTextXY(247,240,'Jul');OutTextXY(277,240,'Aug');OutTextXY(307,240,'Sep');
  1270.     OutTextXY(337,240,'Oct');OutTextXY(367,240,'Nov');OutTextXY(397,240,'Dec');
  1271.     Line(50,240,50,70);Line(55,80,50,70);Line(50,70,45,80);
  1272.     SetColor(Yellow);SetTextStyle(SmallFont,HorizDir,3);h:=(Random(10)+1)*10;
  1273.     for i:=0 to 15 do begin Line(48,240-i*10,52,240-i*10);str(h*i,s);
  1274.     OutTextXY(30,237-i*10,s);end;
  1275.     SetTextStyle(TriplexFont,HorizDir,3);SetColor(random(15)+1);
  1276.     if Random(10)=0 then OutTextXY(0,0,'Cats'' Wool Growth') else
  1277.     if Random(10)=0 then OutTextXY(0,0,'Poltergeist in the USSR') else
  1278.     if Random(10)=0 then OutTextXY(0,0,'Alcohol sale in Sib-Sibiya') else
  1279.     if Random(10)=0 then OutTextXY(0,0,'Contacts of the 3d kind growth') else
  1280.     if Random(10)=0 then OutTextXY(0,0,'UFP software annual budget') else
  1281.     if Random(10)=0 then OutTextXY(0,0,'Number of ghosts catched by Ghostbusters') else
  1282.     if Random(10)=0 then OutTextXY(0,0,'Vice in Miami') else
  1283.     if Random(10)=0 then OutTextXY(0,0,'Cinetic energy of Darth Vader');
  1284.     repeat chx:=ReadKey; until chx=' ';
  1285.   end
  1286.   else
  1287.     begin
  1288.     SetTextStyle(TriplexFont,HorizDir,6);SetColor(LightGreen);
  1289.     OutTextXY(200,30,'Hey Boss!');SetColor(LightRed);
  1290.     OutTextXY(100,80,'C''mon Big Fella!');SetColor(Yellow);
  1291.     OutTextXY(150,150,'Do''Ya Wanna');SetColor(White);
  1292.     OutTextXY(150,200,'Play TROFF?!');
  1293.     h:=1;i:=100;
  1294.     115: repeat sound(i); i:=i+h;if (i>2000) or (i<100) then h:=-h;
  1295.     until keypressed;
  1296.     ch:=ReadKey; if ch<>' ' then goto 115;
  1297.     end;
  1298.   SetVisualPage(0);SetActivePage(0);nosound;
  1299.   end;
  1300.  
  1301. begin
  1302.   Gd:=EGA; Gm:=EGAHi; InitGraph(Gd,Gm,''); if GraphResult<>grOk then Halt(1);
  1303.   FirstGameFlag:=True; QuitFlag:=False;
  1304.   SetActivePage(0);SetVisualPage(0);
  1305.   GlobalInit;
  1306.   GetDefaultPalette(OldPal); Randomize;
  1307.   GetImages;
  1308.   ClearDevice; SetAllPalette(OldPal); TroffTitle;
  1309.   3:scr[1]:=0;scr[2]:=0;trn[1]:=0;trn[2]:=0;
  1310.     DeleteScreen;SetAllPalette(Oldpal);SetGameOptions;DeleteScreen;
  1311.   if QuitFlag=True then goto 4;
  1312.   2: ClearVariables;
  1313.   DrawScoreWindow; if ToggleSound=True then ShowNote;
  1314.   DrawPlayField;
  1315.   1: ShowScore;
  1316.   { ******************** Get Command *********************** }
  1317.     OldestCode:=OldCode;
  1318.     if KeyPressed then
  1319.       begin
  1320.       ch:=ReadKey;
  1321.       if ch=#0 then begin
  1322.       ch:=ReadKey;
  1323.       SaveCode:=Code;Code:=ord(ch);
  1324.       case Code of
  1325.       77 : if OldCode<>75 then begin XDir[1]:=1 ;YDir[1]:=0 ;OldCode:=77;end;
  1326.       75 : if OldCode<>77 then begin XDir[1]:=-1;YDir[1]:=0 ;OldCode:=75;end;
  1327.       72 : if OldCode<>80 then begin XDir[1]:=0 ;YDir[1]:=-1;OldCode:=72;end;
  1328.       80 : if OldCode<>72 then begin XDir[1]:=0 ;YDir[1]:=1 ;OldCode:=80;end;
  1329.       68 : ExitFlag:=True ;
  1330.       59 : begin PauseGame; Code:=SaveCode; end;
  1331.       60 : begin ToggleSound:=not ToggleSound; ShowNote;
  1332.            nosound; Code:=SaveCode; end;
  1333.       61 : begin Bosskey; Code:=SaveCode; end;
  1334.       end; { case }
  1335.       end; end;
  1336.   { ******************************************************** }
  1337.   MoveYou;
  1338.   if EnemyToggle=True then MoveIBM;
  1339.   ObN:=Random(3)+1;
  1340.   if (Gold[Obn].Class=PS) and (Gold[Obn].Size>0) then MoveSib(ObN);
  1341.   if random(10)=0 then Change(ObN);
  1342.   if MoveWallFlag=True then MoveWall;
  1343.   if MWallToggle>-1 then if
  1344.      (random(MWallToggle)=0) and (MoveWallFlag=False) then SetMoveWall;
  1345.   if (Tune>0) and (ToggleSound=True) then play(Tune);
  1346.   if ((MessageFlag=0) and (Random(2000)=0))
  1347.     then begin PrintMessage(Random(10)+1); MessageFlag:=100; end;
  1348.   if MessageFlag>0 then
  1349.     begin
  1350.     MessageFlag:=MessageFlag-1;
  1351.     if MessageFlag=0 then begin SetFillStyle(SolidFill,0);
  1352.                           Bar(251,342,550,349); end;
  1353.     end;
  1354.   delay(Speed);
  1355.   if (EndFlag[You]=False) and (EndFlag[IBM]=False)
  1356.      and (ExitFlag=False) then GoTo 1;
  1357.   if ExitFlag=True then goto 3;
  1358.   { ***  End of Turn *** }
  1359.     SetFillStyle(SolidFill,0);Bar(251,342,550,349);
  1360.     if (EndFlag[You]=True) then if Random(5)=0
  1361.        then PrintMessage(Random(5)+16);
  1362.     if (EndFlag[You]=False) then if Random(5)=0
  1363.        then PrintMessage(Random(5)+11);
  1364.     if EndFlag[IBM]=True then Destroy(IBM);
  1365.     if EndFlag[You]=True then Destroy(You);
  1366.     if ToggleSound=True then begin
  1367.     if EndFlag[IBM]=True then begin MaxCounter:=9;
  1368.        Counter:=0;repeat Play(12); delay(750); until Counter=0; end;
  1369.     if EndFlag[You]=True then begin MaxCounter:=9;
  1370.        Counter:=0;repeat Play(13); delay(750); until Counter=0; end;
  1371.     nosound;
  1372.        end;
  1373.     if EndFlag[IBM]=True then Trn[You]:=Trn[You]+1;
  1374.     if EndFlag[You]=True then Trn[IBM]:=Trn[IBM]+1;
  1375.     ShowTurnsFlag:=True; ShowScore; Delay(500);
  1376.     DeleteScreen; CalcBonus;
  1377.     StatusScreen; DeleteScreen;
  1378.     if (trn[1]<MaxTrn) and (trn[2]<MaxTrn) then GoTo 2;
  1379.     GameOver;
  1380.     scr[1]:=0;scr[2]:=0;trn[1]:=0;trn[2]:=0;Tune:=0;Counter:=0;GameNo:=0;
  1381.     goto 3;
  1382. 4: CloseGraph; end.