Source Code 1992 March/Source_Code_CD-ROM_Walnut_Creek_March_1992.iso/usenet/altsrcs/1/1790

Internet Message Format | 1990-12-28 | 44.1 KB

From: [e-mail]
Newsgroups: alt.sources,vmsnet.sources.games
Subject: shapes.shar2 (of 2)
Message-ID: <[e-mail]>
Date: 7 Sep 90 16:47:24 GMT

This is part two of a two part poting of tetris for VAX's

Delete everything above the line showing "$Part4:", concatenate part 2 onto
the end of part one and then "@shapes.shar1" to unarchive it


!-----------------------------------------------------------------------------
$Part4:
$File_is="SHAPES.PAS"
$Check_Sum_is=573653758
$Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
Xprogram Shapes(input,output,Htable,Save);
X
X
V{*****************************************************************************
X**
X   Copyright 1989,1990 by Colin Cowie, Glasgow, Scotland.
X
X                        All Rights Reserved
X
X   Permission to use, copy, modify, and distribute this software and its
X   documentation for any purpose and without fee is hereby granted,
X   provided that the above copyright notice appear in all copies and that
X   both that copyright notice and this permission notice appear in
X   supporting documentation.
V******************************************************************************
X*}
X
X
X
Xconst
X  Htablefile='disk18:[cadp02.pascal.shapes]Htable.dat';
X  Savefile='disk18:[cadp02.pascal.shapes]save.dat';
X
Xtype
X  string = packed array[1..8] of char;
X  scorerec = record
X      num:integer;
X     name:packed array[1..40] of char;
X     level:integer;
X     id:string;
X     end;
X  recfile = file of scorerec;
X  scorearray = array[1..10] of scorerec;
X  screenarray = array[1..22,1..10] of integer;
X  timearray = packed array[1..11] of char;
X  datestr = packed array [1..11] of char;
X  saverec = record
X     num:integer;
X     level:integer;
X     outp:screenarray;
X     x:integer;
X     y:integer;
X     shape:integer;
X     position:integer;
X     lines:integer;
X     user:string;
X     current:datestr;
X      end;
X  saverecfile = file of saverec;
X  savearray = array[1..100] of saverec;
X
Xvar
X  restored:boolean;
X  blank:saverec;
X  peeps:savearray;
X  HP:boolean;
X  factor:real;
X  curr:timearray;
X  flag,
X  flag2:boolean;
X  answer:char;
X  del:boolean;
X  userid:string;
X  flagA,
X  flagB,
X  flagC,
X  flagD:boolean;
X  chan:integer;
X  key:integer;
X  xchrhigh,
X  xchrlow,
X  ychrhigh,
X  ychrlow:char;
X  score,
X  shape,
X  position:integer;
X  cheat:boolean;
X  currd:datestr;
X  I,J,A:integer;
X  x,y:integer;
X  scores:scorearray;
X  OTT:boolean;
X  Htable:recfile;
X  Save,
X  Saver:saverecfile;
X  level:integer;
X  levelmin:integer;
X  screen:screenarray;
X  left,
X  right,
X  rotleft,
X  rotright,
X  speed,
X  redraw,
X  quitkey:char;
X  lines:integer;
X
X{*****************************************************************}
Xprocedure CLS;
Xbegin {CLS}
Xwrite(chr(27),'[H');
Xwriteln(chr(27),'[2J');
Xend; {CLS}
X{*****************************************************************}
X
X{*****************************************************************}
V{*****************************************************************************
X}
Xprocedure makechan(%REF chan:integer);external;
X
Xprocedure readkey(%REF key,chan:integer);external;
X
Xprocedure waitkey(%REF key,chan:integer);external;
X
Xprocedure waitx(%REF factor:real);external;
X
Xprocedure spawn;external;
X
Xprocedure RANDOMISE;fortran;
X
Xfunction RANDOM(min,max:integer):integer;fortran;
X
Xprocedure USERNUM(%stdescr userid:string);fortran;
X{*****************************************************************}
X
X
X{******************************************************************}
Xprocedure highscores(score:integer; bit:integer; var Htable:recfile;
X var scores:scorearray; var gotin:boolean);
X
X
Xvar
X  I,J:integer;
X  newscore:scorerec;
X  A:integer;
X  two:boolean;
X
Xbegin
X  gotin:=false;
X  cls;
X  writeln('You scored: ',score,' points!!');
X  I:=1;
X  open (Htable, Htablefile,
X        history:=readonly);
X  reset(Htable);
X  while (not eof(Htable)) and (I <=10) do
X  begin
X    read(Htable,scores[I]);
X    I:=I+1;
X  end;
X  close(Htable);
X  for A:= I to 10 do
X  begin
X    scores[A].num:=0;
X    scores[A].name:='                                        ';
X    scores[A].level:=1;
X    scores[A].id:='        ';
X  end;
X  if score > scores[10].num then
X  begin
X    two := true;
X    usernum(userid);
X    if (userid='CADP03  ') or
X       (userid='CADP02  ') or
X       (userid='CRAA30  ') or
X       (userid='CRAA38  ') then
X    begin
X      writeln('Enter usernum, maximum 8 chars (RETURN for default):');
X      write(':');
X      userid:='        ';
X      readln(userid);
X      if userid[1]=' ' then usernum(userid);
X    end;
X
X    for I := 10 downto 1 do
X    begin
X      if userid = scores[I].id then
X      begin
X       if score > scores[I].num then
X        begin
X          for J := I to 9 do
X            scores[J] := scores[J+1];
X          if I = 9 then
X            scores[9] := scores[10];
X          scores[10].num:=0;
X          scores[10].name:='                                       ';
X          scores[10].level:=1;
X          scores[10].id:='        ';
X        end
X        else
X        begin
X          two := false;
X        end;
X      end;
X    end;
X    if two = true then
X    begin
X      gotin:=true;
X      writeln('Well done, yu have made it into the top ten!!');
X      for A:=1 to 20 do
X        newscore.name[A]:=' ';
X      Writeln('Enter name, maximum 40 chars:');
X      write(':');
X      readln(newscore.name);
X      usernum(userid);
X      if (userid='CADP03  ') or
X         (userid='CADP02  ') or
X         (userid='CRAA30  ') or
X         (userid='CHBS08  ') then
X      begin
X        writeln('Enter usernum, maximum 8 chars (RETURN for default):');
X        write(':');
X        userid:='        ';
X        readln(userid);
X        if userid[1]=' ' then usernum(userid);
X      end;
X      newscore.num:=score;
X      newscore.level:=bit;
X      newscore.id:=userid;
X      I:=1;
X      while newscore.num < scores[I].num do
X        I:=I+1;
X      for A:=10 downto I+1 do
X        scores[A]:=scores[A-1];
X      scores[I]:=newscore;
X      open (Htable , Htablefile ,
X  `009history := old);
X      rewrite(Htable);
X      for I:=1 to 10 do
X        write(Htable,scores[I]);
X      close (Htable);
X      writeln('Press any key to view high-score table');
X    end
X    else
X    begin
X      writeln('One entry only per usernum in the high score table!!');
X      writeln('Press any key to return to main menu');
X    end;
X  end
X  else
X  begin
X    writeln('Sorry, yu didnt make the high score table!!!!!!');
X    writeln('Press any key to return to main menu');
X  end;
X  waitkey(key,chan);
Xend;
X{*************************************************************}
X
X
X{*************************************************************}
Xprocedure viewscores(var Htable:recfile; scores:scorearray; key,chan:integer);
X
Xvar
X  score:scorerec;
X  I,
X  A:integer;
X
Xbegin
X  cls;
X  open (Htable, Htablefile,
X        history:=readonly);
X  reset(Htable);
X  I:=1;
X  while (not eof(Htable)) and (I <=10) do
X  begin
X    read(Htable,score);
X    scores[I]:=score;
X    I:=I+1;
X  end;
X  close (Htable);
X  for A:= I to 10 do
X  begin
X    scores[I].num:=0;
X    scores[I].name:='                                        ';
X    scores[I].level:=1;
X    scores[I].id:='        ';
X  end;
X  Writeln('                       Shapes HIGH SCORE TABLE');
X  writeln;writeln;
V  writeln('          score              name                           level
Xuserid');
X  for I:=1 to 10 do
X  begin
X    writeln(I:2,'. ',scores[I].num,'     ',scores[I].name,'  ',
X            scores[I].level:2,'    ',scores[I].id);
X  end;
Xwriteln;writeln;
Xwriteln('                         Press any key to return to main menu');
Xwaitkey(key,chan);
Xend;
X
X{***********************************************************}
X
X
X{************************************************************}
Xprocedure INTOCHAR(var xchrhigh,xchrlow,
X                       ychrhigh,ychrlow:char; x,y:integer);
X
Xbegin {INTOCHAR}
X  xchrhigh`009:= chr(ord('0') + x div 10) ;
X  xchrlow`009:= chr(ord('0') + x mod 10) ;
X
X  ychrhigh`009:= chr(ord('0') + y div 10) ;
X  ychrlow`009:= chr(ord('0') + y mod 10) ;
X
Xend; {INTOCHAR}
X{*********************************************************************}
X
X
X{*****************************************************************}
Xprocedure MENUPRINT;
X
Xbegin
X  CLS;
X  writeln(chr(27),'#3               Shapes');
X  writeln(chr(27),'#4               Shapes');
X  writeln(chr(27),'[22;25HCopyright 1989,1990 LokiSoft Ltd.');
X  writeln(chr(27),'[09;31H1. Play Shapes');
X  writeln(chr(27),'[10;31H2. Redefine Keys');
X  writeln(chr(27),'[11;31H3. View Score Board');
X  writeln(chr(27),'[12;31H4. Instructions');
X  write(chr(27),'[13;31H5. Print Next Shape');
X  if flag then writeln('  (YES)') else writeln('  (NO) ');
X  write(chr(27),'[14;31H6. Slow Down Game');
X  if flag2 then writeln('   (YES)') else writeln('   (NO) ');
X  writeln(chr(27),'[15;31H7. Restore Saved Game');
X  writeln(chr(27),'[17;31H0. Exit from game');
X  writeln(chr(27),'[19;31HEnter choice from options above');
X  writeln;
Xend;
X{**********************************************************************}
X{*****************************}
Xprocedure Instructions;
Xbegin
Xcls;
Xwriteln('Hi Guys, here''s another offering from the LokiSoft label,');
Xwriteln('except this one''s good!!!!');
Xwriteln;
Xwriteln('This game is based on a certain arcade game which you may have ');
Xwriteln('played at sometime or other, but I aint mentioning which one cos');
Xwriteln('this is a blatant rip-off of it so its really dead obvious!!');
Xwriteln;
Xwriteln('Anyway, its like this: there are these seven different shapes:-');
Xwriteln;
Xwriteln('@@        @        @        @        @        @        @');
Xwriteln('@@        @        @        @@      @@        @@       @');
Xwriteln('          @@      @@         @      @         @        @');
Xwriteln('                                                       @');
Xwriteln('And these shapes fall from the top of the screen to the bottom,');
Xwriteln('piling on top of one another.');
Xwriteln('You can rotate each shape, and move it left or right, the ');
Xwriteln('object being to get complete unbroken lines of "@@@@@@@@@@" at ');
Xwriteln('the bottom of the screen.');
Xwriteln('when this happens, that line is deleted, and the pile drops down');
Xwriteln('and you are given points depending on which level you are on');
Xwriteln;
Xwriteln('                           Press any key for next page');
Xwaitkey(key,chan);
Xcls;
Xwriteln;
Xwriteln('If you are fortunate enough to get more than one completed line at');
Vwriteln('a time, you receive a bonus dependent on the level you are on and the
X');
Xwriteln('number of lines completed.');
Xwriteln('After completing 5 lines, you move on to level 2 where you have to');
Xwriteln('complete 10 lines,..15 for level 3, and so on.');
Xwriteln('There is a bonus at the end of each level depending on which level');
Vwriteln('you are on, and how low the pile of bricks is,..the lower the pile,')
X;
Xwriteln('the higher the bonus');
Vwriteln('For each level, the number of points per completed line, and potentia
Xl');
Xwriteln('bonus per level is increased, and there are an infinite number');
Xwriteln('of levels in the game.');
Xwriteln;
Xwriteln('The default keys are: z - left, x - right,');
Xwriteln('                o - rotate left, p - rotate right,');
Xwriteln('     [ - move shape to bottom, r - redraw screen, q - quit');
Xwriteln('     ! - to spawn to dcl, @ - to save game');
Xwriteln;
Xwriteln('                           Press any key for next page');
Xwaitkey(key,chan);
Xcls;
Xwriteln('Note on Saving game:-');
Xwriteln;
Xwriteln('It is only possible for any user to have one saved game at a time,');
Vwriteln('and if you attempt to save a game when you already have one stored,')
X;
Xwriteln('the stored game will be written over!!!');
Xwriteln('Stored games will automatically be deleted when restored.');
Xwriteln;
Vwriteln('There is total space on the save-file for 100 games, and when it is')
X;
Vwriteln('full, whenever anyone attempts to save their game, the oldest previou
Xs');
Xwriteln('saved game is written over!');
Xwriteln;
Xwriteln('Note on Slowing down game option:-');
Xwriteln;
Vwriteln('This option is intended only for people using workstations or similar
X');
Xwriteln('which vastly speed up the screen printing, thereby making the game');
Xwriteln('unplayable. The slow down option negates this problem.');
Xwriteln;
Xwriteln('Now I''ll take this opportunity to wish you happy playing and good');
Xwriteln('luck, you''ll need it!!!!');
Xwriteln(chr(27),'[22;30HPress any key for main menu');
Xwaitkey(key,chan);
Xend;
X{*****************************}
X
X
X
X{*******************************************************************}
Vprocedure KEYDEFINE(var left,right,rotleft,rotright,speed,quitkey,redraw:char)
X;
X
Xvar
X
X  redrawint,
X  null,
X  leftint,
X  rightint,
X  rotleftint,
X  rotrightint,
X  speedint,
X  stopint:integer;
X  quitint:integer;
X
Xbegin {KEYDEFINE}
X  CLS;
X  writeln('         Defining Keys For SHAPES ');
X  writeln;
X  writeln;
X  writeln;
X  writeln;
X  writeln('Press key for movement LEFT: ');
X  waitkey(leftint,chan);
X  left:=chr(leftint);
X  writeln(left);
X  writeln('press key for movement RIGHT: ');
X  waitkey(rightint,chan);
X  while (rightint=leftint) do
X    waitkey(rightint,chan);
X  right:=chr(rightint);
X  writeln(right);
X  writeln('Press key for rotation ANTICLOCKWISE: ');
X  waitkey(rotleftint,chan);
X  while (rotleftint=leftint) or
X        (rotleftint=rightint) do
X    waitkey(rotleftint,chan);
X  rotleft:=chr(rotleftint);
X  writeln(rotleft);
X  writeln('press key for rotation CLOCKWISE: ');
X  waitkey(rotrightint,chan);
X  while (rotrightint=rightint) or
X        (rotrightint=rotleftint) or
X        (rotrightint=leftint) do
X    waitkey(rotrightint,chan);
X  rotright:=chr(rotrightint);
X  writeln(rotright);
X  writeln('press key to move shape to bottom: ');
X  waitkey(speedint,chan);
X  while (speedint=rightint) or
X        (speedint=leftint) or
X        (speedint=rotleftint) or
X        (speedint=rotrightint) do
X    waitkey(speedint,chan);
X  speed:=chr(speedint);
X  writeln(speed);
X  writeln('press key to quit game: ');
X  waitkey(quitint,chan);
X  while (quitint=rightint) or
X        (quitint=leftint) or
X        (quitint=rotleftint) or
X        (quitint=rotrightint) or
X        (quitint=speedint) do
X    waitkey(quitint,chan);
X  quitkey:=chr(quitint);
X  writeln(quitkey);
X  writeln('press key to redraw screen');
X  waitkey(redrawint,chan);
X  while (redrawint=rightint) or
X        (redrawint=leftint) or
X        (redrawint=rotrightint) or
X        (redrawint=rotleftint) or
X        (redrawint=quitint) do
X    waitkey(redrawint,chan);
X  redraw:=chr(redrawint);
X  writeln(redraw);
X  writeln;
X  writeln;
X  writeln;
X  writeln('    Press any key to continue ');
X  waitkey(null,chan);
Xend; {KEYDEFINE}
X{*******************************************************************}
X
X
X
X{***********************************************************************}
Xprocedure Shapestuff(shape,position,y,x:integer; var screen:screenarray;
X                     n:integer);
Xbegin
X  screen[y,x]:=n;
X  if shape = 1 then
X  begin
X    screen[y,x+1]:=n;
X    screen[y+1,x]:=n;
X    screen[y+1,x+1]:=n;
X  end
X  else
X  if shape = 2 then
X  begin
X    if position = 1 then
X    begin
X      screen[y-1,x]:=n;
X      screen[y+1,x]:=n;
X      screen[y+1,x+1]:=n;
X    end
X    else
X    if position = 2 then
X    begin
X      screen[y,x+1]:=n;
X      screen[y,x-1]:=n;
X      screen[y+1,x-1]:=n;
X    end
X    else
X    if position = 3 then
X    begin
X      screen[y+1,x]:=n;
X      screen[y-1,x]:=n;
X      screen[y-1,x-1]:=n;
X    end
X    else
X    if position = 4 then
X    begin
X      screen[y,x-1]:=n;
X      screen[y,x+1]:=n;
X      screen[y-1,x+1]:=n;
X    end;
X  end
X  else
X  if shape = 3 then
X  begin
X    if position = 1 then
X    begin
X      screen[y-1,x]:=n;
X      screen[y+1,x]:=n;
X      screen[y+1,x-1]:=n;
X    end
X    else
X    if position = 2 then
X    begin
X      screen[y,x+1]:=n;
X      screen[y,x-1]:=n;
X      screen[y-1,x-1]:=n;
X    end
X    else
X    if position = 3 then
X    begin
X      screen[y-1,x]:=n;
X      screen[y+1,x]:=n;
X      screen[y-1,x+1]:=n;
X    end
X    else
X    if position = 4 then
X    begin
X      screen[y,x-1]:=n;
X      screen[y,x+1]:=n;
X      screen[y+1,x+1]:=n;
X    end;
X  end
X  else
X  if shape = 4 then
X  begin
X    if position = 1 then
X    begin
X      screen[y-1,x]:=n;
X      screen[y+1,x]:=n;
X      screen[y,x+1]:=n;
X    end
X    else
X    if position = 2 then
X    begin
X      screen[y+1,x]:=n;
X      screen[y,x-1]:=n;
X      screen[y,x+1]:=n;
X    end
X    else
X    if position = 3 then
X    begin
X      screen[y-1,x]:=n;
X      screen[y+1,x]:=n;
X      screen[y,x-1]:=n;
X    end
X    else
X    if position = 4 then
X    begin
X      screen[y-1,x]:=n;
X      screen[y,x-1]:=n;
X      screen[y,x+1]:=n;
X    end;
X  end
X  else
X  if shape = 5 then
X  begin
X    if (position = 1) or (position = 3) then
X    begin
X      screen[y+1,x]:=n;
X      screen[y,x+1]:=n;
X      screen[y-1,x+1]:=n;
X    end
X    else
X    if (position = 2) or (position = 4) then
X    begin
X      screen[y,x-1]:=n;
X      screen[y+1,x]:=n;
X      screen[y+1,x+1]:=n;
X    end;
X  end
X  else
X  if shape = 6 then
X  begin
X    if (position = 1) or (position = 3) then
X    begin
X      screen[y-1,x]:=n;
X      screen[y,x+1]:=n;
X      screen[y+1,x+1]:=n;
X    end
X    else
X    if (position = 2) or (position = 4) then
X    begin
X      screen[y,x+1]:=n;
X      screen[y+1,x]:=n;
X      screen[y+1,x-1]:=n;
X    end;
X  end
X  else
X  if shape = 7 then
X  begin
X    if (position = 1) or (position = 3) then
X    begin
X      screen[y-1,x]:=n;
X      screen[y+1,x]:=n;
X      screen[y+2,x]:=n;
X    end
X    else
X    if (position = 2) or (position = 4) then
X    begin
X      screen[y,x-2]:=n;
X      screen[y,x-1]:=n;
X      screen[y,x+1]:=n;
X    end;
X  end;
Xend;
X{****************************************************************************}
X
X
X{***********************************************************************}
Xprocedure Check(shape,position,y,x:integer; var change:boolean);
X
Xbegin
X  change:=true;
X  if shape = 2 then
X  begin
X    if position = 1 then
X    begin
X      if screen[y-1,x]=1 then change:= false
X    else
X      if screen[y+1,x]=1 then change:= false
X    else
X      if screen[y+1,x+1]=1 then change:= false;
X    end
X    else
X    if position = 2 then
X    begin
X      if screen[y,x+1]=1 then change:= false else
X      if screen[y,x-1]=1 then change:= false else
X      if screen[y+1,x-1]=1 then change:= false;
X    end
X    else
X    if position = 3 then
X    begin
X      if screen[y+1,x]=1 then change:= false else
X      if screen[y-1,x]=1 then change:= false else
X      if screen[y-1,x-1]=1 then change:= false;
X    end
X    else
X    if position = 4 then
X    begin
X      if screen[y,x-1]=1 then change:= false else
X      if screen[y,x+1]=1 then change:= false else
X      if screen[y-1,x+1]=1 then change:= false;
X    end;
X  end
X  else
X  if shape = 3 then
X  begin
X    if position = 1 then
X    begin
X      if screen[y-1,x]=1 then change:= false else
X      if screen[y+1,x]=1 then change:= false else
X      if screen[y+1,x-1]=1 then change:= false;
X    end
X    else
X    if position = 2 then
X    begin
X      if screen[y,x+1]=1 then change:= false else
X      if screen[y,x-1]=1 then change:= false else
X      if screen[y-1,x-1]=1 then change:= false;
X    end
X    else
X    if position = 3 then
X    begin
X      if screen[y-1,x]=1 then change:= false else
X      if screen[y+1,x]=1 then change:= false else
X      if screen[y-1,x+1]=1 then change:= false;
X    end
X    else
X    if position = 4 then
X    begin
X      if screen[y,x-1]=1 then change:= false else
X      if screen[y,x+1]=1 then change:= false else
X      if screen[y+1,x+1]=1 then change:= false;
X    end;
X  end
X  else
X  if shape = 4 then
X  begin
X    if position = 1 then
X    begin
X      if screen[y-1,x]=1 then change:= false else
X      if screen[y+1,x]=1 then change:= false else
X      if screen[y,x+1]=1 then change:= false;
X    end
X    else
X    if position = 2 then
X    begin
X      if screen[y+1,x]=1 then change:= false else
X      if screen[y,x-1]=1 then change:= false else
X      if screen[y,x+1]=1 then change:= false;
X    end
X    else
X    if position = 3 then
X    begin
X      if screen[y-1,x]=1 then change:= false else
X      if screen[y+1,x]=1 then change:= false else
X      if screen[y,x-1]=1 then change:= false;
X    end
X    else
X    if position = 4 then
X    begin
X      if screen[y-1,x]=1 then change:= false else
X      if screen[y,x-1]=1 then change:= false else
X      if screen[y,x+1]=1 then change:= false;
X    end;
X  end
X  else
X  if shape = 5 then
X  begin
X    if (position = 1) or (position = 3) then
X    begin
X      if screen[y+1,x]=1 then change:= false else
X      if screen[y,x+1]=1 then change:= false else
X      if screen[y-1,x+1]=1 then change:= false;
X    end
X    else
X    if (position = 2) or (position = 4) then
X    begin
X      if screen[y,x-1]=1 then change:= false else
X      if screen[y+1,x]=1 then change:= false else
X      if screen[y+1,x+1]=1 then change:= false;
X    end;
X  end
X  else
X  if shape = 6 then
X  begin
X    if (position = 1) or (position = 3) then
X    begin
X      if screen[y-1,x]=1 then change:= false else
X      if screen[y,x+1]=1 then change:= false else
X      if screen[y+1,x+1]=1 then change:= false;
X    end
X    else
X    if (position = 2) or (position = 4) then
X    begin
X      if screen[y,x+1]=1 then change:= false else
X      if screen[y+1,x]=1 then change:= false else
X      if screen[y+1,x-1]=1 then change:= false;
X    end;
X  end
X  else
X  if shape = 7 then
X  begin
X    if (position = 1) or (position = 3) then
X    begin
X      if screen[y-1,x]=1 then change:= false else
X      if screen[y+1,x]=1 then change:= false else
X      if screen[y+2,x]=1 then change:= false;
X    end
X    else
X    if (position = 2) or (position = 4) then
X    begin
X      if screen[y,x-2]=1 then change:= false else
X      if screen[y,x-1]=1 then change:= false else
X      if screen[y,x+1]=1 then change:= false;
X    end;
X  end;
Xend;
X{****************************************************************************}
X
X
X{****************************************************************************}
Xprocedure Create(var shape,position,y,x:integer);
X
Xvar
X  shapenum:integer;
X
Xbegin
X  shapenum:=random(1,23);
X  if shapenum < 4 then shape:=1
X  else
X  if shapenum < 7 then shape:=2
X  else
X  if shapenum < 11 then shape:=3
X  else
X  if shapenum < 14 then shape:=4
X  else
X  if shapenum < 17 then shape:=5
X  else
X  if shapenum < 20 then shape:=6
X  else
X  if shapenum < 23 then shape:=7
X  else
X  shape:=8;
X  position:=1;
X  y:=2;
X  x:=5;
Xend;
X{**************************************************************************}
X
X
X{***********************************************}
Xprocedure PrintLines(screen:screenarray; b:integer);
X
Xvar
X  a,
X  c:integer;
X  noline:boolean;
X
Xbegin
X  a:=b;
X  repeat
X    noline:=true;
X    for c:=1 to 10 do
X    begin
X      if screen[a,c] = 1 then noline:=false;
X      intochar(xchrhigh,xchrlow,ychrhigh,ychrlow,c+30,a);
X      if screen[a,c] = 1 then
X        writeln(chr(27),'[',ychrhigh,ychrlow,';',xchrhigh,xchrlow,'H#');
X      if screen[a,c] = 0 then
X        writeln(chr(27),'[',ychrhigh,ychrlow,';',xchrhigh,xchrlow,'H ');
X    end;
X    a:=a-1;
X  until (noline) or (a = 1);
Xend;
X{************************************************}
X{******************************************************}
Xprocedure LineDelete(var screen:screenarray; b:integer; var score:integer;
X                         level:integer; var lines:integer);
X
Xvar
X  a,
X  c:integer;
X
Xbegin
X  for a:= b downto 2 do
X    for c:=1 to 10 do
X      screen[a,c]:=screen[a-1,c];
X  printlines(screen,b);
X  if not(flag) then
X    score:=score+(150*level)
X  else
X    score:=score+(100*level);
X  lines:=lines+1;
X  writeln(chr(27),'[14;7H',((5*level)-lines):2);
X  writeln(chr(27),'[10;7H',score:1);
Xend;
X{***************************************************}
X{****************************************************************************}
Xprocedure LineStuff(var screen:screenarray; var lines:integer;
X                    level:integer; var score:integer);
X
Xvar
X  A,
X  B:integer;
X  line,
X  nothing:boolean;
X  linenum:integer;
X  bounty:integer;
X
Xbegin
X  linenum:=lines;
X  b:=22;
X  bounty:=0;
X  repeat
X    line:=true;
X    for a:=1 to 10 do
X      if screen[b,a]=0 then line:=false;
X    nothing:=true;
X    for a:=1 to 10 do
X      if screen[b,a]=1 then nothing:=false;
X    if line then
X    begin
X      LineDelete(screen,b,score,level,lines);
X      b:=b+1;
X    end;
X    b:=b-1;
X  until (nothing = true) or (b = 0);
X  linenum:=lines-linenum;
X  if linenum > 1 then  bounty:=((linenum-1) * 200 * level);
X  score:=score+bounty;
X  writeln(chr(27),'[10;7H',score:1);
Xend;
X{**********************************************************************}
X
X
X{**********************************************************************}
Xprocedure bonus(var score:integer; screen:screenarray; level:integer);
X
Xvar
X  a,
X  b:integer;
X  noline:boolean;
X
X
Xbegin
X  a:=22;
X  b:=1;
X  repeat
X    noline:=true;
X    for b:=1 to 10 do
X      if screen[a,b] = 1 then noline:=false;
X    a:=a-1;
X  until (a = 0) or (noline = true);
X
X  if noline then
X    score:=score+(100*a*level);
Xend;
X{******************************************************************}
X
X{*************************************}
Xprocedure Printshape(screen:screenarray; y,x:integer);
X
Xvar
X  a,
X  b,
X  i,
X  j:integer;
X  stuff:packed array[1..10] of char;
X
Xbegin
X  if flag2 = TRUE then
X  begin
X    waitx(factor);
X  end;
X  for a:= y-2 to y+3 do
X    begin
X      if (a < 23) and (a > 1) then
X      begin
X        intochar(xchrhigh,xchrlow,ychrhigh,ychrlow,31,a);
X        for b:=1 to 10 do
X        begin
X          if screen[a,b] = 1 then stuff[b]:='#'
X          else
X          if screen[a,b] = 2 then stuff[b]:='@'
X          else
X            stuff[b]:=' ';
X        end;
X        writeln(chr(27),'[',ychrhigh,ychrlow,';31H',stuff)
X       end;
X    end;
Xend;
X{*************************************}
X
X{**********************************************************************}
Xprocedure printnext(shape:integer);
X
Xbegin
X  writeln(chr(27),'[07;50H  ');
X  writeln(chr(27),'[08;50H  ');
X  if shape = 1 then
X  begin
X    writeln(chr(27),'[05;50H@@');
X    writeln(chr(27),'[06;50H@@');
X  end
X  else
X  if shape = 2 then
X  begin
X    writeln(chr(27),'[05;50H@ ');
X    writeln(chr(27),'[06;50H@ ');
X    writeln(chr(27),'[07;50H@@');
X  end
X  else
X  if shape = 3 then
X  begin
X    writeln(chr(27),'[05;50H @');
X    writeln(chr(27),'[06;50H @');
X    writeln(chr(27),'[07;50H@@');
X  end
X  else
X  if shape = 4 then
X  begin
X    writeln(chr(27),'[05;50H@ ');
X    writeln(chr(27),'[06;50H@@');
X    writeln(chr(27),'[07;50H@ ');
X  end
X  else
X  if shape = 5 then
X  begin
X    writeln(chr(27),'[05;50H @');
X    writeln(chr(27),'[06;50H@@');
X    writeln(chr(27),'[07;50H@ ');
X  end
X  else
X  if shape = 6 then
X  begin
X    writeln(chr(27),'[05;50H@ ');
X    writeln(chr(27),'[06;50H@@');
X    writeln(chr(27),'[07;50H @');
X  end
X  else
X  if shape = 7 then
X  begin
X    writeln(chr(27),'[05;50H@ ');
X    writeln(chr(27),'[06;50H@ ');
X    writeln(chr(27),'[07;50H@ ');
X    writeln(chr(27),'[08;50H@ ');
X  end;
Xend;
X{**********************************************************************}
X
X
X{**********************************************************************}
Vprocedure Rotation(var screen:screenarray; shape:integer; var position:integer
X;
X                       rotint:integer;  var y,x:integer);
X
Xvar
X  newposition:integer;
X  ax:integer;
X  change:boolean;
X
Xbegin
X  if shape = 7 then
X  begin
X    ax:=x;
X    if x = 10 then ax:=9;
X    if x = 1 then ax:=3;
X    if x = 2 then ax:=3;
X  end
X  else
X    if x =1 then ax:=2
X  else
X    if x =10 then ax:=9
X  else
X    ax:=x;
X
X
X  if rotint = -1 then
X  begin
X    if position = 1 then newposition:=4
X    else
X      newposition:=position -1;
X  end
X  else
X  if rotint = 1 then
X  begin
X    if position = 4 then newposition:=1
X    else
X      newposition:=position +1;
X  end;
X
X
X  check(shape,newposition,y,ax,change);
X  if change = true then
X  begin
X    shapestuff(shape,position,y,x,screen,0);
X    position:=newposition;
X    x:=ax;
X    shapestuff(shape,position,y,x,screen,2);
X    printshape(screen,y,x);
X  end;
Xend;
V{*****************************************************************************
X}
X
X
V{*****************************************************************************
X}
Xprocedure Movement(var screen:screenarray; shape,position:integer;
X                   var y,x:integer; d:integer);
X
X
Xvar
X  move:boolean;
X  a,
X  b:integer;
Xbegin
X  move:=true;
X  if d = 1 then
X  begin
X    for a:= x+2 downto x-2 do
X      for b:=y+2 downto y-1 do
X        if (a >1) and (a<11) and (b > 1) and (b < 23) then
X        begin
X          if (a = 10) and (screen[b,a] = 2) then move:=false;
X          if (screen[b,a] = 1) and (screen[b,a-1] = 2) then move:=false;
X        end;
X  end
X  else
X  if d = -1 then
X  begin
X    for a:=x-3 to x+1 do
X      for b:=y-1 to y+2 do
X        if (a >0) and (a<9) and (b>1) and (b<23) then
X        begin
X          if (a = 1) and (screen[b,a] = 2) then move:=false;
X          if (screen[b,a] = 1) and (screen[b,a+1] = 2) then move:=false;
X        end;
X  end;
X  if move = true then
X  begin
X    shapestuff(shape,position,y,x,screen,0);
X    x:=x+d;
X    shapestuff(shape,position,y,x,screen,2);
X    printshape(screen,y,x);
X  end;
Xend;
X{************************************************************************}
V{*****************************************************************************
X}
Vprocedure Down(var screen:screenarray; shape,position:integer; var y,x:integer
X;
X               var fast:boolean);
X
X
Xvar
X  move:boolean;
X  a,
X  b:integer;
X
Xbegin
X  move:=true;
X  for b:=y+3 downto y-1 do
X    for a:= x+2 downto x-2 do
X      if (a >0) and (a<11) and (b > 1) and (b < 23) then
X      begin
X        if (b = 22) and (screen[b,a] = 2) then move:=false;
X        if (screen[b,a] = 1) and (screen[b-1,a] = 2) then move:=false;
X      end;
X  if move = true then
X  begin
X    if fast = true then
X    begin
X      y:=y+1;
X      shapestuff(shape,position,y-1,x,screen,0);
X      printshape(screen,y,x);
X      shapestuff(shape,position,y,x,screen,2);
X      repeat
X        move:=true;
X        for b:=y+3 downto y-1 do
X          for a:= x+2 downto x-2 do
X            if (a >0) and (a<11) and (b > 1) and (b < 23) then
X            begin
X              if (b = 22) and (screen[b,a] = 2) then move:=false;
X              if (screen[b,a] = 1) and (screen[b-1,a] = 2 ) then move:=false;
X            end;
X         if move = true then
X         begin
X           y:=y+1;
X           shapestuff(shape,position,y-1,x,screen,0);
X           shapestuff(shape,position,y,x,screen,2);
X         end;
X       until move=false;
X       printshape(screen,y,x);
X    end
X    else
X    begin
X      y:=y+1;
X      screen[y-1,x]:=0;
X      screen[y,x]:=2;
X      shapestuff(shape,position,y-1,x,screen,0);
X      shapestuff(shape,position,y,x,screen,2);
X      printshape(screen,y,x);
X    end;
X  end;
X  fast:=false;
Xend;
X{************************************************************************}
X
Xprocedure printall(screen:screenarray; score,lines,level:integer);
X
X
Xvar
X  a,
X  b:integer;
X  g,
X  h,
X  xchrhigh,
X  xchrlow,
X  ychrhigh,
X  ychrlow:char;
X  stuff:packed array[1..10] of char;
X
Xbegin
X
X  cls;
X  for I:=1 to 22 do
X  begin
X    intochar(g,h,ychrhigh,ychrlow,1,I);
X    writeln(chr(27),'[',ychrhigh,ychrlow,';30H|          |');
X  end;
X  writeln(chr(27),'[23;30H------------');
X  if flag then writeln(chr(27),'[03;49HNEXT');
X  writeln(chr(27),'[10;1HSCORE:',score:1);
X  writeln(chr(27),'[12;1HLEVEL:',level:1);
X  writeln(chr(27),'[14;1HLINES:',((5*level)-lines):2);
X  for a:=1 to 22 do
X  begin
X    intochar(xchrhigh,xchrlow,ychrhigh,ychrlow,31,a);
X    for b:=1 to 10 do
X    begin
X      if screen[a,b] = 1 then stuff[b]:='#'
X      else
X        stuff[b]:=' ';
X    end;
X    writeln(chr(27),'[',ychrhigh,ychrlow,';31H',stuff);
X  end;
Xend;
V{*****************************************************************************
X*}
X
V{*****************************************************************************
X*}
Xprocedure editshape(key:integer; var nshape:integer);
X
X
Xbegin
X  nshape:=key-48;
X  printnext(nshape);
Xend;
V{*****************************************************************************
X*}
X{***********************************************}
Xprocedure getyearday(inp:datestr; var year,day:integer);
X
Xvar
X  digit1,
X  digit2,
X  digit3,
X  digit4:integer;
X  offset:integer;
X
Xbegin
X  offset:= ord('1') + 1;
X  digit1:= ord(inp[8]) - offset;
X  digit2:= ord(inp[9]) - offset;
X  digit3:= ord(inp[10]) - offset;
X  digit4:= ord(inp[11]) - offset;
X  year:= digit4 + (10*digit3) + (100*digit2) + (1000*digit1);
X  digit1:= ord(inp[1]) - offset;
X  digit2:= ord(inp[2]) - offset;
X  day:= digit2 + (10*digit1);
Xend;
X{************************************************}
X
X{**********************************************}
Xprocedure getmonth(inp:datestr; var month:integer);
X
Xbegin
X
X  if (inp[4] = 'J') and (inp[5] = 'A') then month:=1
X  else
X  if (inp[4] = 'F') then month:=2
X  else
X  if (inp[4] = 'M') and (inp[6] = 'R') then month:=3
X  else
X  if (inp[4] = 'A') and (inp[5] = 'P') then month:=4
X  else
X  if (inp[4] = 'M') and (inp[6] = 'Y') then month:=5
X  else
X  if (inp[4] = 'J') and (inp[6] = 'N') then month:=7
X  else
X  if (inp[4] = 'J') then month:=6
X  else
X  if (inp[4] = 'A') and (inp[5] = 'U') then month:=8
X  else
X  if (inp[4] = 'S') then month:=9
X  else
X  if (inp[4] = 'O') then month:=10
X  else
X  if (inp[4] = 'N') then month:=11
X  else
X  if (inp[4] = 'D') then month:=12;
Xend;
X
V{*****************************************************************************
X*}
V{*****************************************************************************
X*}
Xfunction older(one,two:datestr):boolean;
X
X
Xvar
X  oneyear,
X  twoyear,
X  onemonth,
X  twomonth,
X  oneday,
X  twoday:integer;
X
Xbegin
X  getyearday(one,oneyear,oneday);
X  getyearday(two,twoyear,twoday);
X  getmonth(one,onemonth);
X  getmonth(two,twomonth);
X  if oneyear < twoyear then older:=true
X  else
X    if onemonth < twomonth then older:=true
X    else
X      if oneday < twoday then older:=true
X      else
X        older:=false;
Xend;
V{*****************************************************************************
X*}
V{*****************************************************************************
X*}
X
X
V{*****************************************************************************
X*}
V{*****************************************************************************
X*}
XProcedure MainGame(left,right,rotleft,rotright,speed,quitkey,redraw:char;
X                   level:integer; cheat:boolean);
X
Xvar
X  oldest:integer;
X  saved,
X  saving:saverec;
X  count:integer;
X  quit:boolean;
X  a,b:integer;
X  height:integer;
X  choice:char;
X  nx,
X  ny,
X  nshape,
X  nposition:integer;
X  fast:boolean;
X  gotin:boolean;
X
Xbegin
X
Xrandomise;
Xif restored = false then
Xbegin
X  for a:=1 to 22 do
X    for b:=1 to 10 do
X      screen[a,b]:=0;
X  score:=0;
X  position:=1;
X  create(shape,position,y,x);
X  lines:=0;
X  shapestuff(shape,position,y,x,screen,2);
Xend;
Xcreate(nshape,nposition,ny,nx);
Xcount:=0;
Xfast:=false;
Xquit:=false;
Xott:=false;
Xcls;
X
Xprintshape(screen,y,x);
Xprintall(screen,score,lines,level);
Xif restored then
X  writeln(chr(27),'[10;49HPress any key to continue game')
Xelse
X  writeln(chr(27),'[10;49HPress any key to play game');
Xwaitkey(key,chan);
Xwriteln(chr(27),'[10;49H                                ');
Xrestored:=false;
Xif flag then printnext(nshape);
Xrepeat
X  readkey(key,chan);
X  choice:=chr(key);
X  if choice = left then Movement(screen,shape,position,y,x,-1)
X  else
X  if choice = right then movement(screen,shape,position,y,x,1)
X  else
X  if choice = rotleft then Rotation(screen,shape,position,-1,y,x)
X  else
X  if choice = rotright then Rotation(screen,shape,position,1,y,x)
X  else
X  if choice = speed then fast:=true
X  else
X  if  (choice in ['1'..'7']) and (cheat = true) then editshape(key,nshape)
X  else
X  if choice = redraw then
X  begin
X    printall(screen,score,lines,level);
X    if flag then printnext(nshape);
X  end
X  else
X    if choice = quitkey then ott:=true
X  else
X    if choice = '!' then
X    begin
X      cls;
X      writeln('%DCL-I-SPAWN, Type eoj to return to Shapes');
X      spawn;
X      printall(screen,score,lines,level);
X      if flag then printnext(nshape);
X      writeln(chr(27),'[10;49HPress any key to continue Shapes');
X      waitkey(key,chan);
X      writeln(chr(27),'[10;49H                                ');
X    end
X  else
X    if choice = '@' then
X    begin
X      cls;
X      Writeln(                      'Save game option');
X      usernum(userid);
X      if (userid = 'CADP02  ') or
X         (userid = 'CADP03  ') then
X      begin
X        write('Enter username, MAX 8 letters, RETURN for default: ');
X        userid:='        ';
X        readln(userid);
X        if userid[1] = ' ' then usernum(userid);
X      end;
X      saving.num:=score;
X      saving.level:=level;
X      saving.outp:=screen;
X      saving.lines:=lines;
X      saving.x:=x;
X      saving.y:=y;
X      saving.shape:=shape;
X      saving.position:=position;
X      saving.user:=userid;
X      DATE(saving.current);
X      open(Save,Savefile,history:=readonly);
X      reset(save);
X      del:=false;
X      for I:=1 to 100 do
X      begin
X        read(save,peeps[I]);
X        if (del = true) and (peeps[I].user = saving.user) then
X          peeps[I].user:='UNUSED  ';
X        if (del = false) and (peeps[I].user = 'UNUSED  ') then
X        begin
X          peeps[I]:=saving;
X          del:=true;
X        end;
X        if (del = false) and (peeps[I].user = saving.user) then
X        begin
X          del:=true;
X          peeps[I]:=saving;
X        end;
X      end;
X      if del = false then
X      begin
X        reset(save);
X        read(save,peeps[1]);
X        oldest:=1;
X        for I:=2 to 100 do
X        begin
X          read(save,peeps[I]);
X          if older(peeps[I-1].current,peeps[I].current) = false then
X            oldest:=I;
X        end;
X        peeps[oldest]:=saving;
X      end;
X      close(save);
X      open(Save,Savefile,history:=old);
X      rewrite(save);
X      for I:=1 to 100 do
X        write(save,peeps[I]);
X      close(save);
X      ott:=true;
X      del:=false;
X      writeln('Game saved.');
X      writeln('Press any key for main menu.');
X      waitkey(key,chan);
X    end;
X  if count = 3 then
X  begin
X    height:=y;
X    Down(screen,shape,position,y,x,fast);
X    if height = y then
X    begin
X      for a:=1 to 10 do
X        if screen[1,a]=2 then ott:=true;
X      shapestuff(shape,position,y,x,screen,1);
X      printshape(screen,y,x);
X      linestuff(screen,lines,level,score);
X      shape:=Nshape;
X      position:=Nposition;
X      y:=Ny;
X      x:=Nx;
X      create(nshape,nposition,ny,nx);
X      if flag then printnext(nshape);
X      shapestuff(shape,position,y,x,screen,2);
X      if lines >= 5*level then
X      begin
X        level:=level+1;
X        bonus(score,screen,level);
X        lines:=0;
X        printall(screen,score,lines,level);
X        if flag then printnext(nshape);
X      end;
X    end;
X    count:=0;
X  end;
X  count:=count+1;
Xuntil OTT = true;
X
Xif choice <> '@' then
Xbegin
X  highscores(score,level,Htable,scores,gotin);
X  if gotin then viewscores(Htable,scores,key,chan)
Xend
Xend;
V{*****************************************************************************
X*}
V{*****************************************************************************
X*}
X
V{*****************************************************************************
X*}
V{*****************************************************************************
X*}
XProcedure RESTORE;
X
Xvar
X  I:integer;
X
Xbegin
X  cls;
X  writeln('                    Restore saved game option');
X  usernum(userid);
X  if (userid = 'CADP02  ') or
X     (userid = 'CADP03  ') then
X  begin
X    write('Enter username, MAX 8 letters, RETURN for default: ');
X    userid:='        ';
X    readln(userid);
X    if userid[1] = ' ' then usernum(userid);
X  end;
X  restored:=false;
X  open(Save,Savefile,history:=readonly);
X  reset(save);
X  for I:=1 to 100 do
X  begin
X    read(save,peeps[I]);
X    if peeps[I].user = userid then
X    begin
X      cls;
X      writeln('Restoring...');
X      lines:=peeps[I].lines;
X      position:=peeps[I].position;
X      x:=peeps[I].x;
X      y:=peeps[I].y;
X      shape:=peeps[I].shape;
X      screen:=peeps[I].outp;
X      score:=peeps[I].num;
X      level:=peeps[I].level;
X      peeps[I].user:='UNUSED  ';
X      restored:=true;
X    end;
X  end;
X  close(save);
X  open(save,savefile,history:=old);
X  rewrite(save);
X  for I:=1 to 100 do
X    write(save,peeps[I]);
X  close(save);
X  if restored = true then
X  begin
X    writeln('Restored.');
X    writeln('Press any key for main screen');
X    waitkey(key,chan);
X    MAINGAME(left,right,rotleft,rotright,speed,quitkey,redraw,level,cheat);
X  end
X  else
X  begin
X    writeln('Data file not found.');
X    writeln('Press any key to return to main menu.');
X    waitkey(key,chan);
X  end;
Xend;
X
V{*****************************************************************************
X*}
V{*****************************************************************************
X*}
X
X{*******************************************************************}
Xbegin {SHAPES}
X  cls;
X  MAKECHAN(chan);
X  HP := FALSE;
X  flag:=true;
X  flag2:=false;
X  cheat:=false;
X  left:='z';right:='x';rotleft:='o';rotright:='p';speed:='[';quitkey:='q';
X  factor:=0.15;
X  redraw:='r';
X  levelmin:=1;
X  for I:=1 to 22 do
X    begin {for}
X    for J:=1 to 10 do
X      screen[I,J]:=0;
X    end; {for}
X  repeat
X    MENUPRINT;
X    repeat
X      if chr(key) = 'c' then flagA:=true;
X      if chr(key) = 'a' then
X      begin
X        if flagA = true then flagB:=true
X        else flagB:=false;
X      end;
X      if chr(key) = 'd' then
X      begin
X        if flagB = true then flagC:=true
X        else flagC:=false;
X      end;
X      if chr(key) = 'p' then
X      begin
X        if flagC = true then flagD:=true
X        else flagD:=false;
X      end;
X      if (chr(key) <> 'c') and (chr(key) <> 'a') and
X         (chr(key) <> 'd') and (chr(key) <> 'p') then
X      begin
X        flagA:=false;
X        flagB:=false;
X        flagC:=false;
X        flagD:=false;
X      end;
X      waitkey(key,chan);
X    until chr(key) in ['0'..'8'];
X    level:=levelmin;
X    if chr(key) <> '8' then flagD:=false;
X    if chr(key)='1' then
X      MAINGAME(left,right,rotleft,rotright,speed,quitkey,redraw,level,cheat);
V    if chr(key)='2' then KEYDEFINE(left,right,rotleft,rotright,speed,quitkey,r
Xedraw);
X    if chr(key)='3' then VIEWSCORES(Htable,scores,key,chan);
X    if chr(key)='4' then INSTRUCTIONS;
X    if chr(key)='5' then flag:=not(flag);
X    if chr(key)='6' then flag2:=not(flag2);
X    if chr(key)='7' then RESTORE;
X    if flagD then
X    begin
X      cheat:=true;
X      write('level??: ');
X      readln(levelmin);
X      write('reset savefile??: ');
X      readln(answer);
X      if (answer = 'y') or (answer = 'Y') then
X      begin
X        blank.user:='UNUSED  ';
X        open(Save,Savefile,history:=unknown);
X        rewrite(save);
X        for I:=1 to 100 do
X          write(save,blank);
X        close(save);
X      end;
X      write('reset scoreboard??: ');
X      readln(answer);
X      if (answer='y') or (answer ='Y') then
X      begin
X        open (Htable , Htablefile ,
X`009  history := unknown);
X        rewrite(Htable);
X        for A:= 1 to 10 do
X        begin
X          scores[A].num:=0;
X          scores[A].name:='                                        ';
X          scores[A].level:=1;
X          scores[A].id:='        ';
X        end;
X        for A:=1 to 10 do
X          write(Htable,scores[A]);
X        close(Htable);
X      end;
X    end;
X  until (chr(key)='0');
X  cls;
X    writeln('There now, that didn''t hurt much did it??');
X    writeln('Byeeeeeeeeee........');
Xend. {SHAPES}
X{*******************************************************************}
X
$GoSub Convert_File
$Exit