eg9413.pas

一个类似俄罗斯方块的游戏

(*
 * Copyright 1989, 1990 Eric Ng
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 1, or (at your option)
 * any later version.
 *
 * This program is distributed in the hope that it will be useful, but
 * without any warranty whatsoever, without even the implied warranties
 * of merchantability or fitness for a particular purpose.  See the
 * accompanying GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; see the file COPYING.  If not, write to:
 *
 * Free Software Foundation, Inc.
 * 675 Massachusetts Avenue
 * Cambridge, Massachusetts 02139
 *)

{$a-}
{$b-}
{$d-}
{$e-}
{$f-}
{$i-}
{$l-}
{$n-}
{$o-}
{$r-}
{$s-}
{$v-}

Program egaint;

 Uses
  Crt, Dos, Driver, Fonts, Graph;


 Const
  id		  : String [6]	= 'egaint';
  version	  : String [7]	= '0.94.13';
  copyright	  : String [27] = 'Copyright 1989-90 Eric Ng';

  nshapes	  = 26; 	    { different shapes }
  shapesiz	  = 5;		    { max size of each shape }
  xshapelevels	  = 4;		    { levels (classic, easy, medium, hard) }
  xshapeclassic   = 7;		    { different classic shapes }
  xshapeeasy	  = 13; 	    { different easy extended shapes }
  xshapemedium	  = 19;
  xshapehard	  = 26; 	    { different hard extended shapes }

  nkeybindings	  = 8;		    { different keyboard bindings }
  nkeys 	  = 5;		    { number of keys }
  keydrop	  = 1;		    { index for the keys }
  keyleft	  = 2;
  keyright	  = 3;
  keyrotateleft   = 4;
  keyrotateright  = 5;

  norients	  = 3;		    { different orientations }

  ncolors	  = 14; 	    { different colors }
  nstyles	  = 3;		    { different styles }
  nstyletabs	  = 7;		    { different style tables }

  palettesiz	  = 16; 	    { EGA palette size }
  palettemap	  : array [0..palettesiz-1] of byte =
		    ( 0,  7, 63, 47, 49, 25, 27, 10,
		     50, 44, 37, 39, 36, 38, 55, 62);

  ngames	  = 256;	    { number of tournament games }

  rowmin	  = 0;		    { playing field coordinates in pixels }
  rowmax	  = 337;
  colmin	  = 250;
  colmax	  = 392;

  pixelsperblock  = 14; 	    { pixels per block }
  blockcols	  = 10; 	    { columns in blocks }
  maxdepth	  = 24; 	    { max rows in blocks }
  mindepth	  = 5;		    { min rows in blocks }

  initrow	  = 0;		    { initial row and column for mkshape }
  initcol	  = 5;

  left		  = -1; 	    { displacements for movement/rotation }
  right 	  = 1;

  maxheight	  = maxdepth-mindepth; { maximum initial height }
  maxlevel	  = 11; 	    { maximum level }

  filladd	  = 3;		    { constants for fill }
  fillbase	  = 3;

  dropdelay	  = 20; 	    { constants for title drop }
  dropinc	  = 5;

  clearlimit	  = 5;

  bonusempty	  = 500;	    { bonus for an empty pit }
  bonusrowclear   = 3;		    { bonus for clearing a row }
  bonusmultclear  = 2;		    { bonus for clearing multiple rows }
  bonusnext	  = 1;		    { bonus for not using show next shape }
  bonusguide	  = 2;		    { bonus fot not using show guide }
  bonusshadow	  = 1;		    { bonus for not using show shadow }
  bonushidden	  = 3;		    { bonus for using hidden blocks }

  info		  = 0;		    { information element in shape table }

  cleartone	  = 220;	    { row clear tone }
  cleartonedelay  = 10; 	    { row clear tone delay }

  nhiscores	  = 15; 	    { number of high scores }
  hiscorename	  = 'egaint.rec';   { high score file name }
  configname	  = 'egaint.rc';    { configuration file name }


 Type
  displaytype	  = (bw, color, mono, plasma);
  mesgcolors	  = (normal, high);
  bufstr	  = String [32];

  rinfotype	  = Array [1..clearlimit] Of byte;

  hiscorerec	  = Record
		     score	: longint;
		     level	: byte;
		     rowsclear	: word;
		     date	: String [8];
		     time	: String [8];
		     name	: bufstr;
		     version	: String [7]
		    End;


 Const
  shapetab	  : Array [1..nshapes, 0..shapesiz-1, 1..2] Of shortint =
      { bar }	    (((3, 2), ( 0, -1), ( 0,  1), ( 0,	2), ( 0,  0)),
      { tee }	     ((3, 2), ( 0, -1), ( 1,  0), ( 0,	1), ( 0,  0)),
      { box }	     ((3, 3), ( 1,  0), ( 0,  1), ( 1,	1), ( 0,  0)),
      { zig }	     ((3, 3), ( 0, -1), ( 1,  0), ( 1,	1), ( 0,  0)),
      { zag }	     ((3, 3), ( 1, -1), ( 1,  0), ( 0,	1), ( 0,  0)),
      { ell }	     ((3, 3), ( 1, -1), ( 0, -1), ( 0,	1), ( 0,  0)),
      { lel }	     ((3, 3), ( 0, -1), ( 0,  1), ( 1,	1), ( 0,  0)),
   { easy }	     ((0, 0), ( 0,  0), ( 0,  0), ( 0,	0), ( 0,  0)),
		     ((1, 0), ( 0,  1), ( 0,  0), ( 0,	0), ( 0,  0)),
		     ((1, 1), ( 1,  1), ( 0,  0), ( 0,	0), ( 0,  0)),
		     ((2, 1), ( 1,  0), ( 0,  1), ( 0,	0), ( 0,  0)),
		     ((2, 1), ( 0, -1), ( 0,  1), ( 0,	0), ( 0,  0)),
      { 13 }	     ((4, 3), ( 0, -2), ( 0, -1), ( 0,	1), ( 0,  2)),
   { medium }	     ((2, 3), ( 1, -1), ( 1,  1), ( 0,	0), ( 0,  0)),
		     ((2, 4), ( 1, -1), ( 0,  1), ( 0,	0), ( 0,  0)),
		     ((2, 4), ( 0, -1), ( 1,  1), ( 0,	0), ( 0,  0)),
		     ((4, 4), ( 1, -1), ( 0, -1), ( 0,	1), ( 1,  1)),
		     ((4, 4), (-1, -1), (-1,  0), ( 1,	0), (-1,  1)),
      { 19 }	     ((4, 5), ( 0, -1), (-1,  0), ( 1,	0), ( 0,  1)),
   { hard }	     ((4, 5), ( 1, -1), ( 0, -1), (-1,	0), (-1,  1)),
		     ((4, 6), ( 1, -1), ( 0, -1), ( 0,	1), (-1,  1)),
		     ((4, 6), (-1, -1), ( 0, -1), ( 0,	1), ( 1,  1)),
		     ((4, 6), ( 2,  0), ( 1,  0), ( 0,	1), ( 0,  2)),
		     ((3, 7), (-1, -1), ( 1,  0), (-1,	1), ( 0,  0)),
		     ((3, 7), ( 1, -1), ( 2,  0), ( 1,	1), ( 0,  0)),
      { 26 }	     ((4, 7), (-1, -1), ( 1, -1), (-1,	1), ( 1,  1)));

  shapecolortab   : Array [displaytype, 1..ncolors] Of byte =
   { bw }	    ((7, 15, 7, 15, 7, 15, 7, 15,  7, 15,  7, 15,  7, 15),
   { color }	     (2,  3, 4,  5, 6,	7, 8,  9, 10, 11, 12, 13, 14, 15),
   { mono }	     (1,  1, 1,  1, 1,	1, 1,  1,  1,  1,  1,  1,  1,  1),
   { plasma }	     (1,  4, 7,  1, 4,	7, 1,  4,  7,  1,  4,  7,  1,  4));
		   { (1,  7, 1,  7, 1,	7, 1,  7,  1,  7,  1,  7,  1,  7)); }

  mesgcolortab	  : Array [displaytype, mesgcolors] Of byte =
   { bw }	    ((7, 15),
   { color }	     (1,  2),
   { mono }	     (1,  1),
   { plasma }	     (4,  7));

  filltab	  : Array [1..nstyles] Of FillPatternType =
		    (($aa, $55, $aa, $55, $aa, $55, $aa, $55),
		     ($99, $cc, $66, $33, $99, $cc, $66, $33),
		     ($99, $33, $66, $cc, $99, $33, $66, $cc));

  timedelaytab	  : Array [1..maxlevel] Of byte =
		    (10, 9, 8, 7, 6, 5, 4, 3, 2, 1, 0);

  advancetab	  : Array [1..maxlevel] Of word =
		    (10, 20, 30, 40, 50, 60, 70, 80, 90, 200, 65535);

  xshapetitles	  : Array [1..xshapelevels] Of String [7] =
		    ('Classic',
		     'Easy',
		     'Medium',
		     'Hard');

  styleblocktitles: Array [1..nstyletabs] Of String[20] =
		    ('New',
		     'Classic',
		     'Pumped Full of Drugs',
		     'Barbed Wire Kisses',
		     'Arpeggiator',
		     'Elephant Stone',
		     'Really P.F.D.');

  keynames	  : array [1..nkeybindings, 1..nkeys] of string[2] =
		    (('Sp', 'J', 'L', 'I', 'K'),
		     ('Sp', 'J', 'L', 'K', 'I'),
		     ('Sp', 'H', 'L', 'J', 'K'),
		     ('Sp', 'S', 'F', 'E', 'D'),
		     ('Sp', 'S', 'F', 'D', 'E'),
		     ('Sp', 'A', 'F', 'S', 'D'),
		     ('0',  '4', '6', '8', '5'),
		     ('Sp', 'J', 'L', 'I', 'K'));

  keybindingtab   : array [1..nkeybindings, 1..nkeys] of byte =
    { classic }     ((57, 36, 38, 23, 37),  { sp,   j,	l,  i,	k }
    { russian }      (57, 36, 38, 37, 23),  { sp,   j,	l,  k,	i }
    { berkeley }     (57, 35, 38, 36, 37),  { sp,   h,	l,  j,	k }
    { left-handed }  (57, 31, 33, 18, 32),  { sp,   s,	f,  e,	d }
    { finnish }      (57, 31, 33, 32, 18),  { sp,   s,	f,  d,	e }
    { sf }	     (57, 30, 33, 31, 32),  { sp,   a,	f,  s,	d }
    { arrow }	     (82, 75, 77, 72, 76),  { ins, lf, rt, up,	5 }
    { user-defined } (00, 00, 00, 00, 00));

  keybindingtitles: array [1..nkeybindings] of string[13] =
		    ('Classic',
		     'Russian',
		     'Berkeley',
		     'Left-handed',
		     'Finnish',
		     'San Francisco',
		     'Arrow',
		     'User-defined');

 Var
  shapecolors	  : Array [1..ncolors] Of byte;
  field 	  : Array [0..maxdepth+1, 1..blockcols] Of boolean;
{ fieldshadows	  : Array [1..blockcols] Of boolean; }
  hiscore	  : Array [1..nhiscores] Of hiscorerec;
  styletab	  : Array [1..ncolors, 1..nstyles] Of pointer;
  xstyletabs	  : Array [1..nstyletabs, 1..ncolors, 1..nstyles] Of pointer;
  xshapetab	  : Array [1..nshapes, 0..norients, 1..shapesiz-1, 1..2] Of
		    shortint;
  yshapetab	  : Array [1..nshapes, 0..norients, 1..shapesiz-1, 1..2] Of
		    shortint;
  keybinding	  : array [1..nkeys] of byte;

  buf, buf2, buf3 : String[255];
  colorhigh	  : byte;
  colornormal	  : byte;
  curtain	  : Array [boolean] Of pointer;
  emptyrow	  : pointer;
  fconfig	  : Text;
  fhiscore	  : File of hiscorerec;
  filler	  : pointer;
  graphdriver	  : integer;
  graphmode	  : integer;
  savemode	  : word;
  savenumlock	  : byte;
  scrollptr	  : pointer;
{ shadows	  : pointer; }

  bonus 	  : byte;
  rowsclear	  : word;
  score 	  : longint;
  shapemap	  : byte;
  userpalette	  : palettetype;
  level 	  : byte;

 Const
  endrun	  : boolean	= False;
  page		  : integer	= 0;

  display	  : displaytype = color;
  height	  : byte    = 0;
  initlevel	  : byte    = 5;
  depth 	  : byte    = maxdepth;
  shownext	  : boolean = True;
  showguide	  : boolean = false;
  showshadow	  : boolean = False;
  styleblocks	  : byte    = 0;
  title 	  : boolean = True;
  tones 	  : boolean = True;
  tournament	  : boolean = False;
  tournamentgame  : byte    = 0;
  xshape	  : byte    = 1;
  binding	  : byte    = 1;


 Function gettimer : longint;
  Inline($28/$e4/		    { sub ah,ah }
	 $cd/$1a/		    { int 1ah	}
	 $89/$d0/		    { mov ax,dx }
	 $89/$ca);		    { mov dx,cx }

 procedure numlock(flag : boolean);
  begin
   if flag then
    begin
     savenumlock := mem[$0000:$0417];
     mem[$0000:$0417] := mem[$0000:$0417] or $20
    end
   else
    if savenumlock and $20 = 0 then
     mem[$0000:$0417] := mem[$0000:$0417] and $df
  end;

(*
   if flag then
    inline($1e/ 		    { push ds	      ; save caller's ds }
	   $31/$c0/		    { xor  ax,ax      ; zero ax }
	   $8e/$d8/		    { mov  ds,ax      ; load ds }
	   $a0/$17/$04/ 	    { mov  al,[0417]  ; get keyboard flags }
	   $0c/$20/		    { or   al,20      ; turn on num lock }
	   $a2/$17/$04/ 	    { mov  [0417],al  ; save keyboard flags }
	   $1f) 		    { pop  ds	      ; restore caller's ds }
   else
    inline($1e/ 		    { push ds	      ; save caller's ds }
	   $31/$c0/		    { xor  ax,ax      ; zero ax }
	   $8e/$d8/		    { mov  ds,ax      ; load ds }
	   $a0/$17/$04/ 	    { mov  al,[0417]  ; get keyboard flags }
	   $24/$df/		    { and  al,df      ; turn off num lock }
	   $a2/$17/$04/ 	    { mov  [0417],al  ; save keyboard flags }
	   $1f) 		    { pop  ds	      ; restore caller's ds }
  end; *)

 function getkey : word;
  inline($30/$e4/		    { xor  ah,ah }
	 $cd/$16);		    { int  16 }


 Procedure dographics;
  Begin
   savemode := LastMode;
   DetectGraph(GraphDriver, GraphMode);
   Case GraphDriver Of
    EGAMono:  Begin
	       initgraph(graphdriver, graphmode, '');
	       setgraphmode(egamonohi);
	       display := mono;
	      end;
    EGA:      Begin
	       InitGraph(GraphDriver, GraphMode, '');
	       SetGraphMode(EGAHi)
	      End;
    HercMono: Begin
	       initgraph(graphdriver, graphmode, '');
	       setgraphmode(HercMonoHi);
	       display := mono;
	      End;
    VGA:      Begin
	       InitGraph(GraphDriver, GraphMode, '');
	       SetGraphMode(VGAMed)
	      End;
    Else
     Begin
      WriteLn(id,
 ' requires either an EGA with 256k RAM, VGA, or Hercules graphics adapter.');
      Halt(0)
     End
   End;
   setactivepage(0);
   cleardevice;
   setactivepage(1);
   cleardevice;
  End;


 Procedure dotext;
  Begin
   CloseGraph;
   TextMode(savemode)
  End;


 Procedure fillzero(Var s : bufstr);

  Var
   i		  : integer;

  Begin
   For i := 1 To Length(s) Do
    If s[i] = #32 Then
     s[i] := '0'
  End;


 Procedure placewindow(x1, y1, x2, y2 : integer);
  Begin
   Rectangle(x1, y1, x2, y2);
   Bar(x2+1, y1+8, x2+3, y2);
   Bar(x1+8, y2+1, x2+3, y2+2)
  End;


 Procedure putshape(x, y : integer;
		    s	 : byte;
		    p	 : pointer);

  Var
   i		  : integer;
   xs		  : byte;

  Begin
   xs := shapetab[s, info, 1];
   PutImage(x, y, p^, XORPut);
   For i := 1 To xs Do
    PutImage(x+xshapetab[s, 0, i, 2], y+xshapetab[s, 0, i, 1], p^, XORPut)
  End;


 Procedure init;

  Var
   i, j, isiz	  : integer;
   x, y 	  : integer;

  Procedure abortgraphics;
   Begin
    WriteLn(GraphErrorMsg(GraphResult));
    Halt(0)
   End; {-abortgraphics-}

  Begin {-init-}
   numlock(true);
   Randomize;

   userpalette.colors[0] := -1;

   Assign(fconfig, configname);
   FileMode := 0;			{ read-only }
   Reset(fconfig);
   If IOResult = 0 Then
    Begin
     While Not Eof(fconfig) Do
      Begin
       ReadLn(fconfig, buf3);
       If buf3[1] <> '#' Then
	Begin
	 i := Pos('=', buf3);
	 buf2 := Copy(buf3, 1, i-1);
	 buf := Copy(buf3, i+1, Length(buf3)-i);
       { WriteLn(buf2);
	 WriteLn(buf);
	 ReadLn; }
	 If buf2 = 'display' Then
	  Case buf[1] Of
	   'B', 'b': display := bw;
	   'C', 'c': display := color;
	   'M', 'm': display := mono;
	   'P', 'p': display := plasma
	  End;
	 if buf2 = 'depth' then
	  begin
	   val (buf, i, j);
	   if (j = 0) and (i in [mindepth..maxdepth]) then
	    depth := i;
	  end;
	 If buf2 = 'height' Then
	  Begin
	   Val(buf, i, j);
	   If (j = 0) And (i In [0..2*maxheight]) Then
	    height := i
	  End;
	 If buf2 = 'level' Then
	  Begin
	   Val(buf, i, j);
	   If (j = 0) And (i In [1..maxlevel]) Then
	    initlevel := i
	  End;
	 If buf2 = 'shownext' Then
	  Case buf[1] Of
	   'Y', 'y': shownext := True;
	   'N', 'n': shownext := False
	  End;
	 If buf2 = 'showguide' Then
	  Case buf[1] Of
	   'Y', 'y': showguide := True;
	   'N', 'n': showguide := False
	  End;