home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / games / egaint.zip / DISKMANT / EGAINT / EG9305.PAS < prev    next >
Pascal/Delphi Source File  |  1989-07-13  |  58KB  |  1,928 lines
  1. (*
  2.  * Copyright (C) 1989 Eric Ng
  3.  *
  4.  * Egaint is free software; you can redistribute it and/or modify it
  5.  * under the terms of the GNU General Public License, Version 1, as
  6.  * published by the Free Software Foundation.
  7.  *
  8.  * This program is distributed in the hope that it will be useful, but
  9.  * without any warranty whatsoever, without even the implied warranties
  10.  * of merchantability or fitness for a particular purpose.  See the
  11.  * enclosed GNU General Public License for more details.
  12.  *
  13.  * You should have received a copy of the GNU General Public License
  14.  * along with egaint; see the file COPYING.  If not, write to:
  15.  *
  16.  *       Free Software Foundation, Inc.
  17.  *       675 Massachusetts Avenue
  18.  *       Cambridge, Massachusetts 02139
  19.  *
  20.  *)
  21.  
  22. (*
  23.  * The complete egaint 0.93.05 package can be obtained at either of
  24.  * the following bulletin board systems:
  25.  *
  26.  *       Tom and Sue McDermet's The Odyssey
  27.  *       A carrier of the SmartNet network
  28.  *       Morris Plains, New Jersey
  29.  *       (201) 984-6574
  30.  *
  31.  *       John Looker's Bandersnatch
  32.  *       Phoenix Net #807/7
  33.  *       Basking Ridge, New Jersey
  34.  *       (201) 766-3801
  35.  *
  36.  * In addition, bug reports, modifications, and other assorted
  37.  * queries can be directed, via Internet e-mail, to
  38.  *
  39.  *       erc@{mars,irss,inis}.njit.edu
  40.  *
  41.  * Please note that since I will be returning to college in the
  42.  * fall, future versions of egaint may not be posted on the above
  43.  * bulletin board systems.  The e-mail address, however, should
  44.  * remain valid.
  45.  *
  46.  *)
  47.  
  48. (*
  49.  * Egaint 0.93.05 was originally written in Turbo Pascal 4.0;
  50.  * however, I have just received my upgrade copy of Turbo Pascal 5.5.
  51.  * This new version of the compiler, so far, has not exhibited
  52.  * any problems and compiled without change.  What this means,
  53.  * through interpolation, is that it should (but is not guaranteed to)
  54.  * compile with Turbo Pascal 5.0 (but I can't verify this).
  55.  *
  56.  *)
  57.  
  58. {$B-}
  59. {$D-}
  60. {$I-}
  61. {$L-}
  62. {$R-}
  63. {$S-}
  64. {$V-}
  65.  
  66. Program egaint;
  67.  
  68.  Uses
  69.   Crt, Dos, Driver, Fonts, Graph;
  70.  
  71.  
  72.  Const
  73.   id              : String [6]  = 'egaint';
  74.   version         : String [7]  = '0.93.05';
  75.   copyright       : String [27] = 'Copyright (C) 1989 Eric Ng';
  76.   copr            : String [22] = 'Copr (C) 1989 Eric Ng';
  77.  
  78.   nshapes         = 26;             { different shapes }
  79.   shapesiz        = 4;              { max size of each shape (minus one) }
  80.   xshapelevels    = 4;              { levels (classic, easy, medium, hard) }
  81.   xshapeclassic   = 7;              { different classic shapes }
  82.   xshapeeasy      = 13;             { different easy extended shapes }
  83.   xshapemedium    = 19;
  84.   xshapehard      = 26;             { different hard extended shapes }
  85.  
  86.   norients        = 3;              { different orientations }
  87.  
  88.   ncolors         = 7;              { different colors }
  89.   nstyles         = 4;              { different styles }
  90.   nstyletabs      = 4;              { different style tables }
  91.  
  92.   ngames          = 256;            { number of tournament games }
  93.  
  94.   rowmin          = 0;              { playing field coordinates in pixels }
  95.   rowmax          = 337;
  96.   colmin          = 250;
  97.   colmax          = 392;
  98.  
  99.   pixelsperblock  = 14;             { pixels per block }
  100.   blockrows       = 24;             { rows in blocks }
  101.   xblockrows      = 25;             { rows in blocks (plus one) }
  102.   blockcols       = 10;             { columns in blocks }
  103.  
  104.   initrow         = 0;              { initial row and column for mkshape }
  105.   initcol         = 5;
  106.  
  107.   left            = -1;             { displacements for movement/rotation }
  108.   right           = 1;
  109.  
  110.   maxlevel        = 10;             { maximum level }
  111.   rowsperlevel    = 10;             { rows needed for level advancement }
  112.  
  113.   maxheight       = 12;             { maximum initial height }
  114.   filladd         = 3;              { constants for fill }
  115.   fillbase        = 3;
  116.  
  117.   dropdelay       = 20;             { constants for title drop }
  118.   dropinc         = 5;
  119.  
  120.   clearlimit      = 5;
  121.  
  122.   bonusrowclear   = 3;              { bonus for clearing a row }
  123.   bonusmultclear  = 2;              { bonus for clearing multiple rows }
  124.   bonusnext       = 1;              { bonus for not using show next shape }
  125.   bonusshadow     = 1;              { bonus for not using show shadow }
  126.   bonushidden     = 3;              { bonus for using hidden blocks }
  127.  
  128.   info            = 0;              { information element in shape table }
  129.  
  130.   nhiscores       = 15;             { number of high scores }
  131.   hiscorename     = 'egaint.rec';   { high score file name }
  132.   configname      = 'egaint.rc';    { configuration file name }
  133.  
  134.  
  135.  Type
  136.   displaytype     = (color, mono, plasma);
  137.   mesgcolors      = (normal, high);
  138.   bufstr          = String [32];
  139.  
  140.   rinfotype       = Array [1..clearlimit] Of byte;
  141.  
  142.   hiscorerec      = Record
  143.                      score      : longint;
  144.                      level      : byte;
  145.                      rowsclear  : word;
  146.                      date       : String [8];
  147.                      time       : String [8];
  148.                      name       : bufstr;
  149.                      version    : String [7]
  150.                     End;
  151.  
  152.  
  153.  Const
  154.   shapetab        : Array [1..nshapes, 0..shapesiz, 1..2] Of shortint =
  155.       { bar }       (((3, 2), ( 0, -1), ( 0,  1), ( 0,  2), ( 0,  0)),
  156.       { tee }        ((3, 2), ( 0, -1), ( 1,  0), ( 0,  1), ( 0,  0)),
  157.       { box }        ((3, 3), ( 1,  0), ( 0,  1), ( 1,  1), ( 0,  0)),
  158.       { zig }        ((3, 3), ( 0, -1), ( 1,  0), ( 1,  1), ( 0,  0)),
  159.       { zag }        ((3, 3), ( 1, -1), ( 1,  0), ( 0,  1), ( 0,  0)),
  160.       { ell }        ((3, 3), ( 1, -1), ( 0, -1), ( 0,  1), ( 0,  0)),
  161.       { lel }        ((3, 3), ( 0, -1), ( 0,  1), ( 1,  1), ( 0,  0)),
  162.    { easy }          ((0, 0), ( 0,  0), ( 0,  0), ( 0,  0), ( 0,  0)),
  163.                      ((1, 0), ( 0,  1), ( 0,  0), ( 0,  0), ( 0,  0)),
  164.                      ((1, 1), ( 1,  1), ( 0,  0), ( 0,  0), ( 0,  0)),
  165.                      ((2, 1), ( 1,  0), ( 0,  1), ( 0,  0), ( 0,  0)),
  166.                      ((2, 1), ( 0, -1), ( 0,  1), ( 0,  0), ( 0,  0)),
  167.       { 13 }         ((4, 3), ( 0, -2), ( 0, -1), ( 0,  1), ( 0,  2)),
  168.    { medium }        ((2, 3), ( 1, -1), ( 1,  1), ( 0,  0), ( 0,  0)),
  169.                      ((2, 4), ( 1, -1), ( 0,  1), ( 0,  0), ( 0,  0)),
  170.                      ((2, 4), ( 0, -1), ( 1,  1), ( 0,  0), ( 0,  0)),
  171.                      ((4, 4), ( 1, -1), ( 0, -1), ( 0,  1), ( 1,  1)),
  172.                      ((4, 4), (-1, -1), (-1,  0), ( 1,  0), (-1,  1)),
  173.       { 19 }         ((4, 5), ( 0, -1), (-1,  0), ( 1,  0), ( 0,  1)),
  174.    { hard }          ((4, 5), ( 1, -1), ( 0, -1), (-1,  0), (-1,  1)),
  175.                      ((4, 6), ( 1, -1), ( 0, -1), ( 0,  1), (-1,  1)),
  176.                      ((4, 6), (-1, -1), ( 0, -1), ( 0,  1), ( 1,  1)),
  177.                      ((4, 6), ( 2,  0), ( 1,  0), ( 0,  1), ( 0,  2)),
  178.                      ((3, 7), (-1, -1), ( 1,  0), (-1,  1), ( 0,  0)),
  179.                      ((3, 7), ( 1, -1), ( 2,  0), ( 1,  1), ( 0,  0)),
  180.       { 26 }         ((4, 7), (-1, -1), ( 1, -1), (-1,  1), ( 1,  1)));
  181.  
  182.   shapecolortab   : Array [displaytype, 1..ncolors] Of byte =
  183.    { color }        ((LightBlue, LightGreen, LightCyan, LightRed,
  184.                       LightMagenta, Yellow, White),
  185.    { mono }          (White, LightGray, White, LightGray, White, LightGray,
  186.                       White),
  187.    { plasma }        (LightGray, Red, Blue, LightGray, Red, Blue, LightGray));
  188.  
  189.   mesgcolortab    : Array [displaytype, mesgcolors] Of byte =
  190.    { color }        ((LightGray, White),
  191.    { mono }          (LightGray, White),
  192.    { plasma }        (White, LightGray));
  193.  
  194.   filltab         : Array [1..nstyles] Of FillPatternType =
  195.                     (($ff, $ff, $ff, $ff, $ff, $ff, $ff, $ff),
  196.                      ($aa, $55, $aa, $55, $aa, $55, $aa, $55),
  197.                      ($99, $cc, $66, $33, $99, $cc, $66, $33),
  198.                      ($99, $33, $66, $cc, $99, $33, $66, $cc));
  199.  
  200.   timedelaytab    : Array [1..maxlevel] Of byte =
  201.                     (10, 9, 8, 7, 6, 5, 4, 3, 2, 1);
  202.  
  203.   xshapetitles    : Array [1..xshapelevels] Of String [7] =
  204.                     ('Classic',
  205.                      'Easy',
  206.                      'Medium',
  207.                      'Hard');
  208.  
  209.   styleblocktitles: Array [1..nstyletabs] Of String[20] =
  210.                     ('New',
  211.                      'Classic',
  212.                      'Pumped Full of Drugs',
  213.                      'Really P.F.D.');
  214.  
  215.  Var
  216.   shapecolors     : Array [1..ncolors] Of byte;
  217.   field           : Array [0..xblockrows, 1..blockcols] Of boolean;
  218. { fieldshadows    : Array [1..blockcols] Of boolean; }
  219.   hiscore         : Array [1..nhiscores] Of hiscorerec;
  220.   styletab        : Array [1..ncolors, 1..nstyles] Of pointer;
  221.   xstyletabs      : Array [1..nstyletabs, 1..ncolors, 1..nstyles] Of pointer;
  222.   xshapetab       : Array [1..nshapes, 0..norients, 1..shapesiz, 1..2] Of
  223.                     shortint;
  224.   yshapetab       : Array [1..nshapes, 0..norients, 1..shapesiz, 1..2] Of
  225.                     shortint;
  226.  
  227.   reg             : Registers;      { 8086 registers record }
  228.  
  229.   buf, buf2, buf3 : bufstr;
  230.   colorhigh       : byte;
  231.   colornormal     : byte;
  232.   curtain         : Array [boolean] Of pointer;
  233.   emptyrow        : pointer;
  234.   fconfig         : Text;
  235.   fhiscore        : File of hiscorerec;
  236.   filler          : pointer;
  237.   graphdriver     : integer;
  238.   graphmode       : integer;
  239.   savemode        : word;
  240. { shadows         : pointer; }
  241.  
  242.   bonus           : byte;
  243.   rowsclear       : word;
  244.   score           : longint;
  245.   shapemap        : byte;
  246.  
  247.  Const
  248.   endrun          : boolean     = False;
  249.   page            : integer     = 0;
  250.   xpage           : byte        = 1;
  251.  
  252.   display         : displaytype = color;
  253.   height          : byte    = 0;
  254.   level           : byte    = 5;
  255.   shownext        : boolean = True;
  256.   showshadow      : boolean = False;
  257.   styleblocks     : byte    = 0;
  258.   tournament      : boolean = False;
  259.   tournamentgame  : byte    = 0;
  260.   xshape          : byte    = 0;
  261.  
  262.  
  263.  Function gettimer : longint;
  264.   Inline($28/$e4/                   { sub ah,ah }
  265.          $cd/$1a/                   { int 1ah   }
  266.          $89/$d0/                   { mov ax,dx }
  267.          $89/$ca);                  { mov dx,cx }
  268.  
  269.  
  270.  Procedure dographics;
  271.   Begin
  272.    savemode := LastMode;
  273.    DetectGraph(GraphDriver, GraphMode);
  274.    Case GraphDriver Of
  275.     EGA: Begin
  276.           InitGraph(GraphDriver, GraphMode, '');
  277.           SetGraphMode(EGAHi)
  278.          End;
  279.     VGA: Begin
  280.           InitGraph(GraphDriver, GraphMode, '');
  281.           SetGraphMode(VGAMed)
  282.          End;
  283.     Else
  284.      Begin
  285.       WriteLn('Sorry, but ', id,
  286.               'requires either an EGA card with 256K or a VGA card.');
  287.       Halt(0)
  288.      End
  289.    End
  290.   End;
  291.  
  292.  
  293.  Procedure dotext;
  294.   Begin
  295.    CloseGraph;
  296.    TextMode(savemode)
  297.   End;
  298.  
  299.  
  300.  Procedure fillzero(Var s : bufstr);
  301.  
  302.   Var
  303.    i              : integer;
  304.  
  305.   Begin
  306.    For i := 1 To Length(s) Do
  307.     If s[i] = #32 Then
  308.      s[i] := '0'
  309.   End;
  310.  
  311.  
  312.  Procedure placewindow(x1, y1, x2, y2 : integer);
  313.   Begin
  314.    Rectangle(x1, y1, x2, y2);
  315.    Bar(x2+1, y1+8, x2+3, y2);
  316.    Bar(x1+8, y2+1, x2+3, y2+2)
  317.   End;
  318.  
  319.  
  320.  Procedure putshape(x, y : integer;
  321.                     s    : byte;
  322.                     p    : pointer);
  323.  
  324.   Var
  325.    i              : integer;
  326.    xs             : byte;
  327.  
  328.   Begin
  329.    xs := shapetab[s, info, 1];
  330.    PutImage(x, y, p^, XORPut);
  331.    For i := 1 To xs Do
  332.     PutImage(x+xshapetab[s, 0, i, 2], y+xshapetab[s, 0, i, 1], p^, XORPut)
  333.   End;
  334.  
  335.  
  336.  Procedure init;
  337.  
  338.   Var
  339.    i, j, isiz     : integer;
  340.  
  341.   Procedure abortgraphics;
  342.    Begin
  343.     WriteLn(GraphErrorMsg(GraphResult));
  344.     Halt(0)
  345.    End; {-abortgraphics-}
  346.  
  347.   Begin {-init-}
  348.    Randomize;
  349.  
  350.    Assign(fconfig, configname);
  351.    Reset(fconfig);
  352.    If IOResult = 0 Then
  353.     While Not Eof(fconfig) Do
  354.      Begin
  355.       ReadLn(fconfig, buf3);
  356.       If buf3[1] <> '#' Then
  357.        Begin
  358.         i := Pos('=', buf3);
  359.         buf2 := Copy(buf3, 1, i-1);
  360.         buf := Copy(buf3, i+1, Length(buf3)-i);
  361.       { WriteLn(buf2);
  362.         WriteLn(buf);
  363.         ReadLn; }
  364.         If buf2 = 'display' Then
  365.          Case buf[1] Of
  366.           'C', 'c': display := color;
  367.           'M', 'm': display := mono;
  368.           'P', 'p': display := plasma
  369.          End;
  370.         If buf2 = 'height' Then
  371.          Begin
  372.           Val(buf, i, j);
  373.           If (j = 0) And (i In [0..2*maxheight]) Then
  374.            height := i
  375.          End;
  376.         If buf2 = 'level' Then
  377.          Begin
  378.           Val(buf, i, j);
  379.           If (j = 0) And (i In [1..maxlevel]) Then
  380.            level := i
  381.          End;
  382.         If buf2 = 'shownext' Then
  383.          Case buf[1] Of
  384.           'Y', 'y': shownext := True;
  385.           'N', 'n': shownext := False
  386.          End;
  387.         If buf2 = 'showshadow' Then
  388.          Case buf[1] Of
  389.           'Y', 'y': showshadow := False;
  390.           'N', 'n': showshadow := False
  391.          End;
  392.         If buf2 = 'tournament' Then
  393.          Case buf[1] Of
  394.           'Y', 'y': tournament := True;
  395.           'N', 'n': tournament := False
  396.          End;
  397.         If buf2 = 'tournamentgame' Then
  398.          Begin
  399.           Val(buf, i, j);
  400.           If (j = 0) And (i In [0..ngames-1]) Then
  401.            tournamentgame := i
  402.          End;
  403.         If buf2 = 'xshape' Then
  404.          Case buf[1] Of
  405.           'C', 'c': xshape := 0;
  406.           'E', 'e': xshape := 1;
  407.           'M', 'm': xshape := 2;
  408.           'H', 'h': xshape := 3
  409.          End;
  410.         If buf2 = 'styleblocks' Then
  411.          Case buf[1] Of
  412.           'N', 'n': styleblocks := 1;
  413.           'C', 'c': styleblocks := 2;
  414.           'P', 'p': styleblocks := 3;
  415.           'R', 'r': styleblocks := 4
  416.          End
  417.        End
  418.      End;
  419.    Close(fconfig);
  420.  
  421.    If ParamCount > 0 Then
  422.     Begin
  423.      buf := Copy(ParamStr(1), 1, 1);
  424.      Case buf[1] Of
  425.       'C', 'c': display := color;
  426.       'M', 'm': display := mono;
  427.       'P', 'p': display := plasma
  428.      End
  429.     End;
  430.  
  431.    If RegisterBGIdriver(@EGAVGADriver) < 0 Then
  432.     abortgraphics;
  433.  
  434.    If RegisterBGIfont(@SansSerifFontProc) < 0 Then
  435.     abortgraphics;
  436.    If RegisterBGIfont(@SmallFontProc) < 0 Then
  437.     abortgraphics;
  438.  
  439.    For i := 1 To nshapes Do
  440.     For j := 1 To shapesiz Do
  441.      Begin
  442.       xshapetab[i, 0, j, 1] :=  pixelsperblock*shapetab[i, j, 1];
  443.       yshapetab[i, 0, j, 1] :=  shapetab[i, j, 1];
  444.       xshapetab[i, 0, j, 2] :=  pixelsperblock*shapetab[i, j, 2];
  445.       yshapetab[i, 0, j, 2] :=  shapetab[i, j, 2];
  446.       xshapetab[i, 1, j, 1] :=  pixelsperblock*shapetab[i, j, 2];
  447.       yshapetab[i, 1, j, 1] :=  shapetab[i, j, 2];
  448.       xshapetab[i, 1, j, 2] := -pixelsperblock*shapetab[i, j, 1];
  449.       yshapetab[i, 1, j, 2] := -shapetab[i, j, 1];
  450.       xshapetab[i, 2, j, 1] := -pixelsperblock*shapetab[i, j, 1];
  451.       yshapetab[i, 2, j, 1] := -shapetab[i, j, 1];
  452.       xshapetab[i, 2, j, 2] := -pixelsperblock*shapetab[i, j, 2];
  453.       yshapetab[i, 2, j, 2] := -shapetab[i, j, 2];
  454.       xshapetab[i, 3, j, 1] := -pixelsperblock*shapetab[i, j, 2];
  455.       yshapetab[i, 3, j, 1] := -shapetab[i, j, 2];
  456.       xshapetab[i, 3, j, 2] :=  pixelsperblock*shapetab[i, j, 1];
  457.       yshapetab[i, 3, j, 2] :=  shapetab[i, j, 1]
  458.      End;
  459.  
  460.    For i := 1 To ncolors Do
  461.     shapecolors[i] := shapecolortab[display, i];
  462.  
  463.    colornormal := mesgcolortab[display, normal];
  464.    colorhigh   := mesgcolortab[display, high];
  465.  
  466.    FillChar(hiscore, SizeOf(hiscore), 0);
  467.    Assign(fhiscore, hiscorename);
  468.    Reset(fhiscore);
  469.    i := 1;
  470.    If IOResult = 0 Then
  471.     Begin
  472.      While (i <= nhiscores) And (Not Eof(fhiscore)) Do
  473.       Begin
  474.        Read(fhiscore, hiscore[i]);
  475.        Inc(i)
  476.       End;
  477.      Close(fhiscore)
  478.     End;
  479.  
  480.    dographics;
  481.    SetVisualPage(page);
  482.    page := 1-page;
  483.    SetActivePage(page);
  484.  
  485.    isiz := ImageSize(colmin+1, rowmin, colmax-1, rowmin+pixelsperblock);
  486.    GetMem(emptyrow, isiz);
  487.    GetImage(colmin+1, rowmin, colmax-1, rowmin+pixelsperblock, emptyrow^);
  488.  
  489.  { isiz := ImageSize(0, 0, pixelsperblock, pixelsperblock);
  490.    SetColor(colorhigh);
  491.    SetFillPattern(filltab[2], colornormal);
  492.    Bar(0, 0, pixelsperblock, pixelsperblock Shr 1);
  493.    GetMem(shadows, isiz);
  494.    GetImage(0, 0, pixelsperblock, pixelsperblock Shr 1, shadows^);
  495.    PutImage(0, 0, shadows^, XORPut); }
  496.  
  497.    isiz := ImageSize(0, 0, pixelsperblock, pixelsperblock);
  498.    SetColor(colornormal);
  499.    SetFillPattern(filltab[1], colornormal);
  500.    Bar(1, 1, pixelsperblock-1, pixelsperblock-1);
  501.    SetColor(Black);
  502.    Rectangle(3, 3, pixelsperblock-3, pixelsperblock-3);
  503.    Line(1, 1, 3, 3);
  504.    Line(1, pixelsperblock-1, 3, pixelsperblock-3);
  505.    Line(pixelsperblock-1, 1, pixelsperblock-3, 3);
  506.    Line(pixelsperblock-1, pixelsperblock-1, pixelsperblock-3,
  507.         pixelsperblock-3);
  508.    For i := 1 To ncolors Do
  509.     For j := 1 To nstyles Do
  510.      Begin
  511.       SetFillPattern(filltab[j], shapecolors[i]);
  512.       Bar(4, 4, pixelsperblock-4, pixelsperblock-4);
  513.       GetMem(xstyletabs[1, i, j], isiz);
  514.       GetImage(0, 0, pixelsperblock, pixelsperblock, xstyletabs[1, i, j]^)
  515.      End;
  516.    For i := 1 To ncolors Do
  517.     For j := 1 To nstyles Do
  518.      Begin
  519.       SetFillPattern(filltab[Random(nstyles)+1],
  520.                      shapecolors[Random(ncolors)+1]);
  521.       Bar(4, 4, 7, 7);
  522.       SetFillPattern(filltab[Random(nstyles)+1],
  523.                      shapecolors[Random(ncolors)+1]);
  524.       Bar(7, 4, 10, 7);
  525.       SetFillPattern(filltab[Random(nstyles)+1],
  526.                      shapecolors[Random(ncolors)+1]);
  527.       Bar(4, 7, 7, 10);
  528.       SetFillPattern(filltab[Random(nstyles)+1],
  529.                      shapecolors[Random(ncolors)+1]);
  530.       Bar(7, 7, 10, 10);
  531.       GetMem(xstyletabs[3, i, j], isiz);
  532.       GetImage(0, 0, pixelsperblock, pixelsperblock, xstyletabs[3, i, j]^)
  533.      End;
  534.  
  535.    SetFillPattern(filltab[2], colornormal);
  536.    Bar(4, 4, pixelsperblock-4, pixelsperblock-4);
  537.    GetMem(filler, isiz);
  538.    GetImage(0, 0, pixelsperblock, pixelsperblock, filler^);
  539.    PutImage(0, 0, filler^, XORPut);
  540.  
  541.    For i := 1 To ncolors Do
  542.     Begin
  543.      SetColor(shapecolors[i]);
  544.      For j := 1 To nstyles Do
  545.       Begin
  546.        SetFillPattern(filltab[j], shapecolors[i]);
  547.        Rectangle(1, 1, pixelsperblock-1, pixelsperblock-1);
  548.        Bar(3, 3, pixelsperblock-3, pixelsperblock-3);
  549.        GetMem(xstyletabs[2, i, j], isiz);
  550.        GetImage(0, 0, pixelsperblock, pixelsperblock, xstyletabs[2, i, j]^)
  551.       End
  552.     End;
  553.  
  554.    SetColor(colornormal);
  555.    SetFillPattern(filltab[3], colornormal);
  556.    Bar(1, 1, pixelsperblock-1, pixelsperblock-1);
  557.    GetMem(curtain[true], isiz);
  558.    GetImage(0, 0, pixelsperblock, pixelsperblock, curtain[true]^);
  559.  
  560.    SetFillPattern(filltab[4], colornormal);
  561.    Bar(1, 1, pixelsperblock-1, pixelsperblock-1);
  562.    GetMem(curtain[false], isiz);
  563.    GetImage(0, 0, pixelsperblock, pixelsperblock, curtain[false]^);
  564.    PutImage(0, 0, curtain[false]^, XORPut);
  565.  
  566.    For i := 1 To ncolors Do
  567.     For j := 1 To nstyles Do
  568.      xstyletabs[4, i, j] := xstyletabs[Random(nstyletabs-1)+1,
  569.                                        Random(ncolors)+1,
  570.                                        Random(nstyles)+1]
  571.   End; {-init-}
  572.  
  573.  
  574.  Procedure drawtitle;
  575.  
  576.   Const
  577.    titlesiz       = 95;
  578.    titletab       : Array [1..titlesiz, 1..2] Of integer =
  579.                     (( 75,  57), ( 75,  71), ( 75, 85), ( 75, 99),
  580.                       ( 75, 113), ( 75, 127), ( 75, 141),
  581.                      ( 89,  57), ( 89, 99), ( 89, 141),
  582.                      (103,  57), (103, 99), (103, 141),
  583.                      (117,  57), (117, 99), (117, 141),
  584.                      (131,  57), (131, 141),
  585.  
  586.                      (159,  71), (159, 85), (159, 99), (159, 113),
  587.                       (159, 127),
  588.                      (173,  57), (173, 141),
  589.                      (187,  57), (187, 141),
  590.                      (201,  57), (201, 99), (201, 141),
  591.                      (215,  71), (215, 99), (215, 113), (215, 127),
  592.  
  593.                      (243,  71), (243, 85), (243, 99), (243, 113),
  594.                       (243, 127), (243, 141),
  595.                      (257,  57), (257, 99),
  596.                      (271,  57), (271, 99),
  597.                      (285,  57), (285, 99),
  598.                      (299,  71), (299, 85), (299, 99), (299, 113),
  599.                       (299, 127), (299, 141),
  600.  
  601.                      (327,  57), (327, 141),
  602.                      (341,  57), (341, 141),
  603.                      (355,  57), (355,  71), (355, 85), (355, 99),
  604.                       (355, 113), (355, 127), (355, 141),
  605.                      (369,  57), (369, 141),
  606.                      (383,  57), (383, 141),
  607.  
  608.                      (411,  57), (411,  71), (411, 85), (411, 99),
  609.                       (411, 113), (411, 127), (411, 141),
  610.                      (425,  71),
  611.                      (439, 85),
  612.                      (453, 99),
  613.                      (467,  57), (467,  71), (467, 85), (467, 99),
  614.                       (467, 113), (467, 127), (467, 141),
  615.  
  616.                      (495,  57),
  617.                      (509,  57),
  618.                      (523,  57), (523,  71), (523, 85), (523, 99),
  619.                       (523, 113), (523, 127), (523, 141),
  620.                      (537,  57),
  621.                      (551,  57));
  622.  
  623.   Var
  624.    test           : Array [1..titlesiz] Of boolean;
  625.    ch             : char;
  626.    i, j, c, s     : integer;
  627.    x, y1, y2      : integer;
  628.    p              : pointer;
  629.  
  630.   Begin {-drawtitle-}
  631.    FillChar(test, SizeOf(test), 0);
  632.  
  633.    If styleblocks = 0 Then
  634.     styleblocks := Random(nstyletabs-1)+1;
  635.    s := 1;
  636.  
  637.    For i := 1 To titlesiz Do
  638.     Begin
  639.      Repeat
  640.       j := Random(titlesiz)+1
  641.      Until Not test[j];
  642.      c := Random(ncolors)+1;
  643.      If styleblocks = 3 Then
  644.       s := Random(nstyles)+1;
  645.      x := titletab[j, 1];
  646.      If KeyPressed Then
  647.       y1 := titletab[j, 2]
  648.      Else
  649.       Begin
  650.        y1 := 0;
  651.        y2 := dropinc
  652.       End;
  653.      p := xstyletabs[styleblocks, c, s];
  654.      PutImage(x, y1, p^, XORPut);
  655.      SetVisualPage(page);
  656.      page := 1-page;
  657.      SetActivePage(page);
  658.  
  659.      While (Not KeyPressed) And (y2 < titletab[j, 2]) Do
  660.       Begin
  661.        PutImage(x, y2, p^, XORPut);
  662.        Delay(dropdelay);
  663.        SetVisualPage(page);
  664.        page := 1-page;
  665.        SetActivePage(page);
  666.        PutImage(x, y1, p^, XORPut);
  667.        y1 := y2;
  668.        Inc(y2, dropinc)
  669.       End;
  670.  
  671.      PutImage(x, titletab[j, 2], p^, XORPut);
  672.      SetVisualPage(page);
  673.      page := 1-page;
  674.      SetActivePage(page);
  675.  
  676.      PutImage(x, y1, p^, XORPut);
  677.      PutImage(x, titletab[j, 2], p^, XORPut);
  678.      test[j] := True
  679.     End;
  680.    While KeyPressed Do
  681.     ch := ReadKey;
  682.  
  683.    SetTextJustify(CenterText, TopText);
  684.    SetColor(colorhigh);
  685.    SetTextStyle(SansSerifFont, HorizDir, 4);
  686.    OutTextXY(320, 10, 'Welcome to version '+version+' of');
  687.    OutTextXY(320, 165, copyright);
  688.  
  689.    SetTextStyle(SmallFont, HorizDir, 4);
  690.    OutTextXY(320, 215,
  691. 'This program is free software; you can redistribute it under the terms of '+
  692. 'the GNU General Public License,');
  693.    OutTextXY(320, 227,
  694. 'Version 1, as published by the Free Software Foundation.  This program is '+
  695. 'distributed in the hope that it');
  696.    OutTextXY(320, 239,
  697. 'will be useful, but without any warranty whatsoever, without even the '+
  698. 'implied warranties of merchantability or');
  699.    OutTextXY(320, 251,
  700. 'fitness for a particular purpose.  See the enclosed GNU General Public '+
  701. 'License for more details, or write to:');
  702.    OutTextXY(320, 263,
  703. 'Free Software Foundation, Inc., 675 Massachusetts Avenue, Cambridge, '+
  704. 'Massachusetts 02139');
  705.    OutTextXY(160, 329, 'Internet:  erc@{mars,irss,inis}.njit.edu');
  706.  
  707.    SetColor(colornormal);
  708.    OutTextXY(160, 281, 'To obtain the complete source code for this');
  709.    OutTextXY(160, 293, 'particular version, call either T. McDermet''s');
  710.    OutTextXY(160, 305, 'The Odyssey at 201/984-6574 or J. Looker''s');
  711.    OutTextXY(160, 317, 'Bandersnatch at 201/766-3801');
  712.  
  713.    OutTextXY(480, 281, 'This program requires an IBM PC-AT compatible');
  714.    OutTextXY(480, 293, '(286s or 386s are strongly recommended) with an');
  715.    OutTextXY(480, 305, 'IBM EGA with 256K RAM or equivalent.  VGA cards');
  716.    OutTextXY(480, 317, 'have been rumored to work, but this has not been');
  717.    OutTextXY(480, 329, 'tested (or witnessed) by the author.');
  718.  
  719.    SetVisualPage(page);
  720.    page := 1-page;
  721.    SetActivePage(page);
  722.    ClearDevice;
  723.  
  724.    Repeat Until KeyPressed;
  725.    Repeat
  726.     ch := ReadKey
  727.    Until Not KeyPressed
  728.   End; {-drawtitle-}
  729.  
  730.  
  731.  Procedure initgame;
  732.  
  733.   Var
  734.    i, j           : integer;
  735.  
  736.   Procedure getoptions;
  737.  
  738.    Const
  739.     noptions      = 8;
  740.  
  741.     optiontitles  : Array [1..noptions] Of String [22] =
  742.                     ('Tournament Game',
  743.                      'Tournament Game Number',
  744.                      'Initial Level',
  745.                      'Initial Height',
  746.                      'Show Next',
  747.                      'Show Shadow',
  748.                      'Extended Shapes',
  749.                      'Block Style');
  750.  
  751.     optionytab    : Array [1..noptions] Of integer =
  752.                     (86, 114, 142, 170, 198, 226, 254, 282);
  753.  
  754.    Var
  755.     done          : boolean;
  756.     o             : byte;
  757.     ch            : char;
  758.  
  759.    Procedure drawoptions;
  760.  
  761.     Var
  762.      i            : integer;
  763.  
  764.     Begin {-drawoptions-}
  765.      SetTextJustify(CenterText, TopText);
  766.      SetColor(colorhigh);
  767.      SetTextStyle(SansSerifFont, HorizDir, 4);
  768.      OutTextXY(320, 5, id+' '+version);
  769.  
  770.      SetColor(colornormal);
  771.      SetTextStyle(DefaultFont, HorizDir, 1);
  772.      OutTextXY(320, 40, 'Options');
  773.      OutTextXY(320, 330,
  774.       'Press J for up, K to rotate, L for left, and the Space Bar when done.');
  775.  
  776.      SetFillStyle(SolidFill, colornormal);
  777.      placewindow(150, 60, 490, 312);
  778.  
  779.      SetTextJustify(LeftText, TopText);
  780.      For i := 1 To noptions Do
  781.       OutTextXY(200, optionytab[i]+2, optiontitles[i])
  782.     End; {-drawoptions-}
  783.  
  784.    Procedure showflag(f : boolean;
  785.                       y : integer);
  786.     Begin
  787.      If f Then
  788.       OutTextXY(440, optionytab[y], 'Yes')
  789.      Else
  790.       OutTextXY(440, optionytab[y], 'No')
  791.     End; {-showflag-}
  792.  
  793.    Procedure showoption(o : byte);
  794.     Begin
  795.      Case o Of
  796.       1: showflag(tournament, 1);
  797.       2: Begin
  798.           Str(tournamentgame, buf);
  799.           OutTextXY(440, optionytab[2], buf)
  800.          End;
  801.       3: Begin
  802.           Str(level, buf);
  803.           OutTextXY(440, optionytab[3], buf)
  804.          End;
  805.       4: Begin
  806.           If height > maxheight Then
  807.            Begin
  808.             Str(height-maxheight, buf);
  809.             buf := 'Hidden '+buf
  810.            End
  811.           Else
  812.            Str(height, buf);
  813.           OutTextXY(440, optionytab[4], buf)
  814.          End;
  815.       5: showflag(shownext, 5);
  816.       6: showflag(showshadow, 6);
  817.       7: OutTextXY(440, optionytab[7], xshapetitles[xshape+1]);
  818.       8: OutTextXY(440, optionytab[8], styleblocktitles[styleblocks])
  819.      End
  820.     End; {-showoptions-}
  821.  
  822.    Procedure rotateopt(o : byte);
  823.     Begin
  824.      SetTextJustify(RightText, TopText);
  825.      SetTextStyle(SmallFont, HorizDir, 4);
  826.      SetColor(Black);
  827.      showoption(o);
  828.      Case o Of
  829.       1: tournament     := Not tournament;
  830.       2: tournamentgame := (tournamentgame+1) Mod ngames;
  831.       3: level          := (level Mod maxlevel)+1;
  832.       4: height         := (height+1) Mod ((maxheight Shl 1)+1);
  833.       5: shownext       := Not shownext;
  834.       6: showshadow     := False;
  835.       7: xshape         := (xshape+1) Mod xshapelevels;
  836.       8: styleblocks    := (styleblocks Mod nstyletabs)+1
  837.      End;
  838.      SetColor(colorhigh);
  839.      showoption(o)
  840.     End; {-rotateopt-}
  841.  
  842.    Begin {-getoptions-}
  843.     drawoptions;
  844.     SetTextJustify(RightText, TopText);
  845.     SetTextStyle(SmallFont, HorizDir, 4);
  846.     SetColor(colorhigh);
  847.     For o := 1 To noptions Do
  848.      showoption(o);
  849.     SetVisualPage(page);
  850.  
  851.     done := False;
  852.     o    := 1;
  853.     Repeat
  854.      SetTextJustify(LeftText, TopText);
  855.      SetTextStyle(DefaultFont, HorizDir, 1);
  856.      SetColor(colorhigh);
  857.      OutTextXY(200, optionytab[o]+2, optiontitles[o]);
  858.  
  859.      Repeat Until KeyPressed;
  860.      ch := ReadKey;
  861.      Case ch Of
  862.                      #27: Begin
  863.                            done   := True;
  864.                            endrun := True
  865.                           End;
  866.                      #32: done := True;
  867.                 'J', 'j': Begin
  868.                            SetColor(colornormal);
  869.                            OutTextXY(200, optionytab[o]+2, optiontitles[o]);
  870.                            If o < 2 Then
  871.                             o := noptions
  872.                            Else
  873.                             Dec(o)
  874.                           End;
  875.       'K', 'k', 'I', 'i': rotateopt(o);
  876.                 'L', 'l': Begin
  877.                            SetColor(colornormal);
  878.                            OutTextXY(200, optionytab[o]+2, optiontitles[o]);
  879.                            If o > noptions-1 Then
  880.                             o := 1
  881.                            Else
  882.                             Inc(o)
  883.                           End
  884.      End
  885.     Until done;
  886.  
  887.     page := 1-page;
  888.     SetActivePage(page);
  889.     ClearDevice;
  890.    End; {-getoptions-}
  891.  
  892.   Procedure fillfield(h : byte);
  893.  
  894.    Var
  895.     i, j          : integer;
  896.     k             : byte;
  897.  
  898.    Begin {-fillfield-}
  899.     For i := blockrows DownTo blockrows-(h-1) Do
  900.      Begin
  901.       k := Random(filladd)+fillbase;
  902.       For j := 1 To k Do
  903.        field[i, Random(blockcols)+1] := True
  904.      End
  905.    End; {-fillfield-}
  906.  
  907.   Begin {-initgame-}
  908.    getoptions;
  909.  
  910.    FillChar(field, SizeOf(field)-blockcols, 0);
  911.    FillChar(field[xblockrows, 1], blockcols, 1);
  912.  { FillChar(fieldshadows, SizeOf(fieldshadows), 0); }
  913.  
  914.    If tournament Then
  915.     RandSeed := tournamentgame;
  916.  
  917.    If height <> 0 Then
  918.     Begin
  919.      If height > maxheight Then
  920.       Begin
  921.        fillfield(height-maxheight);
  922.        bonus := (height-maxheight)+bonushidden
  923.       End
  924.      Else
  925.       Begin
  926.        fillfield(height);
  927.        bonus := height
  928.       End
  929.     End
  930.    Else
  931.     bonus := 0;
  932.    If Not shownext Then
  933.     Inc(bonus, bonusnext);
  934.    If Not showshadow Then
  935.     Inc(bonus, bonusshadow);
  936.  
  937.    rowsclear := 0;
  938.    score     := 0;
  939.  
  940.    Case xshape Of
  941.     0: shapemap := xshapeclassic;
  942.     1: shapemap := xshapeeasy;
  943.     2: shapemap := xshapemedium;
  944.     3: shapemap := xshapehard
  945.    End;
  946.  
  947.    Move(xstyletabs[styleblocks], styletab, SizeOf(styletab))
  948.   End; {-initgame-}
  949.  
  950.  Procedure drawscreen;
  951.  
  952.   Procedure drawfieldwin;
  953.  
  954.    Var
  955.     rowmaxpel      : integer;
  956.     colminpel      : integer;
  957.     colmaxpel      : integer;
  958.     i              : integer;
  959.  
  960.    Begin {-drawfieldwin-}
  961.     rowmaxpel := rowmax+pixelsperblock-2;
  962.     colminpel := colmin-pixelsperblock;
  963.     colmaxpel := colmax+pixelsperblock;
  964.  
  965.     SetColor(colornormal);
  966.     SetFillPattern(filltab[2], colornormal);
  967.     Bar(colminpel, rowmin, colmin, rowmaxpel);
  968.     Bar(colmin, rowmax, colmax, rowmaxpel);
  969.     Bar(colmax, rowmin, colmaxpel, rowmaxpel);
  970.     Line(colminpel, rowmin, colminpel, rowmaxpel);
  971.     Line(colmin, rowmin, colmin, rowmax);
  972.     Line(colmax, rowmin, colmax, rowmax);
  973.     Line(colmaxpel, rowmin, colmaxpel, rowmaxpel);
  974.     Line(colminpel, rowmin, colmin, rowmin);
  975.     Line(colmin, rowmax, colmax, rowmax);
  976.     Line(colmax, rowmin, colmaxpel, rowmin);
  977.     Line(colminpel, rowmaxpel, colmaxpel, rowmaxpel);
  978.    End; {-drawfieldwin-}
  979.  
  980.   Procedure drawnextwin;
  981.    Begin
  982.     SetColor(colornormal);
  983.     SetFillStyle(SolidFill, colornormal);
  984.     placewindow(35, 16, 201, 126);
  985.  
  986.     SetTextStyle(DefaultFont, HorizDir, 1);
  987.     OutTextXY(102, 114, 'Next')
  988.    End;
  989.  
  990.   Procedure drawscorewin;
  991.    Begin
  992.     SetColor(colornormal);
  993.     SetFillStyle(SolidFill, colornormal);
  994.     placewindow(439, 16, 605, 126);
  995.  
  996.     SetColor(colorhigh);
  997.     SetTextStyle(SansSerifFont, HorizDir, 4);
  998.     SetTextJustify(CenterText, TopText);
  999.     OutTextXY(522, 24, id);
  1000.  
  1001.     SetColor(colornormal);
  1002.     SetTextStyle(SmallFont, HorizDir, 4);
  1003.     OutTextXY(522, 60, copr);
  1004.  
  1005.     SetTextStyle(DefaultFont, HorizDir, 1);
  1006.     SetTextJustify(LeftText, TopText);
  1007.     OutTextXY(466, 74, 'Score:');
  1008.     OutTextXY(466, 86, 'Value:');
  1009.     OutTextXY(466, 98, 'Level:');
  1010.     OutTextXY(466, 110, ' Rows:');
  1011.    End; {-drawscorewin-}
  1012.  
  1013.   Procedure drawhelpwin;
  1014.    Begin
  1015.     SetColor(colornormal);
  1016.     SetFillStyle(SolidFill, colornormal);
  1017.     placewindow(35, 224, 201, 334);
  1018.     placewindow(439, 224, 605, 334);
  1019.  
  1020.     SetColor(colorhigh);
  1021.     SetTextStyle(DefaultFont, HorizDir, 1);
  1022.     OutTextXY(58, 245, 'J');
  1023.     OutTextXY(58, 257, 'I');
  1024.     OutTextXY(58, 269, 'K');
  1025.     OutTextXY(58, 281, 'L');
  1026.     OutTextXY(58, 293, 'Sp');
  1027.     OutTextXY(58, 305, 'Esc');
  1028.     OutTextXY(462, 245, 'B');
  1029.     OutTextXY(462, 257, 'N');
  1030.     OutTextXY(462, 269, 'S');
  1031.     OutTextXY(462, 281, 'V');
  1032.     OutTextXY(462, 293, 'X');
  1033.  
  1034.     SetColor(colornormal);
  1035.     SetTextStyle(SmallFont, HorizDir, 4);
  1036.     OutTextXY(90, 243, 'move left');
  1037.     OutTextXY(90, 255, 'rotate left');
  1038.     OutTextXY(90, 267, 'rotate right');
  1039.     OutTextXY(90, 279, 'move right');
  1040.     OutTextXY(90, 291, 'drop');
  1041.     OutTextXY(90, 303, 'pause/quit');
  1042.     OutTextXY(494, 243, 'block style');
  1043.     OutTextXY(494, 255, 'show next');
  1044.     OutTextXY(494, 267, 'show shadow');
  1045.     OutTextXY(494, 279, 'change level');
  1046.     OutTextXY(494, 291, 'extended shapes');
  1047.    End; {-drawhelpwin-}
  1048.  
  1049.   Procedure refill;
  1050.  
  1051.    Var
  1052.     i, j          : integer;
  1053.  
  1054.    Begin {-refill-}
  1055.     For i := blockrows DownTo blockrows-(height-1) Do
  1056.      For j := 1 To blockcols Do
  1057.       If field[i, j] Then
  1058.        PutImage(colmin+(pixelsperblock*(j-1))+1,
  1059.                 rowmin+(pixelsperblock*(i-1)), filler^, XORPut)
  1060.    End; {-refill-}
  1061.  
  1062.   Begin {-drawscreen-}
  1063.    ClearDevice;
  1064.    drawfieldwin;
  1065.    drawnextwin;
  1066.    drawscorewin;
  1067.    drawhelpwin;
  1068.    If height In [1..maxheight] Then
  1069.     refill;
  1070.  
  1071.    SetVisualPage(page);
  1072.    page := 1-page;
  1073.    SetActivePage(page);
  1074.  
  1075.    ClearDevice;
  1076.    drawfieldwin;
  1077.    drawnextwin;
  1078.    drawscorewin;
  1079.    drawhelpwin;
  1080.    If height In [1..maxheight] Then
  1081.     refill;
  1082.   End; {-drawscreen-}
  1083.  
  1084.  Procedure play;
  1085.  
  1086.   Var
  1087.    dropped        : boolean;
  1088.    endgame        : boolean;
  1089.    shape          : byte;
  1090.    orient         : byte;
  1091.    row, col       : byte;
  1092.    color          : byte;
  1093.    style          : byte;
  1094.    ch             : char;
  1095.    t, tdelay      : longint;
  1096.  
  1097.    nextshape      : byte;
  1098.    nextcolor      : byte;
  1099.    nextstyle      : byte;
  1100.  
  1101.    xsize          : byte;
  1102.    xvalue         : integer;
  1103.  
  1104.    oldscore       : longint;
  1105.    oldxvalue      : integer;
  1106.    oldlevel       : byte;
  1107.    oldxshape      : byte;
  1108.    oldrowsclear   : byte;
  1109.  
  1110.    i, j           : integer;
  1111.    r, c           : byte;
  1112.  
  1113.   Procedure scrolldown(rclr  : byte;
  1114.                        var r : rinfotype);
  1115.  
  1116.    Var
  1117.     rz            : Array [1..clearlimit] Of integer;
  1118.     i, j, s       : integer;
  1119.     p             : pointer;
  1120.  
  1121.    Begin {-scrolldown-}
  1122.     For i := 1 To rclr Do
  1123.      rz[i] := pixelsperblock*(r[i]-1);
  1124.  
  1125.     s := ImageSize(colmin+1, rowmin, colmax-1, rz[rclr]);
  1126.     GetMem(p, s);
  1127.  
  1128.     For i := 1 To rclr Do
  1129.      Begin
  1130.       GetImage(colmin+1, rowmin, colmax-1, rz[i], p^);
  1131.       PutImage(colmin+1, rowmin, emptyrow^, NormalPut);
  1132.       PutImage(colmin+1, rowmin+pixelsperblock, p^, NormalPut);
  1133.       SetVisualPage(page);
  1134.       page := 1-page;
  1135.       SetActivePage(page);
  1136.       PutImage(colmin+1, rowmin, emptyrow^, NormalPut);
  1137.       PutImage(colmin+1, rowmin+pixelsperblock, p^, NormalPut)
  1138.      End;
  1139.  
  1140.     FreeMem(p, s)
  1141.    End; {-scrolldown-}
  1142.  
  1143.   Procedure drawshape;
  1144.  
  1145.    Var
  1146.     i             : integer;
  1147.     x, y, x1, y1  : integer;
  1148.     p             : pointer;
  1149.  
  1150.    Begin {-drawshape-}
  1151.   { If showshadow Then
  1152.      FillChar(fieldshadows, SizeOf(fieldshadows), 0); }
  1153.     x := colmin+(pixelsperblock*(col-1))+1;
  1154.     y := rowmin+(pixelsperblock*(row-1));
  1155.     p := styletab[color, style];
  1156.  
  1157.     PutImage(x, y, p^, XORPut);
  1158.   { If showshadow Then
  1159.      Begin
  1160.       PutImage(x, rowmax+1, shadows^, XORPut);
  1161.       fieldshadows[col] := True
  1162.      End; }
  1163.     For i := 1 To xsize Do
  1164.      Begin
  1165.       x1 := x+xshapetab[shape, orient, i, 2];
  1166.       y1 := y+xshapetab[shape, orient, i, 1];
  1167.       If (y1 >= rowmin) Then
  1168.        PutImage(x1, y1, p^, XORPut);
  1169.     { If showshadow And Not fieldshadows[col+yshapetab[shape, orient, i, 2]]
  1170.       Then
  1171.        Begin
  1172.         PutImage(x1, rowmax+1, shadows^, XORPut);
  1173.         fieldshadows[col+yshapetab[shape, orient, i, 2]] := True
  1174.        End }
  1175.      End
  1176.    End; {-drawshape-}
  1177.  
  1178.   Procedure dispscore;
  1179.    Begin
  1180.     If oldscore <> score Then
  1181.      Begin
  1182.       SetColor(Black);
  1183.       Str(oldscore, buf);
  1184.       OutTextXY(522, 72, buf);
  1185.       SetColor(colorhigh);
  1186.       Str(score, buf);
  1187.       OutTextXY(522, 72, buf)
  1188.      End;
  1189.     If oldxvalue <> xvalue Then
  1190.      Begin
  1191.       SetColor(Black);
  1192.       Str(oldxvalue, buf);
  1193.       OutTextXY(522, 84, buf);
  1194.       SetColor(colorhigh);
  1195.       Str(xvalue, buf);
  1196.       OutTextXY(522, 84, buf)
  1197.      End;
  1198.     If (oldlevel <> level) Or (oldxshape <> xshape) Then
  1199.      Begin
  1200.       SetColor(Black);
  1201.       Str(oldlevel, buf);
  1202.       buf := buf+' '+xshapetitles[oldxshape+1];
  1203.       OutTextXY(522, 96, buf);
  1204.       SetColor(colorhigh);
  1205.       Str(level, buf);
  1206.       buf := buf+' '+xshapetitles[xshape+1];
  1207.       OutTextXY(522, 96, buf)
  1208.      End;
  1209.     If oldrowsclear <> rowsclear Then
  1210.      Begin
  1211.       SetColor(Black);
  1212.       Str(oldrowsclear, buf);
  1213.       OutTextXY(522, 108, buf);
  1214.       SetColor(colorhigh);
  1215.       Str(rowsclear, buf);
  1216.       OutTextXY(522, 108, buf)
  1217.      End
  1218.    End; {-dispscore-}
  1219.  
  1220.   Function chk : boolean;
  1221.  
  1222.    Var
  1223.     f             : boolean;
  1224.     x, y, r       : shortint;
  1225.     i             : integer;
  1226.  
  1227.    Begin {-chk-}
  1228.     r := row+1;
  1229.  
  1230.     f := field[r, col];
  1231.     For i := 1 To xsize Do
  1232.      Begin
  1233.       y := r+yshapetab[shape, orient, i, 1];
  1234.       x := col+yshapetab[shape, orient, i, 2];
  1235.       If ((y >= 1) And (y <= xblockrows)) And ((x >= 1) And (x <= blockcols))
  1236.       Then
  1237.        f := f Or field[y, x]
  1238.      End;
  1239.  
  1240.     chk := f
  1241.    End; {-chk-}
  1242.  
  1243.   Procedure chkmv(c : shortint);
  1244.  
  1245.    Var
  1246.     f1, f2        : boolean;
  1247.     x, y          : shortint;
  1248.     i             : integer;
  1249.     xcol          : shortint;
  1250.  
  1251.    Begin {-chkmv-}
  1252.     Inc(c, col);
  1253.  
  1254.     f1 := (c >= 1) And (c <= blockcols);
  1255.     If f1 Then
  1256.      f2 := field[row, c]
  1257.     Else
  1258.      f2 := True;
  1259.     For i := 1 To xsize Do
  1260.      Begin
  1261.       x  := c+yshapetab[shape, orient, i, 2];
  1262.       y  := row+yshapetab[shape, orient, i, 1];
  1263.       f1 := f1 And ((x >= 1) And (x <= blockcols));
  1264.       If f1 And ((y >= 1) And (y <= blockrows)) Then
  1265.        f2 := f2 Or field[y, x]
  1266.      End;
  1267.  
  1268.     If f1 And (Not f2) Then
  1269.      Begin
  1270.       xcol := col;
  1271.       col := c;
  1272.       drawshape;
  1273.       SetVisualPage(page);
  1274.       page := 1-page;
  1275.       SetActivePage(page);
  1276.       col := xcol;
  1277.       drawshape;
  1278.       col := c
  1279.      End
  1280.    End; {-chkmv-}
  1281.  
  1282.   Procedure chkrot(o : byte);
  1283.  
  1284.    Var
  1285.     f1, f2     : boolean;
  1286.     xorient    : byte;
  1287.     x, y       : shortint;
  1288.     i          : integer;
  1289.     f          : Text;
  1290.  
  1291.    Begin {-chkrot-}
  1292.     f1 := True;
  1293.     f2 := False;
  1294.  
  1295.     For i := 1 To xsize Do
  1296.      Begin
  1297.       y  := row+yshapetab[shape, o, i, 1];
  1298.       x  := col+yshapetab[shape, o, i, 2];
  1299.       f1 := f1 And ((x >= 1) And (x <= blockcols)) And
  1300.                    (y <= blockrows);
  1301.       If f1 And (y >= 1) Then
  1302.        f2 := f2 Or field[y, x]
  1303.      End;
  1304.  
  1305.     If f1 And (Not f2) Then
  1306.      Begin
  1307.       xorient := orient;
  1308.       orient := o;
  1309.       drawshape;
  1310.       SetVisualPage(page);
  1311.       page := 1-page;
  1312.       SetActivePage(page);
  1313.       orient := xorient;
  1314.       drawshape;
  1315.       orient := o
  1316.      End
  1317.    End; {-chkrot-}
  1318.  
  1319.   Procedure dropshape;
  1320.  
  1321.    Var
  1322.     oldrow, xrow  : byte;
  1323.  
  1324.    Begin {-dropshape-}
  1325.     oldrow := row;
  1326.  
  1327.     While Not chk Do
  1328.      Inc(row);
  1329.     drawshape;
  1330.     SetVisualPage(page);
  1331.     page := 1-page;
  1332.     SetActivePage(page);
  1333.     xrow := row;
  1334.     row := oldrow;
  1335.     drawshape;
  1336.     row := xrow;
  1337.  
  1338.     Inc(score, level*(row-oldrow)+bonus);
  1339.     dropped := True
  1340.    End; {-dropshape-}
  1341.  
  1342.   Procedure chkrows;
  1343.  
  1344.    Var
  1345.     rows       : byte;
  1346.     r          : byte;
  1347.     rinfo      : rinfotype;
  1348.  
  1349.    Function chkrow(r : byte) : boolean;
  1350.  
  1351.     Var
  1352.      f         : boolean;
  1353.      i, j      : integer;
  1354.  
  1355.     Begin {-chkrow-}
  1356.      f := False;
  1357.      If r < xblockrows Then
  1358.       Begin
  1359.        f := field[r, 1];
  1360.        i := 2;
  1361.        While f And (i <= blockcols) Do
  1362.         Begin
  1363.          f := f And field[r, i];
  1364.          Inc(i)
  1365.         End;
  1366.  
  1367.        If f Then
  1368.         Begin
  1369.          Inc(rowsclear);
  1370.          If (level < maxlevel) And (rowsclear = ((level+1)*rowsperlevel)) Then
  1371.           Begin
  1372.            Inc(level);
  1373.            tdelay := timedelaytab[level]
  1374.           End;
  1375.          Move(field[0, 1], field[1, 1], blockcols*r);
  1376.          Inc(score, level*bonusrowclear+bonus)
  1377.         End
  1378.       End;
  1379.      chkrow := f
  1380.     End; {-chkrow-}
  1381.  
  1382.    Begin {-chkrows-}
  1383.     rows := 0;
  1384.     For r := row-2 To row+2 Do
  1385.      If chkrow(r) Then
  1386.       Begin
  1387.        Inc(rows);
  1388.        rinfo[rows] := r
  1389.       End;
  1390.  
  1391.     If rows > 0 Then
  1392.      Begin
  1393.       scrolldown(rows, rinfo);
  1394.       If rows > 1 Then
  1395.        Inc(score, level*((rows-1)*bonusmultclear)+bonus)
  1396.      End
  1397.    End; {-chkrows-}
  1398.  
  1399.   Procedure gameover;
  1400.  
  1401.    Var
  1402.     i, x, y, p    : integer;
  1403.     f             : boolean;
  1404.  
  1405.    Begin {-gameover-}
  1406.     f := True;
  1407.     For y := 1 To blockrows Do
  1408.      For p := 1 To 2 Do
  1409.       Begin
  1410.        For x := 1 To blockcols Do
  1411.         Begin
  1412.          If Not field[y, x] Then
  1413.            PutImage(colmin+(pixelsperblock*(x-1))+1,
  1414.                    rowmin+(pixelsperblock*(y-1)),
  1415.                    curtain[f]^, NormalPut);
  1416.          f := Not f
  1417.         End;
  1418.        SetVisualPage(page);
  1419.        page := 1-page;
  1420.        SetActivePage(page);
  1421.        If Not KeyPressed Then
  1422.         Delay(dropdelay)
  1423.       End;
  1424.  
  1425.     PutImage(colmin+1, rowmin, emptyrow^, NormalPut);
  1426.     SetColor(colorhigh);
  1427.     SetTextStyle(DefaultFont, HorizDir, 1);
  1428.     SetTextJustify(CenterText, TopText);
  1429.     OutTextXY(320, rowmin+4, 'Game Over');
  1430.  
  1431.     i := 1;
  1432.     Repeat
  1433.      SetVisualPage(page);
  1434.      page := 1-page;
  1435.      SetActivePage(page);
  1436.      Delay(i*dropdelay);
  1437.      Inc(i)
  1438.     Until (i > 25) Or (Not Odd(i) And KeyPressed);
  1439.  
  1440.     While KeyPressed Do
  1441.      ch := ReadKey
  1442.    End; {-gameover-}
  1443.  
  1444.   Begin {-play-}
  1445.    endgame   := False;
  1446.    nextshape := Random(shapemap)+1;
  1447.    nextcolor := Random(ncolors)+1;
  1448.    nextstyle := Random(nstyles)+1;
  1449.    xvalue    := 0;
  1450.    tdelay    := timedelaytab[level];
  1451.  
  1452.    oldscore     := 255;
  1453.    oldlevel     := 255;
  1454.    oldxvalue    := 0;
  1455.    oldxshape    := 255;
  1456.    oldrowsclear := 255;
  1457.  
  1458.  { dispscore;
  1459.    SetVisualPage(page);
  1460.    page := 1-page;
  1461.    SetActivePage(page);
  1462.    dispscore;
  1463.    oldscore     := 0;
  1464.    oldlevel     := level;
  1465.    oldxvalue    := xvalue;
  1466.    oldxshape    := xshape;
  1467.    oldrowsclear := 0; }
  1468.  
  1469.    If shownext Then
  1470.     putshape(111, 54, nextshape, styletab[nextcolor, nextstyle]);
  1471.    SetVisualPage(page);
  1472.    page := 1-page;
  1473.    SetActivePage(page);
  1474.    If shownext Then
  1475.     putshape(111, 54, nextshape, styletab[nextcolor, nextstyle]);
  1476.  
  1477.    Repeat
  1478.     Inc(score, xvalue);
  1479.     shape   := nextshape;
  1480.     orient  := 0;
  1481.     row     := initrow;
  1482.     col     := initcol;
  1483.     color   := nextcolor;
  1484.     style   := nextstyle;
  1485.     dropped := False;
  1486.     xsize   := shapetab[shape, info, 1];
  1487.     xvalue  := level*shapetab[shape, info, 2]+bonus;
  1488.     nextshape := Random(shapemap)+1;
  1489.     nextcolor := Random(ncolors)+1;
  1490.     nextstyle := Random(nstyles)+1;
  1491.  
  1492.     drawshape;
  1493.     dispscore;
  1494.     If shownext Then
  1495.      Begin
  1496.       putshape(111, 54, shape, styletab[color, style]);
  1497.       putshape(111, 54, nextshape, styletab[nextcolor, nextstyle])
  1498.      End;
  1499.     SetVisualPage(page);
  1500.     page := 1-page;
  1501.     SetActivePage(page);
  1502.     dispscore;
  1503.     If shownext Then
  1504.      Begin
  1505.       putshape(111, 54, shape, styletab[color, style]);
  1506.       putshape(111, 54, nextshape, styletab[nextcolor, nextstyle])
  1507.      End;
  1508.     oldscore     := score;
  1509.     oldxvalue    := xvalue;
  1510.     oldlevel     := level;
  1511.     oldxshape    := xshape;
  1512.     oldrowsclear := rowsclear;
  1513.  
  1514.     t := gettimer+tdelay;
  1515.     Repeat Until (gettimer > t);
  1516.     While KeyPressed Do
  1517.      ch := ReadKey;
  1518.  
  1519.     If chk Then
  1520.      endgame := True
  1521.     Else
  1522.      Begin
  1523.       Repeat
  1524.        Inc(row);
  1525.        drawshape;
  1526.        SetVisualPage(page);
  1527.        page := 1-page;
  1528.        SetActivePage(page);
  1529.        Dec(row);
  1530.        drawshape;
  1531.        Inc(row);
  1532.  
  1533.        t := gettimer+tdelay;
  1534.        Repeat
  1535.         Repeat Until KeyPressed Or (gettimer > t);
  1536.         If KeyPressed Then
  1537.          Begin
  1538.           ch := ReadKey;
  1539.           Case ch Of
  1540.                 #27: Begin
  1541.                       Repeat Until KeyPressed;
  1542.                       ch := ReadKey;
  1543.                       If ch = #27 Then
  1544.                        Begin
  1545.                         dropshape;
  1546.                         endgame := True
  1547.                        End
  1548.                      End;
  1549.                 #32: dropshape;
  1550.            'B', 'b': Begin
  1551.                       i := styleblocks;
  1552.                       If shownext Then
  1553.                        putshape(111, 54, nextshape,
  1554.                                 styletab[nextcolor, nextstyle]);
  1555.                       styleblocks := (styleblocks Mod nstyletabs)+1;
  1556.                       Move(xstyletabs[styleblocks], styletab,
  1557.                            SizeOf(styletab));
  1558.                       drawshape;
  1559.                       If shownext Then
  1560.                        putshape(111, 54, nextshape,
  1561.                                 styletab[nextcolor, nextstyle]);
  1562.                       SetVisualPage(page);
  1563.                       page := 1-page;
  1564.                       SetActivePage(page);
  1565.                       Move(xstyletabs[i], styletab,
  1566.                            SizeOf(styletab));
  1567.                       drawshape;
  1568.                       If shownext Then
  1569.                        putshape(111, 54, nextshape,
  1570.                                 styletab[nextcolor, nextstyle]);
  1571.                       Move(xstyletabs[styleblocks], styletab,
  1572.                            SizeOf(styletab));
  1573.                       If shownext Then
  1574.                        putshape(111, 54, nextshape,
  1575.                                 styletab[nextcolor, nextstyle]);
  1576.                       While KeyPressed Do
  1577.                        ch := ReadKey
  1578.                      End;
  1579.            'I', 'i': chkrot((norients+orient) Mod (norients+1));
  1580.            'J', 'j': chkmv(left);
  1581.            'K', 'k': chkrot((orient+1) Mod (norients+1));
  1582.            'L', 'l': chkmv(right);
  1583.            'N', 'n': Begin
  1584.                       shownext := Not shownext;
  1585.                       If shownext Then
  1586.                        Dec(bonus, bonusnext)
  1587.                       Else
  1588.                        Inc(bonus, bonusnext);
  1589.                       putshape(111, 54, nextshape,
  1590.                                styletab[nextcolor, nextstyle]);
  1591.                       drawshape;
  1592.                       SetVisualPage(page);
  1593.                       page := 1-page;
  1594.                       SetActivePage(page);
  1595.                       putshape(111, 54, nextshape,
  1596.                                styletab[nextcolor, nextstyle]);
  1597.                       drawshape;
  1598.                       While KeyPressed Do
  1599.                        ch := ReadKey
  1600.                      End;
  1601.            'S', 's': Begin
  1602.                       showshadow := Not showshadow;
  1603.                       drawshape;
  1604.                       SetVisualPage(page);
  1605.                       page := 1-page;
  1606.                       SetActivePage(page);
  1607.                       showshadow := Not showshadow;
  1608.                       drawshape;
  1609.                       showshadow := Not showshadow;
  1610.                       If showshadow Then
  1611.                        Dec(bonus, bonusshadow)
  1612.                       Else
  1613.                        Inc(bonus, bonusshadow);
  1614.                       While KeyPressed Do
  1615.                        ch := ReadKey
  1616.                      End;
  1617.            'V', 'v': Begin
  1618.                       level := (level Mod maxlevel)+1;
  1619.                       tdelay := timedelaytab[level];
  1620.                       drawshape;
  1621.                       dispscore;
  1622.                       SetVisualPage(page);
  1623.                       page := 1-page;
  1624.                       SetActivePage(page);
  1625.                       drawshape;
  1626.                       dispscore;
  1627.                       oldlevel := level;
  1628.                       While KeyPressed Do
  1629.                        ch := ReadKey
  1630.                      End;
  1631.            'X', 'x': Begin
  1632.                       xshape := (xshape+1) Mod xshapelevels;
  1633.                       Case xshape Of
  1634.                        0: shapemap := xshapeclassic;
  1635.                        1: shapemap := xshapeeasy;
  1636.                        2: shapemap := xshapemedium;
  1637.                        3: shapemap := xshapehard
  1638.                       End;
  1639.                       drawshape;
  1640.                       dispscore;
  1641.                       SetVisualPage(page);
  1642.                       page := 1-page;
  1643.                       SetActivePage(page);
  1644.                       drawshape;
  1645.                       dispscore;
  1646.                       oldxshape := xshape;
  1647.                       While KeyPressed Do
  1648.                        ch := ReadKey
  1649.                      End
  1650.           End
  1651.          End
  1652.        Until dropped Or (gettimer > t);
  1653.       Until dropped Or chk;
  1654.  
  1655.       drawshape;
  1656.  
  1657.       field[row, col] := True;
  1658.       For i := 1 To xsize Do
  1659.        field[row+yshapetab[shape, orient, i, 1],
  1660.              col+yshapetab[shape, orient, i, 2]] := True;
  1661.  
  1662.       chkrows;
  1663.  
  1664.       t := gettimer+(tdelay Shr 1);
  1665.       Repeat Until (gettimer > t);
  1666.       While KeyPressed Do
  1667.        ch := ReadKey
  1668.      End;
  1669.    Until endgame;
  1670.  
  1671.    dispscore;
  1672.    SetVisualPage(page);
  1673.    page := 1-page;
  1674.    SetActivePage(page);
  1675.    dispscore;
  1676.    oldscore     := score;
  1677.    oldxvalue    := xvalue;
  1678.    oldlevel     := level;
  1679.    oldxshape    := xshape;
  1680.    oldrowsclear := rowsclear;
  1681.  
  1682.    While KeyPressed Do
  1683.     ch := ReadKey;
  1684.    gameover;
  1685.  
  1686.    Repeat Until KeyPressed;
  1687.    While KeyPressed Do
  1688.     ch := ReadKey
  1689.   End;
  1690.  
  1691.  Procedure postgame;
  1692.  
  1693.   Var
  1694.    ch             : char;
  1695.    today          : DateTime;
  1696.    i, j           : word;
  1697.    rank, x, s     : integer;
  1698.  
  1699.   Begin
  1700.    rank := 0;
  1701.  
  1702.    If rowsclear > 0 Then
  1703.     Begin
  1704.      i    := 1;
  1705.      While (i <= nhiscores) And (hiscore[i].score >= score) Do
  1706.       Inc(i);
  1707.      If i <= nhiscores Then
  1708.       Begin
  1709.        rank := i;
  1710.        For j := nhiscores-1 DownTo i Do
  1711.         hiscore[j+1] := hiscore[j];
  1712.        hiscore[i].score     := score;
  1713.        hiscore[i].level     := level;
  1714.        hiscore[i].rowsclear := rowsclear;
  1715.  
  1716.        GetTime(today.hour, today.min, today.sec, j);
  1717.        GetDate(today.year, today.month, today.day, j);
  1718.        Dec(today.year, 1900);
  1719.        Str(today.month:2, hiscore[i].date);
  1720.        Str(today.day:2, buf);
  1721.        hiscore[i].date := hiscore[i].date+'/'+buf;
  1722.        Str(today.year:2, buf);
  1723.        hiscore[i].date := hiscore[i].date+'/'+buf;
  1724.        fillzero(hiscore[i].date);
  1725.        Str(today.hour:2, hiscore[i].time);
  1726.        Str(today.min:2, buf);
  1727.        hiscore[i].time := hiscore[i].time+':'+buf;
  1728.        Str(today.sec:2, buf);
  1729.        hiscore[i].time := hiscore[i].time+':'+buf;
  1730.        fillzero(hiscore[i].time);
  1731.        hiscore[i].version := version;
  1732.  
  1733.        ClearDevice;
  1734.  
  1735.        SetTextJustify(CenterText, TopText);
  1736.        SetTextStyle(SansSerifFont, HorizDir, 4);
  1737.        SetColor(colorhigh);
  1738.        OutTextXY(320, 5, 'Congratulations!');
  1739.  
  1740.        SetTextStyle(DefaultFont, HorizDir, 1);
  1741.        SetColor(colornormal);
  1742.        OutTextXY(320, 45, 'You''ve made it into the Glorious Fifteen;');
  1743.        OutTextXY(320, 57, 'please enter your name for posterity:');
  1744.  
  1745.        SetColor(colornormal);
  1746.        placewindow(214, 155, 426, 195);
  1747.  
  1748.        SetVisualPage(page);
  1749.        page := 1-page;
  1750.  
  1751.        SetTextStyle(SmallFont, HorizDir, 4);
  1752.        x := 1;
  1753.        Repeat
  1754.         SetColor(colorhigh);
  1755.         OutTextXY(224+6*(x-1), 171, '_');
  1756.         Repeat Until KeyPressed;
  1757.         ch := ReadKey;
  1758.         Case ch Of
  1759.           #0: While KeyPressed Do
  1760.                ch := ReadKey;
  1761.           #8: If x > 1 Then
  1762.                Begin
  1763.                 SetColor(Black);
  1764.                 OutTextXY(224+6*(x-1), 171, '_');
  1765.                 Dec(x);
  1766.                 OutTextXY(224+6*(x-1), 171, hiscore[i].name[x])
  1767.                End;
  1768.          #13: hiscore[i].name[0] := Chr(x-1);
  1769.          #27: If x > 1 Then
  1770.                Begin
  1771.                 SetColor(Black);
  1772.                 OutTextXY(224+6*(x-1), 171, '_');
  1773.                 For s := x DownTo 1 Do
  1774.                  OutTextXY(224+6*(s-1), 171, hiscore[i].name[s]);
  1775.                 x := 1
  1776.                End;
  1777.          Else If x < SizeOf(bufstr) Then
  1778.                Begin
  1779.                 SetColor(Black);
  1780.                 OutTextXY(224+6*(x-1), 171, '_');
  1781.                 SetColor(colorhigh);
  1782.                 OutTextXY(224+6*(x-1), 171, ch);
  1783.                 hiscore[i].name[x] := ch;
  1784.                 Inc(x)
  1785.                End
  1786.         End
  1787.        Until (ch = #13) or (x > SizeOf(bufstr))
  1788.       End
  1789.     End;
  1790.  
  1791.    SetActivePage(page);
  1792.    ClearDevice;
  1793.  
  1794.    SetTextStyle(SansSerifFont, HorizDir, 4);
  1795.    SetTextJustify(CenterText, TopText);
  1796.    SetColor(colorhigh);
  1797.    OutTextXY(320, 5, 'The Glorious Fifteen');
  1798.  
  1799.    SetColor(colornormal);
  1800.    SetFillStyle(SolidFill, colornormal);
  1801.    placewindow(16, 50, 615, 256);
  1802.  
  1803.    SetTextStyle(DefaultFont, HorizDir, 1);
  1804.    SetTextJustify(LeftText, TopText);
  1805.    SetColor(colorhigh);
  1806.    OutTextXY(24, 60, 'Rank  Score  Level Rows   Date     Time   Name');
  1807.  
  1808.    SetColor(colornormal);
  1809.    SetTextStyle(SmallFont, HorizDir, 4);
  1810.    For i := 1 To nhiscores Do
  1811.     Begin
  1812.      If rank = i Then
  1813.       SetColor(colorhigh);
  1814.      SetTextJustify(CenterText, TopText);
  1815.      Str(i:2, buf);
  1816.      fillzero(buf);
  1817.      OutTextXY(40, 72+12*(i-1), buf);
  1818.      If hiscore[i].score <> 0 Then
  1819.       Begin
  1820.        Str(hiscore[i].score:7, buf);
  1821.        fillzero(buf);
  1822.        OutTextXY(92, 72+12*(i-1), buf);
  1823.        Str(hiscore[i].level:2, buf);
  1824.        fillzero(buf);
  1825.        OutTextXY(148, 72+12*(i-1), buf);
  1826.        Str(hiscore[i].rowsclear:2, buf);
  1827.        fillzero(buf);
  1828.        OutTextXY(192, 72+12*(i-1), buf);
  1829.        OutTextXY(248, 72+12*(i-1), hiscore[i].date);
  1830.        OutTextXY(320, 72+12*(i-1), hiscore[i].time);
  1831.        SetTextJustify(LeftText, TopText);
  1832.        OutTextXY(360, 72+12*(i-1), hiscore[i].name);
  1833.        OutTextXY(563, 72+12*(i-1), hiscore[i].version)
  1834.       End;
  1835.      If rank = i Then
  1836.       SetColor(colornormal)
  1837.     End;
  1838.  
  1839.    SetTextStyle(DefaultFont, HorizDir, 1);
  1840.    SetTextJustify(CenterText, TopText);
  1841.    SetColor(colornormal);
  1842.    OutTextXY(320, 300, 'Press Y to try again or N to exit.');
  1843.  
  1844.    SetVisualPage(page);
  1845.    page := 1-page;
  1846.    SetActivePage(page);
  1847.    ClearDevice;
  1848.  
  1849.    Repeat
  1850.     Repeat Until KeyPressed;
  1851.     ch := ReadKey;
  1852.    Until (ch In ['N', 'Y', 'n', 'y']);
  1853.  
  1854.    endrun := ch In ['N', 'n']
  1855.   End;
  1856.  
  1857. { 12345678901234567890123456789012345678901234567890123456789012345678901234
  1858.   rank  score  level rows   date     time   name'
  1859.    00  0000000   00  0000 00/00/00 00:00:00 12345678901234567890123456789012
  1860. }
  1861.  
  1862.  Procedure cleanup;
  1863.  
  1864.   Var
  1865.    i              : integer;
  1866.  
  1867.   Procedure configflag(f : boolean);
  1868.    Begin
  1869.     If f Then
  1870.      WriteLn(fconfig, 'Yes')
  1871.     Else
  1872.      WriteLn(fconfig, 'No')
  1873.    End; {-configflag-}
  1874.  
  1875.   Begin {-cleanup-}
  1876.    dotext;
  1877.  
  1878.    Assign(fhiscore, hiscorename);
  1879.    Rewrite(fhiscore);
  1880.  
  1881.    i := 1;
  1882.    While (i <= nhiscores) And (hiscore[i].score > 0) Do
  1883.     Begin
  1884.      Write(fhiscore, hiscore[i]);
  1885.      Inc(i)
  1886.     End;
  1887.    Close(fhiscore);
  1888.  
  1889.    Assign(fconfig, configname);
  1890.    Rewrite(fconfig);
  1891.    WriteLn(fconfig, '# ', id, '':1, version, ' configuration file');
  1892.    WriteLn(fconfig, '# ', copyright);
  1893.    Write(fconfig, 'display=');
  1894.    Case display Of
  1895.     color : WriteLn(fconfig, 'Color');
  1896.     mono  : WriteLn(fconfig, 'Mono');
  1897.     plasma: WriteLn(fconfig, 'Plasma')
  1898.    End;
  1899.    WriteLn(fconfig, 'height=', height);
  1900.    WriteLn(fconfig, 'level=', level);
  1901.    Write(fconfig, 'shownext=');
  1902.    configflag(shownext);
  1903.    Write(fconfig, 'showshadow=');
  1904.    configflag(showshadow);
  1905.    WriteLn(fconfig, 'styleblocks=', styleblocktitles[styleblocks]);
  1906.    Write(fconfig, 'tournament=');
  1907.    configflag(tournament);
  1908.    WriteLn(fconfig, 'tournamentgame=', tournamentgame);
  1909.    WriteLn(fconfig, 'xshape=', xshapetitles[xshape+1]);
  1910.    Close(fconfig)
  1911.   End; {-cleanup-}
  1912.  
  1913.  Begin
  1914.   init;
  1915.   drawtitle;
  1916.   Repeat
  1917.    initgame;
  1918.    If Not endrun Then
  1919.     Begin
  1920.      drawscreen;
  1921.      play;
  1922.      postgame
  1923.     End;
  1924.   Until endrun;
  1925.   cleanup
  1926.  End.
  1927.  
  1928.