unit spence;                        {Phil Spencer's Menu's}

interface

uses graph, crt;

const
 max      =  10;
 bgipath  = 'D:\\tp7\\bgi';

type
  title     = string[76];
  MenuText  = string[76];
  WinRec    = record
								WinXLoc   : integer;
								WinYloc   : integer;
								WinXmax   : integer;
								WinYmax   : integer;
                WinTitle  : string[79];
                WinColour : integer;
            end;
  winarray  =  array[1..max] of winrec;
  StarLoc   = record
   								X :integer;
                  y :integer;
               end;
	StarArray = array[1..50] of StarLoc;
  FType     = file of integer;
  Strings   = string[12];

var
  i         : integer;
  WinMenu   : winarray;
  active    : integer;
  Stars     : stararray;

procedure StartGraph;
procedure StarStart;
procedure StarMove;
procedure SpenceLogo(Animate:boolean);
procedure ClearMenu;
procedure menu(xloc,yloc,xmax,ymax :integer ; titlebar
																:title ; colour :integer);
procedure refresh;
procedure setactive(TheMenu:integer);
procedure writelnmenu(Menu:integer ; TheText:MenuText);
procedure writemenu(Menu:integer ; TheText:MenuText);
function  DoesFileExist(filename : strings):boolean;

implementation

procedure StartGraph;
var
	 gd,gm :integer;
begin
  gd := detect;
  initgraph(gd,gm,Bgipath);                      {Graphics Initilization}
  if GraphResult <> grOk then Halt(1);
end;

procedure StarStart;
var
	StarX 	: integer;
  StarY   : integer;
  i				: integer;

begin
   randomize;
   setcolor(white);
   for i := 1 to 50 do begin
      with Stars[i] do begin
      	x := random(640)+1;      {Randomly Places stars on 640x480 plane}
      	y := random(480)+1;      {While placing them in struct Stars[i]}
      	line(X,Y,X,Y);
      end;
   end;
end;

Procedure SpenceAnim;
var
 i,k     : integer;
 x,y     : integer;
 x2,y2   : integer;
 colour  : integer;

begin
  setcolor(red);
  x   := 225;
  x2  := 225;
  for i := 1 to 125 do begin
    line((x-(i*2)),150,x,150); {Animates top red lines}
    inc(x);
    if x2 > 549 then x2 := 550
    else
    	x2 := (x +(i*2));
   	line((x-(i*2)),260,x2,260);
   	delay(15);
  end;
  setcolor(yellow);
  x   := 100;
  y   := 205;
  x2  := 350;
  y2  := 205;
  for i := 1 to 45 do begin
     y  := y - 1;
     y2 := y2 + 1;
     setcolor(black);
     line(x+1,y+1,x2,y+1);
     setcolor(yellow);
     line(x,y,x2,y);
     setcolor(black);
     line(x,y-1,x2+1,y2-1);
     line(x,y+1,x2+1,y2+1);
     setcolor(yellow);               {S Expansion animation}
     line(x,y,x2,y2);
     setcolor(black);
     line(x,y2-1,x2-1,y2-1);
     setcolor(yellow);
     line(x,y2,x2,y2);
     delay(25);
  end;
  y := 0;
	for i := 1 to 250 do begin
    setcolor(yellow);
    inc(y);
    line(365,y,365,y-20);         {P start}
  	line(365,y-20,375,y-15);
  	line(375,y-15,365,y-10);
    setcolor(black);
    line(364,y-21,375,y-16);
  	line(374,y-16,364,y-11);      {P end}
    setcolor(yellow);
    line(395,y,385,y-5);            {E Start}
  	line(385,y-5,400,y-5);
  	line(400,y-5,391,y-12);
  	line(391,y-12,385,y-5);
    setcolor(black);
    line(395,y-1,385,y-6);
    line(386,y-6,399,y-6);
    line(400,y-6,391,y-13);
    line(391,y-13,385,y-6);       {E End}
    setcolor(yellow);             {N start}
    line(405,y,410,y-10);
  	line(410,y-10,415,y);
    setcolor(Black);
    line(405,y-1,410,y-11);
  	line(410,y-11,415,y-1);      {N end};
    setcolor(yellow);           {C Start}
    line(425,y-5,435,y);
  	line(425,y-5,435,y-10);
    setcolor(black);
    line(425,y-6,435,y-1);
  	line(425,y-6,435,y-11);     {C End}
    setcolor(yellow);
    line(455,y,445,y-5);            {E Start}
  	line(445,y-5,460,y-5);
  	line(460,y-5,451,y-12);
  	line(451,y-12,445,y-5);
    setcolor(black);
    line(455,y-1,446,y-6);
    line(446,y-6,459,y-6);
    line(460,y-6,451,y-13);
    line(451,y-13,445,y-6);       {E End}
    delay(5);
 	end;
  randomize;
  for i := 1 to 100 do begin
    colour := random(14)+1;
   	setcolor(colour);
   	SetTextStyle(TripleXFont, HorizDir, 3);
  	outtextxy(240,270,'Electronics 99');
    delay(5);
  end;
end;

procedure StarMove;
var
	k,l      : integer;
  colour : integer;

begin
   for l := 1 to 17 do begin
    with Stars[l] do begin
       setcolor(8);
    	 dec(x);           {Background stars, These are the slowest/farthest}
     	 line(x,y,x,y);
       setcolor(black);
     	 {line(x,y-1,x,y-1);
     	 if y < 3
		 	 then y := 0;
     	 }
       line(x+1,y,x+1,y);
       if x < 0 then begin
			  x := 640;
        y := random(480)+1;
       end;
    end;
   end;
	 for l := 18 to 33 do begin
    with Stars[l] do begin
      for k := 1 to 2 do begin
     	  setcolor(7);
     	  dec(x);                   {Middle Stars, Medium Speed, light grey}
     	  line(x,y,x,y);
        colour := getpixel(x+1,y);
  			setcolor(Black);
     	 {line(x,y-1,x,y-1);
     	 if y < 3
		 	 then y := 0;
     	 }
       line(x+1,y,x+1,y);
       if x < 0 then begin
			  x := 640;
        y :=  random(480)+1;
       end;
      end;
    end;
  end;
  for l := 34 to 50 do begin
    with Stars[l] do begin
      for k := 1 to 4 do begin
     	  setcolor(white);
     	  dec(x);
     	  line(x,y,x,y);             {Closest, Brightest and fastest Stars}
  			setcolor(Black);
			 {line(x,y-1,x,y-1);
     	 if y < 3
		 	 then y := 0;
     	 }
       line(x+1,y,x+1,y);
       if x < 0 then begin
			  x := 640;
        y := random(480)+1;
       end;
      end;
    end;
  end;
  delay(10);  {star speed, lower is faster}
end;

procedure SpenceLogo(Animate:boolean);
begin
  randomize;
  ClearDevice;
  StarStart;
  if Animate = true then
  	SpenceAnim;
  repeat
  	setcolor(red);
  	line(100,150,350,150); {top red line}
  	setcolor(yellow);
  	line(100,160,350,160);     {the S begins here }
  	line(100,160,350,250);
  	line(350,250,100,250);
  	setcolor(red);
  	line(100,260,550,260);   {bottom red line}
  	setcolor(yellow);
		line(365,250,365,230);	{starts mini letters}
  	line(365,230,375,235);
  	line(375,235,365,240);          {P}
  	line(395,250,385,245);
  	line(385,245,400,245);
  	line(400,245,391,238);
  	line(391,238,385,245);          {E}
  	line(405,250,410,240);
  	line(410,240,415,250);          {N}
  	line(425,245,435,250);
  	line(425,245,435,240);          {C}
  	line(455,250,445,245);
  	line(445,245,460,245);
  	line(460,245,451,238);
  	line(451,238,445,245);          {E}
  	setcolor(red);
  	SetTextStyle(TripleXFont, HorizDir, 3);
  	outtextxy(240,270,'Electronics 99');
    StarMove;
  until (keypressed = true);
end;

procedure ClearMenu;
var
  loop :integer;
begin
  active := 0;
  i      := 0;
  textcolor(8);
  textbackground(0);
  for loop := 1 to max do begin;
  	with WinMenu[loop] do begin
       WinXloc   := 0;     {This procedure Clears Info on all menus}
       WinYloc   := 0;     {And Clears the screen}
       WinXmax   := 0;
       WinYmax   := 0;
       WinTitle  := '';
       WinColour := 0;
    end;
  end;
  clrscr;
end;

procedure menu(xloc,yloc,xmax,ymax :integer ; titlebar
																:title ; colour :integer);
 var
 titlex,titley :integer;
 loop          :integer;

 begin
   i := i + 1;
   with WinMenu[i] do begin
     Winxloc   := xloc;
     Winyloc   := yloc;
     WinXmax   := xmax;
     WinYmax   := ymax;    {Saves menu info in an ordered array for easy use later}
   	 WinColour := colour;
     WinTitle  := titlebar;
   end;
   textcolor(colour);
   textbackground(0);
   titlex := (xmax div 2) + (xloc div 2) - (length(titlebar) div 2) + 1;
	 titley := yloc;                   {Title centering}
   gotoxy(xloc,yloc);
   write('É');
   for loop := xloc to xmax do
       write('Í');                   {Top bar of menu}
   writeln('»');
   gotoxy(titlex,titley);
   write(titlebar);                  {Title}
   for loop := yloc to (ymax-1) do begin
      gotoxy(xloc,loop + 1);
      write('º');                           {Menu walls}
      writeln('º':(xmax - xloc + 2));
      end;
   gotoxy(xloc,ymax);
   write('È');
   for loop := xloc to xmax do
      write('Í');                       {Bottom of menu}
   write('¼');
   NormVideo;                         {resets colour}
end;

procedure refresh;
var
	loop       :integer;
  itemp      :integer;

begin
  itemp    := i;             {Saves i so it doesnt double}
  for loop := 1 to itemp do begin
    if loop <> active then begin
      with WinMenu[loop] do
       	menu(Winxloc,Winyloc,Winxmax,Winymax,Wintitle,7);
    end;
  end;
  with WinMenu[active] do
  	menu(Winxloc,Winyloc,Winxmax,Winymax,Wintitle,Wincolour);  {draws active window on top}
  i      := itemp;                           {retores i to original value}
end;

procedure SetActive(TheMenu :integer);
begin                                       {allows changing active window}
  active := TheMenu;
  refresh;
end;

procedure writelnmenu(Menu:integer ; TheText:MenuText);
begin
  with WinMenu[menu] do begin
  	gotoxy(Winxloc + 1,winyloc + 1);
  	textcolor(WinColour);                   {Writes first line of text in menu}
  end;
  writeln(TheText);
end;

procedure writemenu(Menu:integer ; TheText:MenuText);
begin
  with WinMenu[menu] do begin
  	textcolor(WinColour);
  	gotoxy(winxloc+1,WhereY);         {Writes Additonal lines of text}
  end;
  writeln(TheText);
end;

function DoesFileExist(filename : Strings) :boolean;
var
	result : integer;
  fh     : Ftype;

begin
  assign(fh,filename);
  {$I-}
  reset(FH);
  {$I+}
  result := IOresult;
  if result = 0 then DoesFileExist := True
  else
		DoesFileExist := False;
end;

begin
end.