Source Code 1994 March/Source_Code_CD-ROM_Walnut_Creek_March_1994.iso/compsrcs/games/vmsnet/tetris/part03

Text File | 1992-07-01 | 28.6 KB | 1,052 lines

Path: uunet!caen!kuhub.cc.ukans.edu!nrlvx1.nrl.navy.mil!koffley
Newsgroups: vmsnet.sources.games
Subject: TETRIS_VMS.03_OF_05
Message-ID: <[e-mail]>
From: [e-mail]
Date: 2 Jul 92 12:39:36 -0400
Organization: NRL SPACE SYSTEMS DIVISION
Lines: 1042

-+-+-+-+-+-+-+-+ START OF PART 3 -+-+-+-+-+-+-+-+
XX
XXif choice <> '@' then
XXbegin
XX  highscores(score,level,Htable,scores,gotin);
XX  if gotin then viewscores(Htable,scores,key,chan)
XXend
XXend;
XV`7B************************************************************************
V*****
XX*`7D
XV`7B************************************************************************
V*****
XX*`7D
XX
XV`7B************************************************************************
V*****
XX*`7D
XV`7B************************************************************************
V*****
XX*`7D
XXProcedure RESTORE;
XX
XXvar
XX  I:integer;
XX
XXbegin
XX  cls;
XX  writeln('                    Restore saved game option');
XX  usernum(userid);
XX  if (userid = 'CADP02  ') or
XX     (userid = 'CADP03  ') then`20
XX  begin
XX    write('Enter username, MAX 8 letters, RETURN for default: ');
XX    userid:='        ';
XX    readln(userid);
XX    if userid`5B1`5D = ' ' then usernum(userid);
XX  end;
XX  restored:=false;
XX  open(Save,Savefile,history:=readonly);
XX  reset(save);
XX  for I:=1 to 100 do
XX  begin
XX    read(save,peeps`5BI`5D);
XX    if peeps`5BI`5D.user = userid then
XX    begin
XX      cls;
XX      writeln('Restoring...');
XX      lines:=peeps`5BI`5D.lines;
XX      position:=peeps`5BI`5D.position;
XX      x:=peeps`5BI`5D.x;
XX      y:=peeps`5BI`5D.y;
XX      shape:=peeps`5BI`5D.shape;
XX      screen:=peeps`5BI`5D.outp;
XX      score:=peeps`5BI`5D.num;
XX      level:=peeps`5BI`5D.level;
XX      peeps`5BI`5D.user:='UNUSED  ';
XX      restored:=true;
XX    end;
XX  end;
XX  close(save);
XX  open(save,savefile,history:=old);
XX  rewrite(save);
XX  for I:=1 to 100 do
XX    write(save,peeps`5BI`5D);
XX  close(save);
XX  if restored = true then
XX  begin
XX    writeln('Restored.');
XX    writeln('Press any key for main screen');
XX    waitkey(key,chan);
XX    MAINGAME(left,right,rotleft,rotright,speed,quitkey,redraw,level,cheat);
XX  end
XX  else
XX  begin
XX    writeln('Data file not found.');
XX    writeln('Press any key to return to main menu.');
XX    waitkey(key,chan);
XX  end;
XXend;
XX
XV`7B************************************************************************
V*****
XX*`7D
XV`7B************************************************************************
V*****
XX*`7D
XX
XX`7B*******************************************************************`7D
XXbegin `7BSHAPES`7D
XX  cls;
XX  MAKECHAN(chan);
XX  HP := FALSE;
XX  flag:=true;
XX  flag2:=false;
XX  cheat:=false;
XX  left:='z';right:='x';rotleft:='o';rotright:='p';speed:='`5B';quitkey:='q'
V;
XX  factor:=0.15;
XX  redraw:='r';
XX  levelmin:=1;
XX  for I:=1 to 22 do
XX    begin `7Bfor`7D
XX    for J:=1 to 10 do
XX      screen`5BI,J`5D:=0;
XX    end; `7Bfor`7D
XX  repeat
XX    MENUPRINT;
XX    repeat
XX      if chr(key) = 'c' then flagA:=true;
XX      if chr(key) = 'a' then
XX      begin
XX        if flagA = true then flagB:=true
XX        else flagB:=false;
XX      end;
XX      if chr(key) = 'd' then
XX      begin
XX        if flagB = true then flagC:=true
XX        else flagC:=false;
XX      end;
XX      if chr(key) = 'p' then
XX      begin
XX        if flagC = true then flagD:=true
XX        else flagD:=false;
XX      end;
XX      if (chr(key) <> 'c') and (chr(key) <> 'a') and
XX         (chr(key) <> 'd') and (chr(key) <> 'p') then
XX      begin
XX        flagA:=false;
XX        flagB:=false;
XX        flagC:=false;
XX        flagD:=false;
XX      end;
XX      waitkey(key,chan);
XX    until chr(key) in `5B'0'..'8'`5D;`20
XX    level:=levelmin;
XX    if chr(key) <> '8' then flagD:=false;
XX    if chr(key)='1' then
XX      MAINGAME(left,right,rotleft,rotright,speed,quitkey,redraw,level,cheat
V);
XV    if chr(key)='2' then KEYDEFINE(left,right,rotleft,rotright,speed,quitke
Vy,r
XXedraw);
XX    if chr(key)='3' then VIEWSCORES(Htable,scores,key,chan);
XX    if chr(key)='4' then INSTRUCTIONS;
XX    if chr(key)='5' then flag:=not(flag);
XX    if chr(key)='6' then flag2:=not(flag2);
XX    if chr(key)='7' then RESTORE;
XX    if flagD then
XX    begin
XX      cheat:=true;
XX      write('level??: ');
XX      readln(levelmin);
XX      write('reset savefile??: ');
XX      readln(answer);
XX      if (answer = 'y') or (answer = 'Y') then
XX      begin
XX        blank.user:='UNUSED  ';
XX        open(Save,Savefile,history:=unknown);
XX        rewrite(save);
XX        for I:=1 to 100 do
XX          write(save,blank);
XX        close(save);
XX      end;
XX      write('reset scoreboard??: ');
XX      readln(answer);
XX      if (answer='y') or (answer ='Y') then
XX      begin
XX        open (Htable , Htablefile ,
XX`60009  history := unknown);
XX        rewrite(Htable);
XX        for A:= 1 to 10 do
XX        begin
XX          scores`5BA`5D.num:=0;
XX          scores`5BA`5D.name:='                                        ';
XX          scores`5BA`5D.level:=1;
XX          scores`5BA`5D.id:='        ';
XX        end;
XX        for A:=1 to 10 do
XX          write(Htable,scores`5BA`5D);
XX        close(Htable);
XX      end;
XX    end;
XX  until (chr(key)='0');
XX  cls;
XX    writeln('There now, that didn''t hurt much did it??');
XX    writeln('Byeeeeeeeeee........');
XXend. `7BSHAPES`7D
XX`7B*******************************************************************`7D
XX
X$GoSub Convert_File
X$Exit
$ CALL UNPACK TETRIS_BUILD.COM;1 728168150
$ create 'f'
Xprogram Shapes(input,output,Htable,Save);
X
X
X`7B*************************************************************************
V******
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`20
X   documentation for any purpose and without fee is hereby granted,`20
X   provided that the above copyright notice appear in all copies and that
X   both that copyright notice and this permission notice appear in`20
X   supporting documentation.
X****************************************************************************
V***`7D
X
X
X
Xconst
X  Htablefile='my$root:`5Brcd.tetris`5DHtable.dat';
X  Savefile='my$root:`5Brcd.tetris`5Dsave.dat';
X
Xtype
X  string = packed array`5B1..8`5D of char;
X  scorerec = record
X      num:integer;
X     name:packed array`5B1..40`5D of char;
X     level:integer;
X     id:string;
X     end;
X  recfile = file of scorerec;
X  scorearray = array`5B1..10`5D of scorerec;
X  screenarray = array`5B1..22,1..10`5D of integer;
X  timearray = packed array`5B1..11`5D of char;
X  datestr = packed array `5B1..11`5D 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`5B1..100`5D 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`7B*****************************************************************`7D
Xprocedure CLS;
Xbegin `7BCLS`7D
Xwrite(chr(27),'`5BH');
Xwriteln(chr(27),'`5B2J');
Xend; `7BCLS`7D
X`7B*****************************************************************`7D
X
X`7B*****************************************************************`7D
X`7B*************************************************************************
V****`7D
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`7B*****************************************************************`7D
X
X
X`7B******************************************************************`7D
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`5BI`5D);
X    I:=I+1;
X  end;
X  close(Htable);
X  for A:= I to 10 do
X  begin
X    scores`5BA`5D.num:=0;
X    scores`5BA`5D.name:='                                        ';
X    scores`5BA`5D.level:=1;
X    scores`5BA`5D.id:='        ';
X  end;
X  if score > scores`5B10`5D.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`5B1`5D=' ' then usernum(userid);
X    end;
X
X    for I := 10 downto 1 do
X    begin
X      if userid = scores`5BI`5D.id then
X      begin`20
X       if score > scores`5BI`5D.num then
X        begin
X          for J := I to 9 do
X            scores`5BJ`5D := scores`5BJ+1`5D;
X          if I = 9 then
X            scores`5B9`5D := scores`5B10`5D;
X          scores`5B10`5D.num:=0;
X          scores`5B10`5D.name:='                                       ';
X          scores`5B10`5D.level:=1;
X          scores`5B10`5D.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`5BA`5D:=' ';
X      Writeln('Enter name, maximum 40 chars:');
X      write(':');
X      readln(newscore.name);
X      usernum(userid);
X      if (userid='CADP03  ') or`20
X         (userid='CADP02  ') or`20
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`5B1`5D=' ' 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`5BI`5D.num do
X        I:=I+1;
X      for A:=10 downto I+1 do
X        scores`5BA`5D:=scores`5BA-1`5D;   `20
X      scores`5BI`5D:=newscore;
X      open (Htable , Htablefile ,
X  `09history := old);
X      rewrite(Htable);
X      for I:=1 to 10 do
X        write(Htable,scores`5BI`5D);
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`7B*************************************************************`7D
X
X
X`7B*************************************************************`7D
Xprocedure viewscores(var Htable:recfile; scores:scorearray; key,chan:integer
V);
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`20
X  begin
X    read(Htable,score);
X    scores`5BI`5D:=score;
X    I:=I+1;
X  end;
X  close (Htable);
X  for A:= I to 10 do
X  begin
X    scores`5BI`5D.num:=0;
X    scores`5BI`5D.name:='                                        ';
X    scores`5BI`5D.level:=1;
X    scores`5BI`5D.id:='        ';
X  end;
X  Writeln('                       Shapes HIGH SCORE TABLE');
X  writeln;writeln;
X  writeln('          score              name                           level
V  userid');
X  for I:=1 to 10 do
X  begin
X    writeln(I:2,'. ',scores`5BI`5D.num,'     ',scores`5BI`5D.name,'  ',
X            scores`5BI`5D.level:2,'    ',scores`5BI`5D.id);
X  end;
Xwriteln;writeln;
Xwriteln('                         Press any key to return to main menu');
Xwaitkey(key,chan);
Xend;
X
X`7B***********************************************************`7D
X
X
X`7B************************************************************`7D
Xprocedure INTOCHAR(var xchrhigh,xchrlow,
X                       ychrhigh,ychrlow:char; x,y:integer);
X
Xbegin `7BINTOCHAR`7D
X  xchrhigh`09:= chr(ord('0') + x div 10) ;
X  xchrlow`09:= chr(ord('0') + x mod 10) ;
X
X  ychrhigh`09:= chr(ord('0') + y div 10) ;
X  ychrlow`09:= chr(ord('0') + y mod 10) ;
X
Xend; `7BINTOCHAR`7D
X`7B*********************************************************************`7D
X
X
X`7B*****************************************************************`7D
Xprocedure MENUPRINT;
X
Xbegin
X  CLS;
X  writeln(chr(27),'#3               Shapes');
X  writeln(chr(27),'#4               Shapes');
X  writeln(chr(27),'`5B22;25HCopyright 1989,1990 LokiSoft Ltd.');
X  writeln(chr(27),'`5B09;31H1. Play Shapes');
X  writeln(chr(27),'`5B10;31H2. Redefine Keys');
X  writeln(chr(27),'`5B11;31H3. View Score Board');
X  writeln(chr(27),'`5B12;31H4. Instructions');
X  write(chr(27),'`5B13;31H5. Print Next Shape');
X  if flag then writeln('  (YES)') else writeln('  (NO) ');
X  write(chr(27),'`5B14;31H6. Slow Down Game');
X  if flag2 then writeln('   (YES)') else writeln('   (NO) ');
X  writeln(chr(27),'`5B15;31H7. Restore Saved Game');
X  writeln(chr(27),'`5B17;31H0. Exit from game');
X  writeln(chr(27),'`5B19;31HEnter choice from options above');
X  writeln;
Xend;
X`7B**********************************************************************`7D
X`7B*****************************`7D
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'
V);
Xwriteln('a time, you receive a bonus dependent on the level you are on and t
Vhe');
Xwriteln('number of lines completed.');
Xwriteln('After completing 5 lines, you move on to level 2 where you have to'
V);
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'
V);
Xwriteln('you are on, and how low the pile of bricks is,..the lower the pile,
V');
Xwriteln('the higher the bonus');
Xwriteln('For each level, the number of points per completed line, and potent
Vial');
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('     `5B - 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,'
V);
Xwriteln('and if you attempt to save a game when you already have one stored,
V');
Xwriteln('the stored game will be written over!!!');
Xwriteln('Stored games will automatically be deleted when restored.');
Xwriteln;
Xwriteln('There is total space on the save-file for 100 games, and when it is
V');
Xwriteln('full, whenever anyone attempts to save their game, the oldest previ
Vous');
Xwriteln('saved game is written over!');
Xwriteln;
Xwriteln('Note on Slowing down game option:-');
Xwriteln;
Xwriteln('This option is intended only for people using workstations or simil
Var');
Xwriteln('which vastly speed up the screen printing, thereby making the game'
V);
Xwriteln('unplayable. The slow down option negates this problem.');
Xwriteln;
Xwriteln('Now I''ll take this opportunity to wish you happy playing and good'
V);
Xwriteln('luck, you''ll need it!!!!');
Xwriteln(chr(27),'`5B22;30HPress any key for main menu');
Xwaitkey(key,chan);
Xend;
X`7B*****************************`7D
X
X
X
X`7B*******************************************************************`7D `2
V0
Xprocedure KEYDEFINE(var left,right,rotleft,rotright,speed,quitkey,redraw:cha
Vr);
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 `7BKEYDEFINE`7D
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`20
X        (speedint=leftint) or`20
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`20
X        (quitint=leftint) or`20
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; `7BKEYDEFINE`7D
X`7B*******************************************************************`7D
X
X
X
X`7B***********************************************************************`7
VD
Xprocedure Shapestuff(shape,position,y,x:integer; var screen:screenarray;
X                     n:integer);
Xbegin
X  screen`5By,x`5D:=n;
X  if shape = 1 then
X  begin
X    screen`5By,x+1`5D:=n;
X    screen`5By+1,x`5D:=n;
X    screen`5By+1,x+1`5D:=n;
X  end
X  else
X  if shape = 2 then
X  begin
X    if position = 1 then
X    begin
X      screen`5By-1,x`5D:=n;
X      screen`5By+1,x`5D:=n;
X      screen`5By+1,x+1`5D:=n;
X    end
X    else
X    if position = 2 then
X    begin
X      screen`5By,x+1`5D:=n;
X      screen`5By,x-1`5D:=n;
X      screen`5By+1,x-1`5D:=n;
X    end
X    else
X    if position = 3 then
X    begin
X      screen`5By+1,x`5D:=n;
X      screen`5By-1,x`5D:=n;
X      screen`5By-1,x-1`5D:=n;
X    end
X    else
X    if position = 4 then
X    begin
X      screen`5By,x-1`5D:=n;
X      screen`5By,x+1`5D:=n;
X      screen`5By-1,x+1`5D:=n;
X    end;
X  end
X  else
X  if shape = 3 then
X  begin
X    if position = 1 then
X    begin
X      screen`5By-1,x`5D:=n;
X      screen`5By+1,x`5D:=n;
X      screen`5By+1,x-1`5D:=n;
X    end
X    else
X    if position = 2 then
X    begin
X      screen`5By,x+1`5D:=n;
X      screen`5By,x-1`5D:=n;
X      screen`5By-1,x-1`5D:=n;
X    end
X    else
X    if position = 3 then
X    begin
X      screen`5By-1,x`5D:=n;
X      screen`5By+1,x`5D:=n;
X      screen`5By-1,x+1`5D:=n;
X    end
X    else
X    if position = 4 then
X    begin
X      screen`5By,x-1`5D:=n;
X      screen`5By,x+1`5D:=n;
X      screen`5By+1,x+1`5D:=n;
X    end;
X  end
X  else
X  if shape = 4 then
X  begin
X    if position = 1 then
X    begin
X      screen`5By-1,x`5D:=n;
X      screen`5By+1,x`5D:=n;
X      screen`5By,x+1`5D:=n;
X    end
X    else
X    if position = 2 then
X    begin
X      screen`5By+1,x`5D:=n;
X      screen`5By,x-1`5D:=n;
X      screen`5By,x+1`5D:=n;
X    end
X    else
X    if position = 3 then
X    begin
X      screen`5By-1,x`5D:=n;
X      screen`5By+1,x`5D:=n;
X      screen`5By,x-1`5D:=n;
X    end
X    else
X    if position = 4 then
X    begin
X      screen`5By-1,x`5D:=n;
X      screen`5By,x-1`5D:=n;
X      screen`5By,x+1`5D:=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`5By+1,x`5D:=n;
X      screen`5By,x+1`5D:=n;
X      screen`5By-1,x+1`5D:=n;
X    end
X    else
X    if (position = 2) or (position = 4) then
X    begin
X      screen`5By,x-1`5D:=n;
X      screen`5By+1,x`5D:=n;
X      screen`5By+1,x+1`5D:=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`5By-1,x`5D:=n;
X      screen`5By,x+1`5D:=n;
X      screen`5By+1,x+1`5D:=n;
X    end
X    else
X    if (position = 2) or (position = 4) then
X    begin
X      screen`5By,x+1`5D:=n;
X      screen`5By+1,x`5D:=n;
X      screen`5By+1,x-1`5D:=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`5By-1,x`5D:=n;
X      screen`5By+1,x`5D:=n;
X      screen`5By+2,x`5D:=n;
X    end
X    else
X    if (position = 2) or (position = 4) then
X    begin
X      screen`5By,x-2`5D:=n;
X      screen`5By,x-1`5D:=n;
X      screen`5By,x+1`5D:=n;
X    end;
X  end;
Xend;
X`7B*************************************************************************
V***`7D
X
X
X`7B***********************************************************************`7
VD
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`5By-1,x`5D=1 then change:= false
X    else
X      if screen`5By+1,x`5D=1 then change:= false
X    else
X      if screen`5By+1,x+1`5D=1 then change:= false;
X    end
X    else
X    if position = 2 then
X    begin
X      if screen`5By,x+1`5D=1 then change:= false else
X      if screen`5By,x-1`5D=1 then change:= false else
X      if screen`5By+1,x-1`5D=1 then change:= false;
X    end
X    else
X    if position = 3 then
X    begin
X      if screen`5By+1,x`5D=1 then change:= false else
X      if screen`5By-1,x`5D=1 then change:= false else
X      if screen`5By-1,x-1`5D=1 then change:= false;
X    end
X    else
X    if position = 4 then
X    begin
X      if screen`5By,x-1`5D=1 then change:= false else
X      if screen`5By,x+1`5D=1 then change:= false else
X      if screen`5By-1,x+1`5D=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`5By-1,x`5D=1 then change:= false else
X      if screen`5By+1,x`5D=1 then change:= false else
X      if screen`5By+1,x-1`5D=1 then change:= false;
X    end
X    else
X    if position = 2 then
X    begin
X      if screen`5By,x+1`5D=1 then change:= false else
X      if screen`5By,x-1`5D=1 then change:= false else
X      if screen`5By-1,x-1`5D=1 then change:= false;
X    end
X    else
X    if position = 3 then
X    begin
X      if screen`5By-1,x`5D=1 then change:= false else
X      if screen`5By+1,x`5D=1 then change:= false else
X      if screen`5By-1,x+1`5D=1 then change:= false;
X    end
X    else
X    if position = 4 then
X    begin
X      if screen`5By,x-1`5D=1 then change:= false else
X      if screen`5By,x+1`5D=1 then change:= false else
X      if screen`5By+1,x+1`5D=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`5By-1,x`5D=1 then change:= false else
X      if screen`5By+1,x`5D=1 then change:= false else
X      if screen`5By,x+1`5D=1 then change:= false;
X    end
X    else
X    if position = 2 then
X    begin
X      if screen`5By+1,x`5D=1 then change:= false else
X      if screen`5By,x-1`5D=1 then change:= false else
X      if screen`5By,x+1`5D=1 then change:= false;
X    end
X    else
X    if position = 3 then
X    begin
X      if screen`5By-1,x`5D=1 then change:= false else
X      if screen`5By+1,x`5D=1 then change:= false else
X      if screen`5By,x-1`5D=1 then change:= false;
X    end
X    else
X    if position = 4 then
X    begin
X      if screen`5By-1,x`5D=1 then change:= false else
X      if screen`5By,x-1`5D=1 then change:= false else
X      if screen`5By,x+1`5D=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`5By+1,x`5D=1 then change:= false else
X      if screen`5By,x+1`5D=1 then change:= false else
X      if screen`5By-1,x+1`5D=1 then change:= false;
X    end
X    else
X    if (position = 2) or (position = 4) then
X    begin
X      if screen`5By,x-1`5D=1 then change:= false else
X      if screen`5By+1,x`5D=1 then change:= false else
X      if screen`5By+1,x+1`5D=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`5By-1,x`5D=1 then change:= false else
X      if screen`5By,x+1`5D=1 then change:= false else
X      if screen`5By+1,x+1`5D=1 then change:= false;
X    end
X    else
X    if (position = 2) or (position = 4) then
X    begin
X      if screen`5By,x+1`5D=1 then change:= false else
X      if screen`5By+1,x`5D=1 then change:= false else
X      if screen`5By+1,x-1`5D=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`5By-1,x`5D=1 then change:= false else
X      if screen`5By+1,x`5D=1 then change:= false else
X      if screen`5By+2,x`5D=1 then change:= false;
X    end
X    else
X    if (position = 2) or (position = 4) then
X    begin
X      if screen`5By,x-2`5D=1 then change:= false else
X      if screen`5By,x-1`5D=1 then change:= false else
X      if screen`5By,x+1`5D=1 then change:= false;
X    end;
X  end;
Xend;
X`7B*************************************************************************
V***`7D
X
X
X`7B*************************************************************************
V***`7D
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
+-+-+-+-+-+-+-+-  END  OF PART 3 +-+-+-+-+-+-+-+-
--
\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
< Joe Koffley                        [e-mail]             >
< Naval Research Laboratory          [e-mail]             >
< Space Systems Division             AT&T  :  202-767-0894                   >
\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/