home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / EG0519S.ZIP / EG9413.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-01-04  |  65.4 KB  |  2,458 lines
  1. (*
  2.  * Copyright 1989, 1990 Eric Ng
  3.  *
  4.  * This program is free software; you can redistribute it and/or modify
  5.  * it under the terms of the GNU General Public License as published by
  6.  * the Free Software Foundation; either version 1, or (at your option)
  7.  * any later version.
  8.  *
  9.  * This program is distributed in the hope that it will be useful, but
  10.  * without any warranty whatsoever, without even the implied warranties
  11.  * of merchantability or fitness for a particular purpose.  See the
  12.  * accompanying GNU General Public License for more details.
  13.  *
  14.  * You should have received a copy of the GNU General Public License
  15.  * along with this program; see the file COPYING.  If not, write to:
  16.  *
  17.  * Free Software Foundation, Inc.
  18.  * 675 Massachusetts Avenue
  19.  * Cambridge, Massachusetts 02139
  20.  *)
  21.  
  22. {$a-}
  23. {$b-}
  24. {$d-}
  25. {$e-}
  26. {$f-}
  27. {$i-}
  28. {$l-}
  29. {$n-}
  30. {$o-}
  31. {$r-}
  32. {$s-}
  33. {$v-}
  34.  
  35. Program egaint;
  36.  
  37.  Uses
  38.   Crt, Dos, Driver, Fonts, Graph;
  39.  
  40.  
  41.  Const
  42.   id          : String [6]    = 'egaint';
  43.   version      : String [7]    = '0.94.13';
  44.   copyright      : String [27] = 'Copyright 1989-90 Eric Ng';
  45.  
  46.   nshapes      = 26;         { different shapes }
  47.   shapesiz      = 5;            { max size of each shape }
  48.   xshapelevels      = 4;            { levels (classic, easy, medium, hard) }
  49.   xshapeclassic   = 7;            { different classic shapes }
  50.   xshapeeasy      = 13;         { different easy extended shapes }
  51.   xshapemedium      = 19;
  52.   xshapehard      = 26;         { different hard extended shapes }
  53.  
  54.   nkeybindings      = 8;            { different keyboard bindings }
  55.   nkeys       = 5;            { number of keys }
  56.   keydrop      = 1;            { index for the keys }
  57.   keyleft      = 2;
  58.   keyright      = 3;
  59.   keyrotateleft   = 4;
  60.   keyrotateright  = 5;
  61.  
  62.   norients      = 3;            { different orientations }
  63.  
  64.   ncolors      = 14;         { different colors }
  65.   nstyles      = 3;            { different styles }
  66.   nstyletabs      = 7;            { different style tables }
  67.  
  68.   palettesiz      = 16;         { EGA palette size }
  69.   palettemap      : array [0..palettesiz-1] of byte =
  70.             ( 0,  7, 63, 47, 49, 25, 27, 10,
  71.              50, 44, 37, 39, 36, 38, 55, 62);
  72.  
  73.   ngames      = 256;        { number of tournament games }
  74.  
  75.   rowmin      = 0;            { playing field coordinates in pixels }
  76.   rowmax      = 337;
  77.   colmin      = 250;
  78.   colmax      = 392;
  79.  
  80.   pixelsperblock  = 14;         { pixels per block }
  81.   blockcols      = 10;         { columns in blocks }
  82.   maxdepth      = 24;         { max rows in blocks }
  83.   mindepth      = 5;            { min rows in blocks }
  84.  
  85.   initrow      = 0;            { initial row and column for mkshape }
  86.   initcol      = 5;
  87.  
  88.   left          = -1;         { displacements for movement/rotation }
  89.   right       = 1;
  90.  
  91.   maxheight      = maxdepth-mindepth; { maximum initial height }
  92.   maxlevel      = 11;         { maximum level }
  93.  
  94.   filladd      = 3;            { constants for fill }
  95.   fillbase      = 3;
  96.  
  97.   dropdelay      = 20;         { constants for title drop }
  98.   dropinc      = 5;
  99.  
  100.   clearlimit      = 5;
  101.  
  102.   bonusempty      = 500;        { bonus for an empty pit }
  103.   bonusrowclear   = 3;            { bonus for clearing a row }
  104.   bonusmultclear  = 2;            { bonus for clearing multiple rows }
  105.   bonusnext      = 1;            { bonus for not using show next shape }
  106.   bonusguide      = 2;            { bonus fot not using show guide }
  107.   bonusshadow      = 1;            { bonus for not using show shadow }
  108.   bonushidden      = 3;            { bonus for using hidden blocks }
  109.  
  110.   info          = 0;            { information element in shape table }
  111.  
  112.   cleartone      = 220;        { row clear tone }
  113.   cleartonedelay  = 10;         { row clear tone delay }
  114.  
  115.   nhiscores      = 15;         { number of high scores }
  116.   hiscorename      = 'egaint.rec';   { high score file name }
  117.   configname      = 'egaint.rc';    { configuration file name }
  118.  
  119.  
  120.  Type
  121.   displaytype      = (bw, color, mono, plasma);
  122.   mesgcolors      = (normal, high);
  123.   bufstr      = String [32];
  124.  
  125.   rinfotype      = Array [1..clearlimit] Of byte;
  126.  
  127.   hiscorerec      = Record
  128.              score    : longint;
  129.              level    : byte;
  130.              rowsclear    : word;
  131.              date    : String [8];
  132.              time    : String [8];
  133.              name    : bufstr;
  134.              version    : String [7]
  135.             End;
  136.  
  137.  
  138.  Const
  139.   shapetab      : Array [1..nshapes, 0..shapesiz-1, 1..2] Of shortint =
  140.       { bar }        (((3, 2), ( 0, -1), ( 0,  1), ( 0,    2), ( 0,  0)),
  141.       { tee }         ((3, 2), ( 0, -1), ( 1,  0), ( 0,    1), ( 0,  0)),
  142.       { box }         ((3, 3), ( 1,  0), ( 0,  1), ( 1,    1), ( 0,  0)),
  143.       { zig }         ((3, 3), ( 0, -1), ( 1,  0), ( 1,    1), ( 0,  0)),
  144.       { zag }         ((3, 3), ( 1, -1), ( 1,  0), ( 0,    1), ( 0,  0)),
  145.       { ell }         ((3, 3), ( 1, -1), ( 0, -1), ( 0,    1), ( 0,  0)),
  146.       { lel }         ((3, 3), ( 0, -1), ( 0,  1), ( 1,    1), ( 0,  0)),
  147.    { easy }         ((0, 0), ( 0,  0), ( 0,  0), ( 0,    0), ( 0,  0)),
  148.              ((1, 0), ( 0,  1), ( 0,  0), ( 0,    0), ( 0,  0)),
  149.              ((1, 1), ( 1,  1), ( 0,  0), ( 0,    0), ( 0,  0)),
  150.              ((2, 1), ( 1,  0), ( 0,  1), ( 0,    0), ( 0,  0)),
  151.              ((2, 1), ( 0, -1), ( 0,  1), ( 0,    0), ( 0,  0)),
  152.       { 13 }         ((4, 3), ( 0, -2), ( 0, -1), ( 0,    1), ( 0,  2)),
  153.    { medium }         ((2, 3), ( 1, -1), ( 1,  1), ( 0,    0), ( 0,  0)),
  154.              ((2, 4), ( 1, -1), ( 0,  1), ( 0,    0), ( 0,  0)),
  155.              ((2, 4), ( 0, -1), ( 1,  1), ( 0,    0), ( 0,  0)),
  156.              ((4, 4), ( 1, -1), ( 0, -1), ( 0,    1), ( 1,  1)),
  157.              ((4, 4), (-1, -1), (-1,  0), ( 1,    0), (-1,  1)),
  158.       { 19 }         ((4, 5), ( 0, -1), (-1,  0), ( 1,    0), ( 0,  1)),
  159.    { hard }         ((4, 5), ( 1, -1), ( 0, -1), (-1,    0), (-1,  1)),
  160.              ((4, 6), ( 1, -1), ( 0, -1), ( 0,    1), (-1,  1)),
  161.              ((4, 6), (-1, -1), ( 0, -1), ( 0,    1), ( 1,  1)),
  162.              ((4, 6), ( 2,  0), ( 1,  0), ( 0,    1), ( 0,  2)),
  163.              ((3, 7), (-1, -1), ( 1,  0), (-1,    1), ( 0,  0)),
  164.              ((3, 7), ( 1, -1), ( 2,  0), ( 1,    1), ( 0,  0)),
  165.       { 26 }         ((4, 7), (-1, -1), ( 1, -1), (-1,    1), ( 1,  1)));
  166.  
  167.   shapecolortab   : Array [displaytype, 1..ncolors] Of byte =
  168.    { bw }        ((7, 15, 7, 15, 7, 15, 7, 15,  7, 15,  7, 15,  7, 15),
  169.    { color }         (2,  3, 4,  5, 6,    7, 8,  9, 10, 11, 12, 13, 14, 15),
  170.    { mono }         (1,  1, 1,  1, 1,    1, 1,  1,  1,  1,  1,  1,  1,  1),
  171.    { plasma }         (1,  4, 7,  1, 4,    7, 1,  4,  7,  1,  4,  7,  1,  4));
  172.            { (1,  7, 1,  7, 1,    7, 1,  7,  1,  7,  1,  7,  1,  7)); }
  173.  
  174.   mesgcolortab      : Array [displaytype, mesgcolors] Of byte =
  175.    { bw }        ((7, 15),
  176.    { color }         (1,  2),
  177.    { mono }         (1,  1),
  178.    { plasma }         (4,  7));
  179.  
  180.   filltab      : Array [1..nstyles] Of FillPatternType =
  181.             (($aa, $55, $aa, $55, $aa, $55, $aa, $55),
  182.              ($99, $cc, $66, $33, $99, $cc, $66, $33),
  183.              ($99, $33, $66, $cc, $99, $33, $66, $cc));
  184.  
  185.   timedelaytab      : Array [1..maxlevel] Of byte =
  186.             (10, 9, 8, 7, 6, 5, 4, 3, 2, 1, 0);
  187.  
  188.   advancetab      : Array [1..maxlevel] Of word =
  189.             (10, 20, 30, 40, 50, 60, 70, 80, 90, 200, 65535);
  190.  
  191.   xshapetitles      : Array [1..xshapelevels] Of String [7] =
  192.             ('Classic',
  193.              'Easy',
  194.              'Medium',
  195.              'Hard');
  196.  
  197.   styleblocktitles: Array [1..nstyletabs] Of String[20] =
  198.             ('New',
  199.              'Classic',
  200.              'Pumped Full of Drugs',
  201.              'Barbed Wire Kisses',
  202.              'Arpeggiator',
  203.              'Elephant Stone',
  204.              'Really P.F.D.');
  205.  
  206.   keynames      : array [1..nkeybindings, 1..nkeys] of string[2] =
  207.             (('Sp', 'J', 'L', 'I', 'K'),
  208.              ('Sp', 'J', 'L', 'K', 'I'),
  209.              ('Sp', 'H', 'L', 'J', 'K'),
  210.              ('Sp', 'S', 'F', 'E', 'D'),
  211.              ('Sp', 'S', 'F', 'D', 'E'),
  212.              ('Sp', 'A', 'F', 'S', 'D'),
  213.              ('0',  '4', '6', '8', '5'),
  214.              ('Sp', 'J', 'L', 'I', 'K'));
  215.  
  216.   keybindingtab   : array [1..nkeybindings, 1..nkeys] of byte =
  217.     { classic }     ((57, 36, 38, 23, 37),  { sp,   j,    l,  i,    k }
  218.     { russian }      (57, 36, 38, 37, 23),  { sp,   j,    l,  k,    i }
  219.     { berkeley }     (57, 35, 38, 36, 37),  { sp,   h,    l,  j,    k }
  220.     { left-handed }  (57, 31, 33, 18, 32),  { sp,   s,    f,  e,    d }
  221.     { finnish }      (57, 31, 33, 32, 18),  { sp,   s,    f,  d,    e }
  222.     { sf }         (57, 30, 33, 31, 32),  { sp,   a,    f,  s,    d }
  223.     { arrow }         (82, 75, 77, 72, 76),  { ins, lf, rt, up,    5 }
  224.     { user-defined } (00, 00, 00, 00, 00));
  225.  
  226.   keybindingtitles: array [1..nkeybindings] of string[13] =
  227.             ('Classic',
  228.              'Russian',
  229.              'Berkeley',
  230.              'Left-handed',
  231.              'Finnish',
  232.              'San Francisco',
  233.              'Arrow',
  234.              'User-defined');
  235.  
  236.  Var
  237.   shapecolors      : Array [1..ncolors] Of byte;
  238.   field       : Array [0..maxdepth+1, 1..blockcols] Of boolean;
  239. { fieldshadows      : Array [1..blockcols] Of boolean; }
  240.   hiscore      : Array [1..nhiscores] Of hiscorerec;
  241.   styletab      : Array [1..ncolors, 1..nstyles] Of pointer;
  242.   xstyletabs      : Array [1..nstyletabs, 1..ncolors, 1..nstyles] Of pointer;
  243.   xshapetab      : Array [1..nshapes, 0..norients, 1..shapesiz-1, 1..2] Of
  244.             shortint;
  245.   yshapetab      : Array [1..nshapes, 0..norients, 1..shapesiz-1, 1..2] Of
  246.             shortint;
  247.   keybinding      : array [1..nkeys] of byte;
  248.  
  249.   buf, buf2, buf3 : String[255];
  250.   colorhigh      : byte;
  251.   colornormal      : byte;
  252.   curtain      : Array [boolean] Of pointer;
  253.   emptyrow      : pointer;
  254.   fconfig      : Text;
  255.   fhiscore      : File of hiscorerec;
  256.   filler      : pointer;
  257.   graphdriver      : integer;
  258.   graphmode      : integer;
  259.   savemode      : word;
  260.   savenumlock      : byte;
  261.   scrollptr      : pointer;
  262. { shadows      : pointer; }
  263.  
  264.   bonus       : byte;
  265.   rowsclear      : word;
  266.   score       : longint;
  267.   shapemap      : byte;
  268.   userpalette      : palettetype;
  269.   level       : byte;
  270.  
  271.  Const
  272.   endrun      : boolean    = False;
  273.   page          : integer    = 0;
  274.  
  275.   display      : displaytype = color;
  276.   height      : byte    = 0;
  277.   initlevel      : byte    = 5;
  278.   depth       : byte    = maxdepth;
  279.   shownext      : boolean = True;
  280.   showguide      : boolean = false;
  281.   showshadow      : boolean = False;
  282.   styleblocks      : byte    = 0;
  283.   title       : boolean = True;
  284.   tones       : boolean = True;
  285.   tournament      : boolean = False;
  286.   tournamentgame  : byte    = 0;
  287.   xshape      : byte    = 1;
  288.   binding      : byte    = 1;
  289.  
  290.  
  291.  Function gettimer : longint;
  292.   Inline($28/$e4/            { sub ah,ah }
  293.      $cd/$1a/            { int 1ah    }
  294.      $89/$d0/            { mov ax,dx }
  295.      $89/$ca);            { mov dx,cx }
  296.  
  297.  procedure numlock(flag : boolean);
  298.   begin
  299.    if flag then
  300.     begin
  301.      savenumlock := mem[$0000:$0417];
  302.      mem[$0000:$0417] := mem[$0000:$0417] or $20
  303.     end
  304.    else
  305.     if savenumlock and $20 = 0 then
  306.      mem[$0000:$0417] := mem[$0000:$0417] and $df
  307.   end;
  308.  
  309. (*
  310.    if flag then
  311.     inline($1e/             { push ds          ; save caller's ds }
  312.        $31/$c0/            { xor  ax,ax      ; zero ax }
  313.        $8e/$d8/            { mov  ds,ax      ; load ds }
  314.        $a0/$17/$04/         { mov  al,[0417]  ; get keyboard flags }
  315.        $0c/$20/            { or   al,20      ; turn on num lock }
  316.        $a2/$17/$04/         { mov  [0417],al  ; save keyboard flags }
  317.        $1f)             { pop  ds          ; restore caller's ds }
  318.    else
  319.     inline($1e/             { push ds          ; save caller's ds }
  320.        $31/$c0/            { xor  ax,ax      ; zero ax }
  321.        $8e/$d8/            { mov  ds,ax      ; load ds }
  322.        $a0/$17/$04/         { mov  al,[0417]  ; get keyboard flags }
  323.        $24/$df/            { and  al,df      ; turn off num lock }
  324.        $a2/$17/$04/         { mov  [0417],al  ; save keyboard flags }
  325.        $1f)             { pop  ds          ; restore caller's ds }
  326.   end; *)
  327.  
  328.  function getkey : word;
  329.   inline($30/$e4/            { xor  ah,ah }
  330.      $cd/$16);            { int  16 }
  331.  
  332.  
  333.  Procedure dographics;
  334.   Begin
  335.    savemode := LastMode;
  336.    DetectGraph(GraphDriver, GraphMode);
  337.    Case GraphDriver Of
  338.     EGAMono:  Begin
  339.            initgraph(graphdriver, graphmode, '');
  340.            setgraphmode(egamonohi);
  341.            display := mono;
  342.           end;
  343.     EGA:      Begin
  344.            InitGraph(GraphDriver, GraphMode, '');
  345.            SetGraphMode(EGAHi)
  346.           End;
  347.     HercMono: Begin
  348.            initgraph(graphdriver, graphmode, '');
  349.            setgraphmode(HercMonoHi);
  350.            display := mono;
  351.           End;
  352.     VGA:      Begin
  353.            InitGraph(GraphDriver, GraphMode, '');
  354.            SetGraphMode(VGAMed)
  355.           End;
  356.     Else
  357.      Begin
  358.       WriteLn(id,
  359.  ' requires either an EGA with 256k RAM, VGA, or Hercules graphics adapter.');
  360.       Halt(0)
  361.      End
  362.    End;
  363.    setactivepage(0);
  364.    cleardevice;
  365.    setactivepage(1);
  366.    cleardevice;
  367.   End;
  368.  
  369.  
  370.  Procedure dotext;
  371.   Begin
  372.    CloseGraph;
  373.    TextMode(savemode)
  374.   End;
  375.  
  376.  
  377.  Procedure fillzero(Var s : bufstr);
  378.  
  379.   Var
  380.    i          : integer;
  381.  
  382.   Begin
  383.    For i := 1 To Length(s) Do
  384.     If s[i] = #32 Then
  385.      s[i] := '0'
  386.   End;
  387.  
  388.  
  389.  Procedure placewindow(x1, y1, x2, y2 : integer);
  390.   Begin
  391.    Rectangle(x1, y1, x2, y2);
  392.    Bar(x2+1, y1+8, x2+3, y2);
  393.    Bar(x1+8, y2+1, x2+3, y2+2)
  394.   End;
  395.  
  396.  
  397.  Procedure putshape(x, y : integer;
  398.             s     : byte;
  399.             p     : pointer);
  400.  
  401.   Var
  402.    i          : integer;
  403.    xs          : byte;
  404.  
  405.   Begin
  406.    xs := shapetab[s, info, 1];
  407.    PutImage(x, y, p^, XORPut);
  408.    For i := 1 To xs Do
  409.     PutImage(x+xshapetab[s, 0, i, 2], y+xshapetab[s, 0, i, 1], p^, XORPut)
  410.   End;
  411.  
  412.  
  413.  Procedure init;
  414.  
  415.   Var
  416.    i, j, isiz      : integer;
  417.    x, y       : integer;
  418.  
  419.   Procedure abortgraphics;
  420.    Begin
  421.     WriteLn(GraphErrorMsg(GraphResult));
  422.     Halt(0)
  423.    End; {-abortgraphics-}
  424.  
  425.   Begin {-init-}
  426.    numlock(true);
  427.    Randomize;
  428.  
  429.    userpalette.colors[0] := -1;
  430.  
  431.    Assign(fconfig, configname);
  432.    FileMode := 0;            { read-only }
  433.    Reset(fconfig);
  434.    If IOResult = 0 Then
  435.     Begin
  436.      While Not Eof(fconfig) Do
  437.       Begin
  438.        ReadLn(fconfig, buf3);
  439.        If buf3[1] <> '#' Then
  440.     Begin
  441.      i := Pos('=', buf3);
  442.      buf2 := Copy(buf3, 1, i-1);
  443.      buf := Copy(buf3, i+1, Length(buf3)-i);
  444.        { WriteLn(buf2);
  445.      WriteLn(buf);
  446.      ReadLn; }
  447.      If buf2 = 'display' Then
  448.       Case buf[1] Of
  449.        'B', 'b': display := bw;
  450.        'C', 'c': display := color;
  451.        'M', 'm': display := mono;
  452.        'P', 'p': display := plasma
  453.       End;
  454.      if buf2 = 'depth' then
  455.       begin
  456.        val (buf, i, j);
  457.        if (j = 0) and (i in [mindepth..maxdepth]) then
  458.         depth := i;
  459.       end;
  460.      If buf2 = 'height' Then
  461.       Begin
  462.        Val(buf, i, j);
  463.        If (j = 0) And (i In [0..2*maxheight]) Then
  464.         height := i
  465.       End;
  466.      If buf2 = 'level' Then
  467.       Begin
  468.        Val(buf, i, j);
  469.        If (j = 0) And (i In [1..maxlevel]) Then
  470.         initlevel := i
  471.       End;
  472.      If buf2 = 'shownext' Then
  473.       Case buf[1] Of
  474.        'Y', 'y': shownext := True;
  475.        'N', 'n': shownext := False
  476.       End;
  477.      If buf2 = 'showguide' Then
  478.       Case buf[1] Of
  479.        'Y', 'y': showguide := True;
  480.        'N', 'n': showguide := False
  481.       End;
  482.        { If buf2 = 'showshadow' Then
  483.       Case buf[1] Of
  484.        'Y', 'y': showshadow := False;
  485.        'N', 'n': showshadow := False
  486.       End; }
  487.      If buf2 = 'tournament' Then
  488.       Case buf[1] Of
  489.        'Y', 'y': tournament := True;
  490.        'N', 'n': tournament := False
  491.       End;
  492.      If buf2 = 'tournamentgame' Then
  493.       Begin
  494.        Val(buf, i, j);
  495.        If (j = 0) And (i In [0..ngames-1]) Then
  496.         tournamentgame := i
  497.       End;
  498.      If buf2 = 'xshape' Then
  499.       Case buf[1] Of
  500.        'C', 'c': xshape := 1;
  501.        'E', 'e': xshape := 2;
  502.        'M', 'm': xshape := 3;
  503.        'H', 'h': xshape := 4
  504.       End;
  505.      If buf2 = 'styleblocks' Then
  506.       Case buf[1] Of
  507.        'N', 'n': styleblocks := 1;
  508.        'C', 'c': styleblocks := 2;
  509.        'P', 'p': styleblocks := 3;
  510.        'B', 'b': styleblocks := 4;
  511.        'A', 'a': styleblocks := 5;
  512.        'E', 'e': styleblocks := 6;
  513.        'R', 'r': styleblocks := nstyletabs
  514.       End;
  515.      If buf2 = 'sound' Then
  516.       Case buf[1] Of
  517.        'Y', 'y': tones := True;
  518.        'N', 'n': tones := False
  519.       End;
  520.      If buf2 = 'title' Then
  521.       Case buf[1] Of
  522.        'Y', 'y': title := True;
  523.        'N', 'n': title := False
  524.       End;
  525.  
  526.      if buf2 = 'palette' then
  527.       begin
  528.        for x := 0 to palettesiz-2 do
  529.         begin
  530.          i := pos (',', buf);
  531.          if i <> 0 then
  532.           begin
  533.            buf3 := copy (buf, 1, i-1);
  534.            buf := copy (buf, i+1, length (buf)-i);
  535.            val(buf3, y, j);
  536.            if (j = 0) and (y in [0..63]) then
  537.         userpalette.colors[x] := y
  538.            else
  539.         userpalette.colors[0] := -1;
  540.           end
  541.          else
  542.           userpalette.colors[0] := -1;
  543.         end;
  544.         val(buf,y,j);
  545.         if (j = 0) and (y in [0..63]) then
  546.          userpalette.colors[palettesiz-1] := y
  547.         else
  548.          userpalette.colors[0] := -1;
  549.       end;
  550.  
  551.      if buf2 = 'keybinding' then
  552.       Case buf[1] Of
  553.        'C', 'c': binding := 1;
  554.        'R', 'r': binding := 2;
  555.        'B', 'b': binding := 3;
  556.        'L', 'l': binding := 4;
  557.        'F', 'f': binding := 5;
  558.        'S', 's': binding := 6;
  559.        'A', 'a': binding := 7;
  560.        'U', 'u': binding := 8;
  561.        '0'..'9': begin
  562.               binding := 8;
  563.               for x := 1 to nkeys-1 do
  564.                begin
  565.             i := pos (',', buf);
  566.             if i <> 0 then
  567.              begin
  568.               buf3 := copy(buf, 1, i-1);
  569.               buf := copy(buf, i+1, length(buf)-i);
  570.               val(buf3, y, j);
  571.               if (j = 0) and (y in [0..255]) then
  572.                keybindingtab[nkeybindings, x] := y
  573.               else
  574.                 keybindingtab[nkeybindings, 1] := 0;
  575.              end
  576.             else
  577.              keybindingtab[nkeybindings, 1] := 0;
  578.                end;
  579.               val(buf, y, j);
  580.               if (j = 0) and (y in [0..255]) then
  581.                keybindingtab[nkeybindings, nkeys] := y
  582.               else
  583.                keybindingtab[nkeybindings, 1] := 0;
  584.              end
  585.       end
  586.     End
  587.       End;
  588.      Close(fconfig)
  589.     End;
  590.  
  591.    If ParamCount > 0 Then
  592.     Begin
  593.      buf := Copy(ParamStr(1), 1, 1);
  594.      Case buf[1] Of
  595.       'B', 'b': display := bw;
  596.       'C', 'c': display := color;
  597.       'M', 'm': display := mono;
  598.       'P', 'p': display := plasma
  599.      End
  600.     End;
  601.  
  602.    If RegisterBGIdriver(@EGAVGADriver) < 0 Then
  603.     abortgraphics;
  604.    if registerbgidriver(@hercdriver) < 0 then
  605.     abortgraphics;
  606.  
  607.    If RegisterBGIfont(@SansSerifFontProc) < 0 Then
  608.     abortgraphics;
  609.    If RegisterBGIfont(@SmallFontProc) < 0 Then
  610.     abortgraphics;
  611.  
  612.    dographics;
  613.  
  614.    For i := 1 To nshapes Do
  615.     For j := 1 To shapesiz-1 Do
  616.      Begin
  617.       xshapetab[i, 0, j, 1] :=    pixelsperblock*shapetab[i, j, 1];
  618.       yshapetab[i, 0, j, 1] :=    shapetab[i, j, 1];
  619.       xshapetab[i, 0, j, 2] :=    pixelsperblock*shapetab[i, j, 2];
  620.       yshapetab[i, 0, j, 2] :=    shapetab[i, j, 2];
  621.       xshapetab[i, 1, j, 1] :=    pixelsperblock*shapetab[i, j, 2];
  622.       yshapetab[i, 1, j, 1] :=    shapetab[i, j, 2];
  623.       xshapetab[i, 1, j, 2] := -pixelsperblock*shapetab[i, j, 1];
  624.       yshapetab[i, 1, j, 2] := -shapetab[i, j, 1];
  625.       xshapetab[i, 2, j, 1] := -pixelsperblock*shapetab[i, j, 1];
  626.       yshapetab[i, 2, j, 1] := -shapetab[i, j, 1];
  627.       xshapetab[i, 2, j, 2] := -pixelsperblock*shapetab[i, j, 2];
  628.       yshapetab[i, 2, j, 2] := -shapetab[i, j, 2];
  629.       xshapetab[i, 3, j, 1] := -pixelsperblock*shapetab[i, j, 2];
  630.       yshapetab[i, 3, j, 1] := -shapetab[i, j, 2];
  631.       xshapetab[i, 3, j, 2] :=    pixelsperblock*shapetab[i, j, 1];
  632.       yshapetab[i, 3, j, 2] :=    shapetab[i, j, 1]
  633.      End;
  634.  
  635.    For i := 1 To ncolors Do
  636.     shapecolors[i] := shapecolortab[display, i];
  637.  
  638.    colornormal := mesgcolortab[display, normal];
  639.    colorhigh   := mesgcolortab[display, high];
  640.  
  641.    FillChar(hiscore, SizeOf(hiscore), 0);
  642.    i := 1;
  643.    Assign(fhiscore, hiscorename);
  644.    FileMode := 0;            { read-only }
  645.    Reset(fhiscore);
  646.    If IOResult = 0 Then
  647.     Begin
  648.      While (i <= nhiscores) And (Not Eof(fhiscore)) Do
  649.       Begin
  650.        Read(fhiscore, hiscore[i]);
  651.        Inc(i)
  652.       End;
  653.      Close(fhiscore)
  654.     End;
  655.  
  656.    SetVisualPage(page);
  657.    page := 1-page;
  658.    SetActivePage(page);
  659.  
  660.    GetMem(scrollptr, ImageSize(colmin+1, rowmin, colmax-1,
  661.     rowmax+pixelsperblock));
  662.  
  663.    getmem(emptyrow, ImageSize(colmin+1, rowmin, colmax-1,
  664.     rowmin+pixelsperblock+1));
  665.    isiz := ImageSize(colmin+1, rowmin, colmax-1, rowmin+pixelsperblock);
  666.  
  667.  { isiz := ImageSize(0, 0, pixelsperblock, pixelsperblock);
  668.    SetColor(colorhigh);
  669.    SetFillPattern(filltab[1], colornormal);
  670.    Bar(0, 0, pixelsperblock, pixelsperblock Shr 1);
  671.    GetMem(shadows, isiz);
  672.    GetImage(0, 0, pixelsperblock, pixelsperblock Shr 1, shadows^);
  673.    PutImage(0, 0, shadows^, XORPut); }
  674.  
  675.    isiz := ImageSize(0, 0, pixelsperblock, pixelsperblock);
  676.    SetColor(colornormal);
  677.    SetFillStyle(SolidFill, colornormal);
  678.    Bar(1, 1, pixelsperblock-1, pixelsperblock-1);
  679.    SetColor(Black);
  680.    Rectangle(3, 3, pixelsperblock-3, pixelsperblock-3);
  681.    Line(1, 1, 3, 3);
  682.    Line(1, pixelsperblock-1, 3, pixelsperblock-3);
  683.    Line(pixelsperblock-1, 1, pixelsperblock-3, 3);
  684.    Line(pixelsperblock-1, pixelsperblock-1, pixelsperblock-3,
  685.     pixelsperblock-3);
  686.  
  687.    For i := 1 To ncolors Do          { new }
  688.     For j := 1 To nstyles Do
  689.      Begin
  690.       SetFillPattern(filltab[j], shapecolors[i]);
  691.       Bar(4, 4, pixelsperblock-4, pixelsperblock-4);
  692.       GetMem(xstyletabs[1, i, j], isiz);
  693.       GetImage(0, 0, pixelsperblock, pixelsperblock, xstyletabs[1, i, j]^)
  694.      End;
  695.  
  696.    For i := 1 To ncolors Do          { pumped full of drugs }
  697.     For j := 1 To nstyles Do
  698.      Begin
  699.       SetFillPattern(filltab[Random(nstyles)+1],
  700.              shapecolors[Random(ncolors)+1]);
  701.       Bar(4, 4, 7, 7);
  702.       SetFillPattern(filltab[Random(nstyles)+1],
  703.              shapecolors[Random(ncolors)+1]);
  704.       Bar(7, 4, 10, 7);
  705.       SetFillPattern(filltab[Random(nstyles)+1],
  706.              shapecolors[Random(ncolors)+1]);
  707.       Bar(4, 7, 7, 10);
  708.       SetFillPattern(filltab[Random(nstyles)+1],
  709.              shapecolors[Random(ncolors)+1]);
  710.       Bar(7, 7, 10, 10);
  711.       GetMem(xstyletabs[3, i, j], isiz);
  712.       GetImage(0, 0, pixelsperblock, pixelsperblock, xstyletabs[3, i, j]^)
  713.      End;
  714.  
  715.   if display = mono then
  716.    begin
  717.     for i := 1 to ncolors do            { barbed wire kisses }
  718.      for j := 1 to nstyles do
  719.       begin
  720.        for x := 4 to pixelsperblock-4 do
  721.     for y := 4 to pixelsperblock-4 do
  722.      begin
  723.       if random(3) > 0 then
  724.        putpixel(x, y, shapecolors[i])
  725.       else
  726.        putpixel(x, y, 0);
  727.      end; { for }
  728.     GetMem(xstyletabs[4, i, j], isiz);
  729.     GetImage(0, 0, pixelsperblock, pixelsperblock, xstyletabs[4, i, j]^)
  730.        End
  731.    end
  732.   else
  733.    begin
  734.     for i := 1 to ncolors do
  735.      for j := 1 to nstyles do
  736.       begin
  737.        for x := 4 to pixelsperblock-4 do
  738.     for y := 4 to pixelsperblock-4 do
  739.      begin
  740.       if random(2) = 0 then
  741.        putpixel(x, y, shapecolors[i])
  742.       else
  743.        putpixel(x, y, shapecolors[random(ncolors)+1])
  744.      end; { for }
  745.     GetMem(xstyletabs[4, i, j], isiz);
  746.     GetImage(0, 0, pixelsperblock, pixelsperblock, xstyletabs[4, i, j]^)
  747.        End
  748.    end;
  749.  
  750.    SetFillPattern(filltab[1], colornormal);
  751.    Bar(4, 4, pixelsperblock-4, pixelsperblock-4);
  752.    GetMem(filler, isiz);
  753.    GetImage(0, 0, pixelsperblock, pixelsperblock, filler^);
  754.    PutImage(0, 0, filler^, XORPut);
  755.  
  756.    For i := 1 To ncolors Do        { classic }
  757.     Begin
  758.      SetColor(shapecolors[i]);
  759.      For j := 1 To nstyles Do
  760.       Begin
  761.        SetFillPattern(filltab[j], shapecolors[i]);
  762.        Rectangle(1, 1, pixelsperblock-1, pixelsperblock-1);
  763.        Bar(3, 3, pixelsperblock-3, pixelsperblock-3);
  764.        GetMem(xstyletabs[2, i, j], isiz);
  765.        GetImage(0, 0, pixelsperblock, pixelsperblock, xstyletabs[2, i, j]^)
  766.       End
  767.     End;
  768.  
  769.    For i := 1 To ncolors Do        { arpeggiator }
  770.     Begin
  771.      SetColor(shapecolors[i]);
  772.      For j := 1 To nstyles Do
  773.       Begin
  774.        SetFillPattern(filltab[j], shapecolors[i]);
  775.        bar(1, 1, pixelsperblock-1, pixelsperblock-1);
  776.        GetMem(xstyletabs[5, i, j], isiz);
  777.        GetImage(0, 0, pixelsperblock, pixelsperblock, xstyletabs[5, i, j]^)
  778.       End
  779.     End;
  780.  
  781.   if display = mono then
  782.    begin
  783.     for i := 1 to ncolors do          { elephant stone }
  784.      for j := 1 to nstyles do
  785.       begin
  786.        for x := 1 to pixelsperblock-1 do
  787.     for y := 1 to pixelsperblock-1 do
  788.      begin
  789.       if random(3) > 0 then
  790.        putpixel(x, y, shapecolors[i])
  791.       else
  792.        putpixel(x, y, 0);
  793.      end; { for }
  794.     getMem(xstyletabs[6, i, j], isiz);
  795.     getImage(0, 0, pixelsperblock, pixelsperblock, xstyletabs[6, i, j]^)
  796.        end
  797.    end
  798.   else
  799.    begin
  800.     for i := 1 to ncolors do          { elephant stone }
  801.      for j := 1 to nstyles do
  802.       begin
  803.        for x := 1 to pixelsperblock-1 do
  804.     for y := 1 to pixelsperblock-1 do
  805.      begin
  806.       if random(2) = 0 then
  807.        putpixel(x, y, shapecolors[i])
  808.       else
  809.        putpixel(x, y, shapecolors[random(ncolors)+1])
  810.      end; { for }
  811.     getMem(xstyletabs[6, i, j], isiz);
  812.     getImage(0, 0, pixelsperblock, pixelsperblock, xstyletabs[6, i, j]^)
  813.        end;
  814.     end;
  815.  
  816.    SetColor(colorhigh);
  817.    SetFillPattern(filltab[2], colornormal);
  818.    Bar(1, 1, pixelsperblock-1, pixelsperblock-1);
  819.    GetMem(curtain[true], isiz);
  820.    GetImage(0, 0, pixelsperblock, pixelsperblock, curtain[true]^);
  821.  
  822.    SetFillPattern(filltab[3], colornormal);
  823.    Bar(1, 1, pixelsperblock-1, pixelsperblock-1);
  824.    GetMem(curtain[false], isiz);
  825.    GetImage(0, 0, pixelsperblock, pixelsperblock, curtain[false]^);
  826.    PutImage(0, 0, curtain[false]^, XORPut);
  827.  
  828.    For i := 1 To ncolors Do
  829.     For j := 1 To nstyles Do
  830.      xstyletabs[nstyletabs, i, j] := xstyletabs[Random(nstyletabs-1)+1, i, j];
  831. {                       Random(ncolors)+1,
  832.                        Random(nstyles)+1] }
  833.  
  834.    if display = color then
  835.     begin
  836.      userpalette.size := palettesiz;
  837.      if userpalette.colors[0] = -1 then
  838.       for i := 0 to palettesiz-1 do
  839.        userpalette.colors[i] := palettemap[i];
  840.      setallpalette(userpalette)
  841.     end
  842.   End; {-init-}
  843.  
  844.  
  845.  Procedure drawtitle;
  846.  
  847.   Const
  848.    titlesiz      = 95;
  849.    titletab      : Array [1..titlesiz, 1..2] Of integer =
  850.             (( 75,  57), ( 75,    71), ( 75, 85), ( 75, 99),
  851.               ( 75, 113), ( 75, 127), ( 75, 141),
  852.              ( 89,  57), ( 89, 99), ( 89, 141),
  853.              (103,  57), (103, 99), (103, 141),
  854.              (117,  57), (117, 99), (117, 141),
  855.              (131,  57), (131, 141),
  856.  
  857.              (159,  71), (159, 85), (159, 99), (159, 113),
  858.               (159, 127),
  859.              (173,  57), (173, 141),
  860.              (187,  57), (187, 141),
  861.              (201,  57), (201, 99), (201, 141),
  862.              (215,  71), (215, 99), (215, 113), (215, 127),
  863.  
  864.              (243,  71), (243, 85), (243, 99), (243, 113),
  865.               (243, 127), (243, 141),
  866.              (257,  57), (257, 99),
  867.              (271,  57), (271, 99),
  868.              (285,  57), (285, 99),
  869.              (299,  71), (299, 85), (299, 99), (299, 113),
  870.               (299, 127), (299, 141),
  871.  
  872.              (327,  57), (327, 141),
  873.              (341,  57), (341, 141),
  874.              (355,  57), (355,    71), (355, 85), (355, 99),
  875.               (355, 113), (355, 127), (355, 141),
  876.              (369,  57), (369, 141),
  877.              (383,  57), (383, 141),
  878.  
  879.              (411,  57), (411,    71), (411, 85), (411, 99),
  880.               (411, 113), (411, 127), (411, 141),
  881.              (425,  71),
  882.              (439, 85),
  883.              (453, 99),
  884.              (467,  57), (467,    71), (467, 85), (467, 99),
  885.               (467, 113), (467, 127), (467, 141),
  886.  
  887.              (495,  57),
  888.              (509,  57),
  889.              (523,  57), (523,    71), (523, 85), (523, 99),
  890.               (523, 113), (523, 127), (523, 141),
  891.              (537,  57),
  892.              (551,  57));
  893.  
  894.   Var
  895.    test       : Array [1..titlesiz] Of boolean;
  896.    ch          : word;
  897.    i, j, c, s      : integer;
  898.    x, y1, y2      : integer;
  899.    p          : pointer;
  900.  
  901.   Begin {-drawtitle-}
  902.    FillChar(test, SizeOf(test), 0);
  903.  
  904.    If styleblocks = 0 Then
  905.     styleblocks := Random(nstyletabs-1)+1;
  906.    s := 1;
  907.  
  908.    if title then
  909.     begin
  910.      For i := 1 To titlesiz Do
  911.       Begin
  912.        Repeat
  913.     j := Random(titlesiz)+1
  914.        Until Not test[j];
  915.        c := Random(ncolors)+1;
  916.        If styleblocks = 3 Then
  917.     s := Random(nstyles)+1;
  918.        x := titletab[j, 1];
  919.        If KeyPressed Then
  920.     y1 := titletab[j, 2]
  921.        Else
  922.     Begin
  923.      y1 := 0;
  924.      y2 := dropinc
  925.     End;
  926.        p := xstyletabs[styleblocks, c, s];
  927.        PutImage(x, y1, p^, XORPut);
  928.        SetVisualPage(page);
  929.        page := 1-page;
  930.        SetActivePage(page);
  931.  
  932.        While (Not KeyPressed) And (y2 < titletab[j, 2]) Do
  933.     Begin
  934.      PutImage(x, y2, p^, XORPut);
  935.      Delay(dropdelay);
  936.      SetVisualPage(page);
  937.      page := 1-page;
  938.      SetActivePage(page);
  939.      PutImage(x, y1, p^, XORPut);
  940.      y1 := y2;
  941.      Inc(y2, dropinc)
  942.     End;
  943.  
  944.        PutImage(x, titletab[j, 2], p^, XORPut);
  945.        SetVisualPage(page);
  946.        page := 1-page;
  947.        SetActivePage(page);
  948.  
  949.        PutImage(x, y1, p^, XORPut);
  950.        PutImage(x, titletab[j, 2], p^, XORPut);
  951.        test[j] := True
  952.       End;
  953.      While KeyPressed Do
  954.       ch := getkey;
  955.  
  956.      SetTextJustify(CenterText, TopText);
  957.      SetColor(colorhigh);
  958.      SetTextStyle(SansSerifFont, HorizDir, 4);
  959.      OutTextXY(320, 7, 'Welcome to version '+version+' of');
  960.      OutTextXY(320, 162, copyright);
  961.  
  962.      SetTextStyle(SmallFont, HorizDir, 4);
  963.      OutTextXY(320, 215,
  964.   'This program comes with ABSOLUTELY NO WARRANTY; see the accompanying GNU '+
  965.   'General Public License for full');
  966.      OutTextXY(320, 227,
  967.   'details.  You should have received a copy along with this program (see the '+
  968.   'file COPYING).  If not, write to:');
  969.      OutTextXY(320, 239,
  970.   'Free Software Foundation, Inc., 675 Massachusetts Avenue, Cambridge, '+
  971.   'Massachusetts 02139');
  972.  
  973.      OutTextXY(320, 323,
  974.   'Eric Ng, 1906 Milvia Street, Berkeley, California 94704');
  975.      OutTextXY(320, 335, 'Internet: erc@irss.njit.edu');
  976.  
  977.      SetColor(colornormal);
  978.      OutTextXY(160, 257, 'To obtain the full source code and/or the');
  979.      OutTextXY(160, 269, 'latest version of this program, call');
  980.      OutTextXY(160, 305, 'or see the included file GETTING.');
  981.  
  982.      OutTextXY(480, 257, 'Requirements:  IBM PC, PS/2, or 100%');
  983.      OutTextXY(480, 269, 'compatible (8 MHz or faster CPU is strongly');
  984.      OutTextXY(480, 281, 'recommended); an EGA with 256k RAM, VGA,');
  985.      OutTextXY(480, 293, 'Hercules graphics adapter; and 256k free');
  986.      OutTextXY(480, 305, 'system RAM.');
  987.  
  988.      SetColor(colorhigh);
  989.      OutTextXY(160, 281, 'The Odyssey +1 201 984 6574');
  990.      OutTextXY(160, 293, 'The PC GFX Exchange +1 415 337 5416');
  991.    { OutTextXY(160, 293, 'The Bandersnatch +1 201 766-3801') }
  992.     end;
  993.  
  994.    SetVisualPage(page);
  995.    page := 1-page;
  996.    SetActivePage(page);
  997.    ClearDevice;
  998.  
  999.    if title then
  1000.     begin
  1001.      Repeat Until KeyPressed;
  1002.      Repeat
  1003.       ch := getkey
  1004.      Until Not KeyPressed
  1005.     end
  1006.   End; {-drawtitle-}
  1007.  
  1008.  procedure getkeybindings;
  1009.  
  1010.   procedure drawkeybindings;
  1011.    begin
  1012.     SetTextJustify(CenterText, TopText);
  1013.     SetColor(colorhigh);
  1014.     SetTextStyle(SansSerifFont, HorizDir, 4);
  1015.     OutTextXY(320, 2, id+' '+version);
  1016.  
  1017.     SetColor(colornormal);
  1018.     SetTextStyle(DefaultFont, HorizDir, 1);
  1019.     OutTextXY(320, 40, 'Key Bindings');
  1020.     SetFillStyle(SolidFill, colornormal);
  1021.     placewindow(237, 60, 403, 132);
  1022.  
  1023.     SetTextStyle(SmallFont, HorizDir, 4);
  1024.     outtextxy(320, 86, 'Press the key for');
  1025.    end;
  1026.  
  1027.   procedure getgetkey(n : integer);
  1028.    var
  1029.     ch : word;
  1030.     i  : integer;
  1031.  
  1032.    begin
  1033.     repeat
  1034.      repeat
  1035.       ch := getkey
  1036.      until lo(ch) in [32..126];
  1037.      i := 1;
  1038.      while (keybindingtab[nkeybindings, i] <> hi(ch)) and (i < n) do
  1039.       inc(i);
  1040.      if i = n then
  1041.       begin
  1042.        keybindingtab[nkeybindings, n] := hi(ch);
  1043.        if tones then
  1044.     begin
  1045.      Sound(cleartone);
  1046.      Delay(cleartonedelay);
  1047.      NoSound
  1048.     end
  1049.       end
  1050.     until i = n
  1051.    end; {-getgetkey-}
  1052.  
  1053.   begin {-getkeybindings-}
  1054.    drawkeybindings;
  1055.    setvisualpage(page);
  1056.  
  1057.    setcolor(colorhigh); outtextxy(320, 98, 'Drop');
  1058.    getgetkey(keydrop);
  1059.    setcolor(black); outtextxy(320, 98, 'Drop');
  1060.  
  1061.    setcolor(colorhigh); outtextxy(320, 98, 'Move Left');
  1062.    getgetkey(keyleft);
  1063.    setcolor(black); outtextxy(320, 98, 'Move Left');
  1064.  
  1065.    setcolor(colorhigh); outtextxy(320, 98, 'Move Right');
  1066.    getgetkey(keyright);
  1067.    setcolor(black); outtextxy(320, 98, 'Move Right');
  1068.  
  1069.    setcolor(colorhigh); outtextxy(320, 98, 'Rotate Left');
  1070.    getgetkey(keyrotateleft);
  1071.    setcolor(black); outtextxy(320, 98, 'Rotate Left');
  1072.  
  1073.    setcolor(colorhigh); outtextxy(320, 98, 'Rotate Right');
  1074.    getgetkey(keyrotateright);
  1075.    setcolor(black); outtextxy(320, 98, 'Rotate Right')
  1076.   end; {-getkeybindings-}
  1077.  
  1078.  Procedure initgame;
  1079.  
  1080.   Var
  1081.    i, j       : integer;
  1082.  
  1083.   Procedure getoptions;
  1084.  
  1085.    Const
  1086.     noptions      = 10;
  1087.     optiontitles  : Array [1..noptions] Of String [22] =
  1088.             ('Tournament Game',
  1089.              'Tournament Game Number',
  1090.              'Initial Level',
  1091.              'Initial Height',
  1092.              'Show Next',
  1093.              'Extended Shapes',
  1094.              'Block Style',
  1095.              'Key Bindings',
  1096.              'Pit Depth',
  1097.              'Show Guide');
  1098.     optiony      = 80;
  1099.     optionyinc      = 22;
  1100.  
  1101.    Var
  1102.     done      : boolean;
  1103.     o          : byte;
  1104.     bigheight      : byte;
  1105.     ch          : word;
  1106.  
  1107.    Procedure drawoptions;
  1108.  
  1109.     Var
  1110.      i          : integer;
  1111.  
  1112.     Begin {-drawoptions-}
  1113.      SetTextJustify(CenterText, TopText);
  1114.      SetColor(colorhigh);
  1115.      SetTextStyle(SansSerifFont, HorizDir, 4);
  1116.      OutTextXY(320, 2, id+' '+version);
  1117.  
  1118.      SetColor(colornormal);
  1119.      SetTextStyle(DefaultFont, HorizDir, 1);
  1120.      OutTextXY(320, 40, 'Options');
  1121.      OutTextXY(320, 330,
  1122. 'Press the arrow keys to move, Enter to rotate, and the Space Bar when done.');
  1123.      SetFillStyle(SolidFill, colornormal);
  1124.      placewindow(150, 65, 490, 307);
  1125.  
  1126.      SetTextJustify(LeftText, TopText);
  1127.      For i := 1 To noptions Do
  1128.       OutTextXY(200, optiony+(optionyinc*(i-1))+3, optiontitles[i])
  1129.     End; {-drawoptions-}
  1130.  
  1131.    Procedure showflag(f : boolean;
  1132.               y : integer);
  1133.     Begin
  1134.      If f Then
  1135.       OutTextXY(440, optiony+(optionyinc*(y-1)), 'Yes')
  1136.      Else
  1137.       OutTextXY(440, optiony+(optionyinc*(y-1)), 'No')
  1138.     End; {-showflag-}
  1139.  
  1140.    Procedure showoption(o : byte);
  1141.     Begin
  1142.      Case o Of
  1143.       1: showflag(tournament, o);
  1144.       2: Begin
  1145.       Str(tournamentgame, buf);
  1146.       OutTextXY(440, optiony+(optionyinc*(o-1)), buf)
  1147.      End;
  1148.       3: Begin
  1149.       Str(level, buf);
  1150.       OutTextXY(440, optiony+(optionyinc*(o-1)), buf)
  1151.      End;
  1152.       4: Begin
  1153.       If height > maxheight Then
  1154.         begin
  1155.          str(height-maxheight, buf);
  1156.          buf := 'Hidden '+buf
  1157.         end
  1158.       Else
  1159.        Str(height, buf);
  1160.       OutTextXY(440, optiony+(optionyinc*(o-1)), buf)
  1161.      End;
  1162.       5: showflag(shownext, o);
  1163.       6: OutTextXY(440, optiony+(optionyinc*(o-1)), xshapetitles[xshape]);
  1164.       7: OutTextXY(440, optiony+(optionyinc*(o-1)), styleblocktitles[styleblocks]);
  1165.       8: OutTextXY(440, optiony+(optionyinc*(o-1)), keybindingtitles[binding]);
  1166.       9: begin
  1167.       str(depth, buf);
  1168.       outtextxy(440, optiony+(optionyinc*(o-1)), buf);
  1169.      end;
  1170.      10: showflag(showguide, o);
  1171.      End
  1172.     End; {-showoptions-}
  1173.  
  1174.    Procedure rotateopt(o : byte);
  1175.     Begin
  1176.      SetTextJustify(RightText, TopText);
  1177.      SetTextStyle(SmallFont, HorizDir, 4);
  1178.      SetColor(Black);
  1179.      showoption(o);
  1180.      Case o Of
  1181.       1: tournament    := Not tournament;
  1182.       2: tournamentgame := (tournamentgame+1) Mod ngames;
  1183.       3: level        := (level Mod maxlevel)+1;
  1184.       4: height := (height+1) Mod ((2*maxheight)+1);
  1185.       5: shownext    := Not shownext;
  1186.       6: xshape     := (xshape Mod xshapelevels)+1;
  1187.       7: styleblocks    := (styleblocks Mod nstyletabs)+1;
  1188.       8: begin
  1189.       binding    := (binding mod nkeybindings)+1;
  1190.       if binding = nkeybindings then
  1191.        keybindingtab[nkeybindings, 1] := 0
  1192.      end;
  1193.       9: begin
  1194.       inc(depth);
  1195.       if depth > maxdepth then depth := mindepth;
  1196.      end;
  1197.      10: showguide := not showguide;
  1198.      End;
  1199.      SetColor(colorhigh);
  1200.      showoption(o)
  1201.     End; {-rotateopt-}
  1202.  
  1203.    Begin {-getoptions-}
  1204.     drawoptions;
  1205.     level := initlevel;
  1206.     SetTextJustify(RightText, TopText);
  1207.     SetTextStyle(SmallFont, HorizDir, 4);
  1208.     SetColor(colorhigh);
  1209.     For o := 1 To noptions Do
  1210.      showoption(o);
  1211.     SetVisualPage(page);
  1212.  
  1213.     done := False;
  1214.     o     := 1;
  1215.     Repeat
  1216.      SetTextJustify(LeftText, TopText);
  1217.      SetTextStyle(DefaultFont, HorizDir, 1);
  1218.      SetColor(colorhigh);
  1219.      OutTextXY(200, optiony+(optionyinc*(o-1))+3, optiontitles[o]);
  1220.      OutTextXY(190, optiony+(optionyinc*(o-1))+3, #254);
  1221.  
  1222.      Repeat Until KeyPressed;
  1223.      ch := getkey;
  1224.      Case hi(ch) of
  1225.                1: Begin             { escape }
  1226.                done   := True;
  1227.                endrun := True
  1228.               End;
  1229.               57: done := True;         { space }
  1230.       35, 36, 72, 75: begin             { H J up left }
  1231.                SetColor(colornormal);
  1232.                OutTextXY(200, optiony+(optionyinc*(o-1))+3, optiontitles[o]);
  1233.                SetColor(0);
  1234.                OutTextXY(190, optiony+(optionyinc*(o-1))+3, #254);
  1235.                If o < 2 Then
  1236.                 o := noptions
  1237.                Else
  1238.                 Dec(o)
  1239.               End;
  1240.           23, 28, 37: rotateopt(o);         { I enter K }
  1241.           38, 77, 80: begin             { L right down }
  1242.                SetColor(colornormal);
  1243.                OutTextXY(200, optiony+(optionyinc*(o-1))+3, optiontitles[o]);
  1244.                SetColor(0);
  1245.                OutTextXY(190, optiony+(optionyinc*(o-1))+3, #254);
  1246.                If o > noptions-1 Then
  1247.                 o := 1
  1248.                Else
  1249.                 Inc(o)
  1250.               End
  1251.      End
  1252.     Until done;
  1253.  
  1254.     page := 1-page;
  1255.     SetActivePage(page);
  1256.     ClearDevice;
  1257.    End; {-getoptions-}
  1258.  
  1259.   Procedure fillfield(h : byte);
  1260.  
  1261.    Var
  1262.     i, j      : integer;
  1263.     k          : byte;
  1264.  
  1265.    Begin {-fillfield-}
  1266.     For i := depth DownTo depth-(h-1) Do
  1267.      Begin
  1268.       k := Random(filladd)+fillbase;
  1269.       For j := 1 To k Do
  1270.        field[i, Random(blockcols)+1] := True
  1271.      End
  1272.    End; {-fillfield-}
  1273.  
  1274.   Begin {-initgame-}
  1275.    getoptions;
  1276.  
  1277.    FillChar(field, SizeOf(field)-blockcols, 0);
  1278.    FillChar(field[depth+1, 1], blockcols, 1);
  1279.  { FillChar(fieldshadows, SizeOf(fieldshadows), 0); }
  1280.  
  1281.    If tournament Then
  1282.     RandSeed := tournamentgame;
  1283.  
  1284.    If height <> 0 Then
  1285.     Begin
  1286.      If height > maxheight Then
  1287.       begin
  1288.        if depth-(height-maxheight) < mindepth then
  1289.     height := (depth-mindepth)+maxheight;
  1290.        fillfield(height-maxheight);
  1291.        bonus := (height-maxheight)+bonushidden
  1292.       end
  1293.      Else
  1294.       Begin
  1295.        if depth-height < mindepth then
  1296.     height := depth-mindepth;
  1297.        fillfield(height);
  1298.        bonus := height
  1299.       End
  1300.     End
  1301.    Else
  1302.     bonus := 0;
  1303.    If Not shownext Then
  1304.     Inc(bonus, bonusnext);
  1305.    if not showguide then
  1306.     inc(bonus, bonusguide);
  1307.    If Not showshadow Then
  1308.     Inc(bonus, bonusshadow);
  1309.    inc(bonus, (maxdepth-depth)*2);
  1310.  
  1311.    rowsclear := 0;
  1312.    score     := 0;
  1313.  
  1314.    Case xshape Of
  1315.     1: shapemap := xshapeclassic;
  1316.     2: shapemap := xshapeeasy;
  1317.     3: shapemap := xshapemedium;
  1318.     4: shapemap := xshapehard
  1319.    End;
  1320.  
  1321.    Move(xstyletabs[styleblocks], styletab, SizeOf(styletab));
  1322.    if not endrun then
  1323.     if binding = nkeybindings then
  1324.      begin
  1325.       if keybindingtab[nkeybindings, 1] = 0 then
  1326.        getkeybindings
  1327.      end
  1328.     else
  1329.      fillchar(keybindingtab[nkeybindings], sizeof(keybinding), 0);
  1330.    move(keybindingtab[binding], keybinding, sizeof(keybinding))
  1331.   End; {-initgame-}
  1332.  
  1333.  procedure drawguide(c:byte);
  1334.   var i:integer;
  1335.   begin
  1336.    setcolor(c);
  1337.    setlinestyle(userbitln,$aaaa,normwidth);
  1338.    for i := 1 to blockcols-1 do
  1339.     line(colmin+(pixelsperblock*i)+1, rowmin,
  1340.      colmin+(pixelsperblock*i)+1, rowmin+(pixelsperblock*depth));
  1341.    setlinestyle(solidln,0,normwidth)
  1342.   end;
  1343.  
  1344.  Procedure drawscreen;
  1345.  
  1346.   Procedure drawfieldwin;
  1347.  
  1348.    Var
  1349.     rowmaxpel       : integer;
  1350.     colminpel       : integer;
  1351.     colmaxpel       : integer;
  1352.     i           : integer;
  1353.  
  1354.    Begin {-drawfieldwin-}
  1355.     rowmaxpel := getmaxy;
  1356.     colminpel := colmin-pixelsperblock;
  1357.     colmaxpel := colmax+pixelsperblock;
  1358.  
  1359.     SetColor(colornormal);
  1360.     SetFillPattern(filltab[1], colornormal);
  1361.     Bar(colminpel, rowmin, colmin, rowmaxpel);
  1362.     Bar(colmin, rowmax, colmax, rowmaxpel);
  1363.     Bar(colmax, rowmin, colmaxpel, rowmaxpel);
  1364.     Line(colminpel, rowmin, colminpel, rowmaxpel);
  1365.     Line(colmin, rowmin, colmin, rowmax);
  1366.     Line(colmax, rowmin, colmax, rowmax);
  1367.     Line(colmaxpel, rowmin, colmaxpel, rowmaxpel);
  1368.     Line(colminpel, rowmin, colmin, rowmin);
  1369.     Line(colmin, rowmax, colmax, rowmax);
  1370.     Line(colmax, rowmin, colmaxpel, rowmin);
  1371.     Line(colminpel, rowmaxpel, colmaxpel, rowmaxpel);
  1372.  
  1373.     if depth <> maxdepth then
  1374.      begin
  1375.       setfillpattern(filltab[1], colornormal);
  1376.       bar(colmin+2, rowmin+(pixelsperblock*depth)+1, colmax-2,
  1377.        rowmin+(pixelsperblock*maxdepth)-1);
  1378.     end;
  1379.  
  1380.     if showguide then
  1381.      drawguide(colornormal)
  1382.    End; {-drawfieldwin-}
  1383.  
  1384.   Procedure drawnextwin;
  1385.    Begin
  1386.     SetColor(colornormal);
  1387.     SetFillStyle(SolidFill, colornormal);
  1388.     placewindow(35, 16, 201, 126);
  1389.  
  1390.     SetTextStyle(DefaultFont, HorizDir, 1);
  1391.     settextjustify(centertext, toptext);
  1392.     OutTextXY(118, 114, 'Next')
  1393.    End;
  1394.  
  1395.   Procedure drawscorewin;
  1396.    Begin
  1397.     SetColor(colornormal);
  1398.     SetFillStyle(SolidFill, colornormal);
  1399.     placewindow(439, 16, 605, 126);
  1400.  
  1401.     SetColor(colorhigh);
  1402.     SetTextStyle(SansSerifFont, HorizDir, 4);
  1403.     SetTextJustify(CenterText, TopText);
  1404.     OutTextXY(522, 21, id);
  1405.  
  1406.     SetColor(colornormal);
  1407.     SetTextStyle(SmallFont, HorizDir, 4);
  1408.     OutTextXY(522, 60, copyright);
  1409.  
  1410.     SetTextStyle(DefaultFont, HorizDir, 1);
  1411.     SetTextJustify(LeftText, TopText);
  1412.     OutTextXY(466, 75, 'Score:');
  1413.     OutTextXY(466, 87, 'Value:');
  1414.     OutTextXY(466, 99, 'Level:');
  1415.     OutTextXY(466, 111, ' Rows:');
  1416.    End; {-drawscorewin-}
  1417.  
  1418.   Procedure drawhelpwin;
  1419.    Begin
  1420.     SetColor(colornormal);
  1421.     SetFillStyle(SolidFill, colornormal);
  1422.     placewindow(35, 224, 201, 334);
  1423.     placewindow(439, 224, 605, 334);
  1424.  
  1425.     SetColor(colorhigh);
  1426.     SetTextStyle(DefaultFont, HorizDir, 1);
  1427.     OutTextXY(58, 246, keynames[binding, keyleft]);
  1428.     OutTextXY(58, 258, keynames[binding, keyrotateleft]);
  1429.     OutTextXY(58, 270, keynames[binding, keyrotateright]);
  1430.     OutTextXY(58, 282, keynames[binding, keyright]);
  1431.     OutTextXY(58, 294, keynames[binding, keydrop]);
  1432.     OutTextXY(58, 306, 'Esc');
  1433.     OutTextXY(462, 246, '^B');
  1434.     OutTextXY(462, 258, '^L');
  1435.     OutTextXY(462, 270, '^N');
  1436.     OutTextXY(462, 282, '^S');
  1437.     OutTextXY(462, 294, '^X');
  1438.     OutTextXY(462, 306, '^\');
  1439.  
  1440.     SetColor(colornormal);
  1441.     SetTextStyle(SmallFont, HorizDir, 4);
  1442.     OutTextXY(90, 243, 'move left');
  1443.     OutTextXY(90, 255, 'rotate left');
  1444.     OutTextXY(90, 267, 'rotate right');
  1445.     OutTextXY(90, 279, 'move right');
  1446.     OutTextXY(90, 291, 'drop');
  1447.     OutTextXY(90, 303, 'pause/quit');
  1448.     OutTextXY(494, 243, 'block style');
  1449.     OutTextXY(494, 255, 'change level');
  1450.     OutTextXY(494, 267, 'show next');
  1451.     OutTextXY(494, 279, 'toggle sound');
  1452.     OutTextXY(494, 291, 'extended shapes');
  1453.     OutTextXY(494, 303, 'quick exit')
  1454.    End; {-drawhelpwin-}
  1455.  
  1456.   Procedure refill;
  1457.  
  1458.    Var
  1459.     i, j      : integer;
  1460.  
  1461.    Begin {-refill-}
  1462.     For i := depth DownTo depth-(height-1) Do
  1463.      For j := 1 To blockcols Do
  1464.       If field[i, j] Then
  1465.        PutImage(colmin+(pixelsperblock*(j-1))+1,
  1466.         rowmin+(pixelsperblock*(i-1)), filler^, XORPut)
  1467.    End; {-refill-}
  1468.  
  1469.   Begin {-drawscreen-}
  1470.    ClearDevice;
  1471.    drawfieldwin;
  1472.    GetImage(colmin+1, rowmin, colmax-1, rowmin+pixelsperblock+1, emptyrow^);
  1473.    drawnextwin;
  1474.    drawscorewin;
  1475.    drawhelpwin;
  1476.    If height In [1..maxheight] Then
  1477.     refill;
  1478.  
  1479.    SetVisualPage(page);
  1480.    page := 1-page;
  1481.    SetActivePage(page);
  1482.  
  1483.    ClearDevice;
  1484.    drawfieldwin;
  1485.    drawnextwin;
  1486.    drawscorewin;
  1487.    drawhelpwin;
  1488.    If height In [1..maxheight] Then
  1489.     refill;
  1490.   End; {-drawscreen-}
  1491.  
  1492.  procedure cleanup;
  1493.   forward;
  1494.  
  1495.  Procedure play;
  1496.  
  1497.   Var
  1498.    dropped      : boolean;
  1499.    endgame      : boolean;
  1500.    shape      : byte;
  1501.    orient      : byte;
  1502.    row, col      : byte;
  1503.    color      : byte;
  1504.    style      : byte;
  1505.    ch          : word;
  1506.    k          : byte;
  1507.    t, tdelay      : longint;
  1508.  
  1509.    nextshape      : byte;
  1510.    nextcolor      : byte;
  1511.    nextstyle      : byte;
  1512.  
  1513.    xsize      : byte;
  1514.    xvalue      : integer;
  1515.  
  1516.    oldscore      : longint;
  1517.    oldxvalue      : integer;
  1518.    oldlevel      : byte;
  1519.    oldxshape      : byte;
  1520.    oldrowsclear   : word;
  1521.  
  1522.    i, j       : integer;
  1523.    r, c       : byte;
  1524.  
  1525. { procedure fake;
  1526.    var
  1527.     a, b, c, d      : pointer;
  1528.     i, j      : integer;
  1529.     z          : bufstr;
  1530.  
  1531.    begin
  1532.     i := imagesize(0, 0, getmaxx, getmaxy div 2);
  1533.     j := imagesize(0, (getmaxy div 2)+1, getmaxx, getmaxy);
  1534.     getmem(a, i); getmem(c, i);
  1535.     getmem(b, j); getmem(d, j);
  1536.     getimage(0, 0, getmaxx, getmaxy div 2, a^);
  1537.     getimage(0, (getmaxy div 2)+1, getmaxx, getmaxy, b^);
  1538.     setactivepage(1-page);
  1539.     getimage(0, 0, getmaxx, getmaxy div 2, c^);
  1540.     getimage(0, (getmaxy div 2)+1, getmaxx, getmaxy, d^);
  1541.     textmode(c80);
  1542.     repeat
  1543.      write('C:>');
  1544.      readln(z)
  1545.     until z = 'exit';
  1546.     dographics;
  1547.     SetTextStyle(SmallFont, HorizDir, 4);
  1548.     setvisualpage(page);
  1549.     setactivepage(1-page);
  1550.     putimage(0, 0, c^, normalput);
  1551.     putimage(0, (getmaxy div 2)+1, d^, normalput);
  1552.     setvisualpage(1-page);
  1553.     setactivepage(page);
  1554.     putimage(0, 0, a^, normalput);
  1555.     putimage(0, (getmaxy div 2)+1, b^, normalput);
  1556.     freemem(a, i); freemem(b, j); freemem(c, i); freemem(d, j)
  1557.    end; }
  1558.  
  1559.   Procedure scrolldown(rclr  : byte;
  1560.                var r : rinfotype);
  1561.  
  1562.    Var
  1563.     rz          : Array [1..clearlimit] Of integer;
  1564.     i, j      : integer;
  1565.  
  1566.    Begin {-scrolldown-}
  1567.     For i := 1 To rclr Do
  1568.      rz[i] := pixelsperblock*(r[i]-1);
  1569.  
  1570.     For i := 1 To rclr Do
  1571.      Begin
  1572.       GetImage(colmin+1, rowmin, colmax-1, rz[i], scrollptr^);
  1573.       PutImage(colmin+1, rowmin, emptyrow^, NormalPut);
  1574.       PutImage(colmin+1, rowmin+pixelsperblock, scrollptr^, NormalPut);
  1575.       if tones then
  1576.        begin
  1577.     Sound(cleartone);
  1578.     Delay(cleartonedelay);
  1579.     NoSound
  1580.        end;
  1581.       SetVisualPage(page);
  1582.       page := 1-page;
  1583.       SetActivePage(page);
  1584.       PutImage(colmin+1, rowmin, emptyrow^, NormalPut);
  1585.       PutImage(colmin+1, rowmin+pixelsperblock, scrollptr^, NormalPut)
  1586.      End
  1587.    End; {-scrolldown-}
  1588.  
  1589.   Procedure drawshape;
  1590.  
  1591.    Var
  1592.     i          : integer;
  1593.     x, y, x1, y1  : integer;
  1594.     p          : pointer;
  1595.  
  1596.    Begin {-drawshape-}
  1597.   { If showshadow Then
  1598.      FillChar(fieldshadows, SizeOf(fieldshadows), 0); }
  1599.     x := colmin+(pixelsperblock*(col-1))+1;
  1600.     y := rowmin+(pixelsperblock*(row-1));
  1601.     p := styletab[color, style];
  1602.  
  1603.     PutImage(x, y, p^, XORPut);
  1604.   { If showshadow Then
  1605.      Begin
  1606.       PutImage(x, rowmax+1, shadows^, XORPut);
  1607.       fieldshadows[col] := True
  1608.      End; }
  1609.     For i := 1 To xsize Do
  1610.      Begin
  1611.       x1 := x+xshapetab[shape, orient, i, 2];
  1612.       y1 := y+xshapetab[shape, orient, i, 1];
  1613.       If (y1 >= rowmin) Then
  1614.        PutImage(x1, y1, p^, XORPut);
  1615.     { If showshadow And Not fieldshadows[col+yshapetab[shape, orient, i, 2]]
  1616.       Then
  1617.        Begin
  1618.     PutImage(x1, rowmax+1, shadows^, XORPut);
  1619.     fieldshadows[col+yshapetab[shape, orient, i, 2]] := True
  1620.        End }
  1621.      End
  1622.    End; {-drawshape-}
  1623.  
  1624.   Procedure dispscore;
  1625.    Begin
  1626.     If oldscore <> score Then
  1627.      Begin
  1628.       SetColor(Black);
  1629.       Str(oldscore, buf);
  1630.       OutTextXY(522, 72, buf);
  1631.       SetColor(colorhigh);
  1632.       Str(score, buf);
  1633.       OutTextXY(522, 72, buf)
  1634.      End;
  1635.     If oldxvalue <> xvalue Then
  1636.      Begin
  1637.       SetColor(Black);
  1638.       Str(oldxvalue, buf);
  1639.       OutTextXY(522, 84, buf);
  1640.       SetColor(colorhigh);
  1641.       Str(xvalue, buf);
  1642.       OutTextXY(522, 84, buf)
  1643.      End;
  1644.     If (oldlevel <> level) Or (oldxshape <> xshape) Then
  1645.      Begin
  1646.       SetColor(Black);
  1647.       Str(oldlevel, buf);
  1648.       buf := buf+' '+xshapetitles[oldxshape];
  1649.       OutTextXY(522, 96, buf);
  1650.       SetColor(colorhigh);
  1651.       Str(level, buf);
  1652.       buf := buf+' '+xshapetitles[xshape];
  1653.       OutTextXY(522, 96, buf)
  1654.      End;
  1655.     If oldrowsclear <> rowsclear Then
  1656.      Begin
  1657.       SetColor(Black);
  1658.       Str(oldrowsclear, buf);
  1659.       OutTextXY(522, 108, buf);
  1660.       SetColor(colorhigh);
  1661.       Str(rowsclear, buf);
  1662.       OutTextXY(522, 108, buf)
  1663.      End
  1664.    End; {-dispscore-}
  1665.  
  1666.   Function chk : boolean;
  1667.  
  1668.    Var
  1669.     f          : boolean;
  1670.     x, y, r      : shortint;
  1671.     i          : integer;
  1672.  
  1673.    Begin {-chk-}
  1674.     r := row+1;
  1675.  
  1676.     f := field[r, col];
  1677.     For i := 1 To xsize Do
  1678.      Begin
  1679.       y := r+yshapetab[shape, orient, i, 1];
  1680.       x := col+yshapetab[shape, orient, i, 2];
  1681.       If ((y >= 1) And (y <= depth+1)) And ((x >= 1) And (x <= blockcols))
  1682.       Then
  1683.        f := f Or field[y, x]
  1684.      End;
  1685.  
  1686.     chk := f
  1687.    End; {-chk-}
  1688.  
  1689.   Procedure chkmv(c : shortint);
  1690.  
  1691.    Var
  1692.     f1, f2      : boolean;
  1693.     x, y      : shortint;
  1694.     i          : integer;
  1695.     xcol      : shortint;
  1696.  
  1697.    Begin {-chkmv-}
  1698.     Inc(c, col);
  1699.  
  1700.     f1 := (c >= 1) And (c <= blockcols);
  1701.     If f1 Then
  1702.      f2 := field[row, c]
  1703.     Else
  1704.      f2 := True;
  1705.     For i := 1 To xsize Do
  1706.      Begin
  1707.       x  := c+yshapetab[shape, orient, i, 2];
  1708.       y  := row+yshapetab[shape, orient, i, 1];
  1709.       f1 := f1 And ((x >= 1) And (x <= blockcols));
  1710.       If f1 And ((y >= 1) And (y <= depth)) Then
  1711.        f2 := f2 Or field[y, x]
  1712.      End;
  1713.  
  1714.     If f1 And (Not f2) Then
  1715.      Begin
  1716.       xcol := col;
  1717.       col := c;
  1718.       drawshape;
  1719.       SetVisualPage(page);
  1720.       page := 1-page;
  1721.       SetActivePage(page);
  1722.       col := xcol;
  1723.       drawshape;
  1724.       col := c
  1725.      End
  1726.    End; {-chkmv-}
  1727.  
  1728.   Procedure chkrot(o : byte);
  1729.  
  1730.    Var
  1731.     f1, f2     : boolean;
  1732.     xorient    : byte;
  1733.     x, y       : shortint;
  1734.     i           : integer;
  1735.     f           : Text;
  1736.  
  1737.    Begin {-chkrot-}
  1738.     f1 := True;
  1739.     f2 := False;
  1740.  
  1741.     For i := 1 To xsize Do
  1742.      Begin
  1743.       y  := row+yshapetab[shape, o, i, 1];
  1744.       x  := col+yshapetab[shape, o, i, 2];
  1745.       f1 := f1 And ((x >= 1) And (x <= blockcols)) And
  1746.            (y <= depth);
  1747.       If f1 And (y >= 1) Then
  1748.        f2 := f2 Or field[y, x]
  1749.      End;
  1750.  
  1751.     If f1 And (Not f2) Then
  1752.      Begin
  1753.       xorient := orient;
  1754.       orient := o;
  1755.       drawshape;
  1756.       SetVisualPage(page);
  1757.       page := 1-page;
  1758.       SetActivePage(page);
  1759.       orient := xorient;
  1760.       drawshape;
  1761.       orient := o
  1762.      End
  1763.    End; {-chkrot-}
  1764.  
  1765.   Procedure dropshape;
  1766.  
  1767.    Var
  1768.     oldrow, xrow  : byte;
  1769.  
  1770.    Begin {-dropshape-}
  1771.     oldrow := row;
  1772.  
  1773.     While Not chk Do
  1774.      Inc(row);
  1775.     drawshape;
  1776.     SetVisualPage(page);
  1777.     page := 1-page;
  1778.     SetActivePage(page);
  1779.     xrow := row;
  1780.     row := oldrow;
  1781.     drawshape;
  1782.     row := xrow;
  1783.  
  1784.     inc(score, level*oldrow+bonus);
  1785.   { Inc(score, level*(row-oldrow)+bonus); }
  1786.     dropped := True
  1787.    End; {-dropshape-}
  1788.  
  1789.   Procedure chkrows;
  1790.  
  1791.    Var
  1792.     f : boolean; i : integer;
  1793.     rows       : byte;
  1794.     r           : byte;
  1795.     rinfo      : rinfotype;
  1796.  
  1797.    Function chkrow(r : byte) : boolean;
  1798.  
  1799.     Var
  1800.      f           : boolean;
  1801.      i, j      : integer;
  1802.  
  1803.     Begin {-chkrow-}
  1804.      f := False;
  1805.      If r < depth+1 Then
  1806.       Begin
  1807.        f := field[r, 1];
  1808.        i := 2;
  1809.        While f And (i <= blockcols) Do
  1810.     Begin
  1811.      f := f And field[r, i];
  1812.      Inc(i)
  1813.     End;
  1814.  
  1815.        If f Then
  1816.     Begin
  1817.      Inc(rowsclear);
  1818.      If (level < maxlevel) And (rowsclear = advancetab[level]) Then
  1819.       Begin
  1820.        Inc(level);
  1821.        tdelay := timedelaytab[level]
  1822.       End;
  1823.      Move(field[0, 1], field[1, 1], blockcols*r);
  1824.      Inc(score, level*bonusrowclear+bonus)
  1825.     End
  1826.       End;
  1827.      chkrow := f
  1828.     End; {-chkrow-}
  1829.  
  1830.    Begin {-chkrows-}
  1831.     rows := 0;
  1832.     For r := row-2 To row+2 Do
  1833.      If chkrow(r) Then
  1834.       Begin
  1835.        Inc(rows);
  1836.        rinfo[rows] := r
  1837.       End;
  1838.  
  1839.     If rows > 0 Then
  1840.      Begin
  1841.       scrolldown(rows, rinfo);
  1842.       If rows > 1 Then
  1843.        Inc(score, level*((rows-1)*bonusmultclear)+bonus);
  1844.       f := false;
  1845.       I := 1;
  1846.       while (not f) and (i <= blockcols) do
  1847.        begin
  1848.     f := f or field[depth, i];
  1849.     inc(i);
  1850.        end;
  1851.       if not f then
  1852.        inc(score, level*bonusempty+bonus);
  1853.      End
  1854.    End; {-chkrows-}
  1855.  
  1856.   Procedure gameover;
  1857.  
  1858.    Var
  1859.     i, x, y, p      : integer;
  1860.     f          : boolean;
  1861.  
  1862.    Begin {-gameover-}
  1863.     f := True;
  1864.     For y := 1 To depth Do
  1865.      For p := 1 To 2 Do
  1866.       Begin
  1867.        For x := 1 To blockcols Do
  1868.     Begin
  1869.      If Not field[y, x] Then
  1870.        PutImage(colmin+(pixelsperblock*(x-1))+1,
  1871.            rowmin+(pixelsperblock*(y-1)),
  1872.            curtain[f]^, NormalPut);
  1873.      f := Not f
  1874.     End;
  1875.        SetVisualPage(page);
  1876.        page := 1-page;
  1877.        SetActivePage(page);
  1878.        If Not KeyPressed Then
  1879.     Delay(dropdelay)
  1880.       End;
  1881.  
  1882.     setcolor(0);
  1883.     setfillstyle(solidfill, 0);
  1884.     bar(colmin+1, rowmin, colmax-1, rowmin+pixelsperblock);
  1885.     SetColor(colorhigh);
  1886.     SetTextStyle(DefaultFont, HorizDir, 1);
  1887.     SetTextJustify(CenterText, TopText);
  1888.     OutTextXY(320, rowmin+4, 'Game Over');
  1889.  
  1890.     i := 1;
  1891.     Repeat
  1892.      SetVisualPage(page);
  1893.      page := 1-page;
  1894.      SetActivePage(page);
  1895.      Delay(i*dropdelay);
  1896.      Inc(i)
  1897.     Until (i > 25) Or (Not Odd(i) And KeyPressed);
  1898.  
  1899.     While KeyPressed Do
  1900.      ch := getkey
  1901.    End; {-gameover-}
  1902.  
  1903.   Begin {-play-}
  1904.    initlevel := level;
  1905.    endgame   := False;
  1906.    nextshape := Random(shapemap)+1;
  1907.    nextcolor := Random(ncolors)+1;
  1908.    nextstyle := Random(nstyles)+1;
  1909.    xvalue    := 0;
  1910.    tdelay    := timedelaytab[level];
  1911.  
  1912.    oldscore    := 255;
  1913.    oldlevel    := 255;
  1914.    oldxvalue    := 0;
  1915.    oldxshape    := (xshape+1) Mod xshapelevels;
  1916.    oldrowsclear := 65535;
  1917.  
  1918.  { dispscore;
  1919.    SetVisualPage(page);
  1920.    page := 1-page;
  1921.    SetActivePage(page);
  1922.    dispscore;
  1923.    oldscore    := 0;
  1924.    oldlevel    := level;
  1925.    oldxvalue    := xvalue;
  1926.    oldxshape    := xshape;
  1927.    oldrowsclear := 0; }
  1928.  
  1929.    If shownext Then
  1930.     putshape(111, 54, nextshape, styletab[nextcolor, nextstyle]);
  1931.    SetVisualPage(page);
  1932.    page := 1-page;
  1933.    SetActivePage(page);
  1934.    If shownext Then
  1935.     putshape(111, 54, nextshape, styletab[nextcolor, nextstyle]);
  1936.  
  1937.    Repeat
  1938.     Inc(score, xvalue);
  1939.     shape   := nextshape;
  1940.     orient  := 0;
  1941.     row     := initrow;
  1942.     col     := initcol;
  1943.     color   := nextcolor;
  1944.     style   := nextstyle;
  1945.     dropped := False;
  1946.     xsize   := shapetab[shape, info, 1];
  1947.     xvalue  := level*shapetab[shape, info, 2]+bonus;
  1948.     nextshape := Random(shapemap)+1;
  1949.     nextcolor := Random(ncolors)+1;
  1950.     nextstyle := Random(nstyles)+1;
  1951.  
  1952.     drawshape;
  1953.     dispscore;
  1954.     If shownext Then
  1955.      Begin
  1956.       putshape(111, 54, shape, styletab[color, style]);
  1957.       putshape(111, 54, nextshape, styletab[nextcolor, nextstyle])
  1958.      End;
  1959.     SetVisualPage(page);
  1960.     page := 1-page;
  1961.     SetActivePage(page);
  1962.     dispscore;
  1963.     If shownext Then
  1964.      Begin
  1965.       putshape(111, 54, shape, styletab[color, style]);
  1966.       putshape(111, 54, nextshape, styletab[nextcolor, nextstyle])
  1967.      End;
  1968.     oldscore     := score;
  1969.     oldxvalue     := xvalue;
  1970.     oldlevel     := level;
  1971.     oldxshape     := xshape;
  1972.     oldrowsclear := rowsclear;
  1973.  
  1974.     t := gettimer+tdelay;
  1975.     Repeat Until (gettimer > t);
  1976.     While KeyPressed Do
  1977.      ch := getkey;
  1978.  
  1979.     If chk Then
  1980.      endgame := True
  1981.     Else
  1982.      Begin
  1983.       Repeat
  1984.        Inc(row);
  1985.        drawshape;
  1986.        SetVisualPage(page);
  1987.        page := 1-page;
  1988.        SetActivePage(page);
  1989.        Dec(row);
  1990.        drawshape;
  1991.        Inc(row);
  1992.  
  1993.        t := gettimer+tdelay;
  1994.        Repeat
  1995.     Repeat Until KeyPressed Or (gettimer > t);
  1996.     If KeyPressed Then
  1997.      Begin
  1998.       ch := getkey;
  1999.       if lo(ch) < 29 then
  2000.        case hi(ch) of
  2001.  { Esc }     1: begin
  2002.        { 1, 68: Begin
  2003.              if hi(ch) = 68 then
  2004.               fake; }
  2005.              Repeat Until KeyPressed;
  2006.              ch := getkey;
  2007.              If chr(lo(ch)) = #27 Then
  2008.               Begin
  2009.                dropshape;
  2010.                endgame := True
  2011.               End
  2012.             End;
  2013.  { ^W }       { 17: Begin
  2014.              showshadow := Not showshadow;
  2015.              drawshape;
  2016.              SetVisualPage(page);
  2017.              page := 1-page;
  2018.              SetActivePage(page);
  2019.              showshadow := Not showshadow;
  2020.              drawshape;
  2021.              showshadow := Not showshadow;
  2022.              If showshadow Then
  2023.               Dec(bonus, bonusshadow)
  2024.              Else
  2025.               Inc(bonus, bonusshadow);
  2026.              While KeyPressed Do
  2027.               ch := getkey
  2028.             End; }
  2029.  { ^S }     31: tones := not tones;
  2030.  { ^L }     38, 47: Begin
  2031.              level := (level Mod maxlevel)+1;
  2032.              tdelay := timedelaytab[level];
  2033.              drawshape;
  2034.              dispscore;
  2035.              SetVisualPage(page);
  2036.              page := 1-page;
  2037.              SetActivePage(page);
  2038.              drawshape;
  2039.              dispscore;
  2040.              oldlevel := level;
  2041.              While KeyPressed Do
  2042.               ch := getKey
  2043.             End;
  2044.  { ^\ }     43: begin
  2045.              cleanup;
  2046.              halt
  2047.             end;
  2048.  { ^X }     45: Begin
  2049.              xshape := (xshape Mod xshapelevels)+1;
  2050.              Case xshape Of
  2051.               1: shapemap := xshapeclassic;
  2052.               2: shapemap := xshapeeasy;
  2053.               3: shapemap := xshapemedium;
  2054.               4: shapemap := xshapehard
  2055.              End;
  2056.              drawshape;
  2057.              dispscore;
  2058.              SetVisualPage(page);
  2059.              page := 1-page;
  2060.              SetActivePage(page);
  2061.              drawshape;
  2062.              dispscore;
  2063.              oldxshape := xshape;
  2064.              While KeyPressed Do
  2065.               ch := getkey
  2066.             End;
  2067.  { ^B }     48: Begin
  2068.              i := styleblocks;
  2069.              If shownext Then
  2070.               putshape(111, 54, nextshape,
  2071.                    styletab[nextcolor, nextstyle]);
  2072.              styleblocks := (styleblocks Mod nstyletabs)+1;
  2073.              Move(xstyletabs[styleblocks], styletab,
  2074.               SizeOf(styletab));
  2075.              drawshape;
  2076.              If shownext Then
  2077.               putshape(111, 54, nextshape,
  2078.                    styletab[nextcolor, nextstyle]);
  2079.              SetVisualPage(page);
  2080.              page := 1-page;
  2081.              SetActivePage(page);
  2082.              Move(xstyletabs[i], styletab,
  2083.               SizeOf(styletab));
  2084.              drawshape;
  2085.              If shownext Then
  2086.               putshape(111, 54, nextshape,
  2087.                    styletab[nextcolor, nextstyle]);
  2088.              Move(xstyletabs[styleblocks], styletab,
  2089.               SizeOf(styletab));
  2090.              If shownext Then
  2091.               putshape(111, 54, nextshape,
  2092.                    styletab[nextcolor, nextstyle]);
  2093.              While KeyPressed Do
  2094.               ch := getkey
  2095.             End;
  2096.  { ^G }       { 34: begin
  2097.              showguide := not showguide;
  2098.              if showguide then
  2099.               begin
  2100.                dec(bonus, bonusguide);
  2101.                drawshape;
  2102.                drawguide(colornormal);
  2103.                SetVisualPage(page);
  2104.                page := 1-page;
  2105.                SetActivePage(page);
  2106.                drawshape;
  2107.                drawguide(colornormal);
  2108.               end
  2109.              else begin
  2110.               inc(bonus, bonusguide);
  2111.               drawshape;
  2112.               drawguide(0);
  2113.               SetVisualPage(page);
  2114.               page := 1-page;
  2115.               SetActivePage(page);
  2116.               drawshape;
  2117.               drawguide(0);
  2118.              end;
  2119.             end; }
  2120.  { ^N }     49: Begin
  2121.              shownext := Not shownext;
  2122.              If shownext Then
  2123.               Dec(bonus, bonusnext)
  2124.              Else
  2125.               Inc(bonus, bonusnext);
  2126.              putshape(111, 54, nextshape,
  2127.                   styletab[nextcolor, nextstyle]);
  2128.              drawshape;
  2129.              SetVisualPage(page);
  2130.              page := 1-page;
  2131.              SetActivePage(page);
  2132.              putshape(111, 54, nextshape,
  2133.                   styletab[nextcolor, nextstyle]);
  2134.              drawshape;
  2135.              While KeyPressed Do
  2136.               ch := getkey
  2137.             End
  2138.        end
  2139.       else
  2140.        begin
  2141.         k := 1;
  2142.         while (hi(ch) <> keybinding[k]) and (k <= nkeys) do
  2143.          inc(k);
  2144.         if k <= nkeys then
  2145.          case k of
  2146.              keydrop: dropshape;
  2147.              keyleft: chkmv(left);
  2148.             keyright: chkmv(right);
  2149.           keyrotateright: chkrot((orient+1) Mod (norients+1));
  2150.            keyrotateleft: chkrot((norients+orient) Mod (norients+1))
  2151.          end
  2152.         end;
  2153.      end;
  2154.        Until dropped Or (gettimer > t);
  2155.       Until dropped Or chk;
  2156.  
  2157.       drawshape;
  2158.  
  2159.       field[row, col] := True;
  2160.       For i := 1 To xsize Do
  2161.        field[row+yshapetab[shape, orient, i, 1],
  2162.          col+yshapetab[shape, orient, i, 2]] := True;
  2163.  
  2164.       chkrows;
  2165.  
  2166.       t := gettimer+(tdelay Shr 1);
  2167.       Repeat Until (gettimer > t);
  2168.       While KeyPressed Do
  2169.        ch := getkey
  2170.      End;
  2171.    Until endgame;
  2172.  
  2173.    dispscore;
  2174.    SetVisualPage(page);
  2175.    page := 1-page;
  2176.    SetActivePage(page);
  2177.    dispscore;
  2178.    oldscore    := score;
  2179.    oldxvalue    := xvalue;
  2180.    oldlevel    := level;
  2181.    oldxshape    := xshape;
  2182.    oldrowsclear := rowsclear;
  2183.  
  2184.    While KeyPressed Do
  2185.     ch := getkey;
  2186.    gameover;
  2187.  
  2188.    Repeat Until KeyPressed;
  2189.    While KeyPressed Do
  2190.     ch := getkey
  2191.   End;
  2192.  
  2193.  Procedure postgame;
  2194.  
  2195.   Var
  2196.    ch          : word;
  2197.    today      : DateTime;
  2198.    i, j       : word;
  2199.    rank, x, s      : integer;
  2200.  
  2201.   Begin
  2202.    rank := 0;
  2203.  
  2204.    If rowsclear > 0 Then
  2205.     Begin
  2206.      i      := 1;
  2207.      While (i <= nhiscores) And (hiscore[i].score >= score) Do
  2208.       Inc(i);
  2209.      If i <= nhiscores Then
  2210.       Begin
  2211.        rank := i;
  2212.        For j := nhiscores-1 DownTo i Do
  2213.     hiscore[j+1] := hiscore[j];
  2214.        hiscore[i].score     := score;
  2215.        hiscore[i].level     := level;
  2216.        hiscore[i].rowsclear := rowsclear;
  2217.  
  2218.        GetTime(today.hour, today.min, today.sec, j);
  2219.        GetDate(today.year, today.month, today.day, j);
  2220.        Dec(today.year, 1900);
  2221.        Str(today.month:2, hiscore[i].date);
  2222.        Str(today.day:2, buf);
  2223.        hiscore[i].date := hiscore[i].date+'/'+buf;
  2224.        Str(today.year:2, buf);
  2225.        hiscore[i].date := hiscore[i].date+'/'+buf;
  2226.        fillzero(hiscore[i].date);
  2227.        Str(today.hour:2, hiscore[i].time);
  2228.        Str(today.min:2, buf);
  2229.        hiscore[i].time := hiscore[i].time+':'+buf;
  2230.        Str(today.sec:2, buf);
  2231.        hiscore[i].time := hiscore[i].time+':'+buf;
  2232.        fillzero(hiscore[i].time);
  2233.        hiscore[i].version := version;
  2234.  
  2235.        ClearDevice;
  2236.  
  2237.        SetTextJustify(CenterText, TopText);
  2238.        SetTextStyle(SansSerifFont, HorizDir, 4);
  2239.        SetColor(colorhigh);
  2240.        OutTextXY(320, 5, 'Congratulations!');
  2241.  
  2242.        SetTextStyle(DefaultFont, HorizDir, 1);
  2243.        SetColor(colornormal);
  2244.        OutTextXY(320, 46, 'You''ve made it into the Glorious Fifteen;');
  2245.        OutTextXY(320, 58, 'please enter your name for posterity:');
  2246.  
  2247.        SetColor(colornormal);
  2248.        placewindow(214, 155, 426, 195);
  2249.  
  2250.        SetVisualPage(page);
  2251.        page := 1-page;
  2252.  
  2253.        SetTextStyle(SmallFont, HorizDir, 4);
  2254.        x := 1;
  2255.        Repeat
  2256.     SetColor(colorhigh);
  2257.     OutTextXY(224+6*(x-1), 171, '_');
  2258.     Repeat Until KeyPressed;
  2259.     ch := getkey;
  2260.     Case lo(ch) Of
  2261.        0: While KeyPressed Do
  2262.            ch := getkey;
  2263.        8: If x > 1 Then
  2264.            Begin
  2265.         SetColor(Black);
  2266.         OutTextXY(224+6*(x-1), 171, '_');
  2267.         Dec(x);
  2268.         OutTextXY(224+6*(x-1), 171, hiscore[i].name[x])
  2269.            End;
  2270.       13: hiscore[i].name[0] := Chr(x-1);
  2271.       27: If x > 1 Then
  2272.            Begin
  2273.         SetColor(Black);
  2274.         OutTextXY(224+6*(x-1), 171, '_');
  2275.         For s := x DownTo 1 Do
  2276.          OutTextXY(224+6*(s-1), 171, hiscore[i].name[s]);
  2277.         x := 1
  2278.            End;
  2279.      Else If x < SizeOf(bufstr) Then
  2280.            Begin
  2281.         SetColor(Black);
  2282.         OutTextXY(224+6*(x-1), 171, '_');
  2283.         SetColor(colorhigh);
  2284.         OutTextXY(224+6*(x-1), 171, chr(lo(ch)));
  2285.         hiscore[i].name[x] := chr(lo(ch));
  2286.         Inc(x)
  2287.            End
  2288.     End
  2289.        Until (lo(ch) = 13) or (x > SizeOf(bufstr))
  2290.       End
  2291.     End;
  2292.  
  2293.    SetActivePage(page);
  2294.    ClearDevice;
  2295.  
  2296.    SetTextStyle(SansSerifFont, HorizDir, 4);
  2297.    SetTextJustify(CenterText, TopText);
  2298.    SetColor(colorhigh);
  2299.    OutTextXY(320, 5, 'The Glorious Fifteen');
  2300.  
  2301.    SetColor(colornormal);
  2302.    SetFillStyle(SolidFill, colornormal);
  2303.    placewindow(16, 50, 615, 256);
  2304.  
  2305.    SetTextStyle(DefaultFont, HorizDir, 1);
  2306.    SetTextJustify(LeftText, TopText);
  2307.    SetColor(colorhigh);
  2308.    OutTextXY(24, 60, 'Rank  Score  Level Rows   Date     Time   Name');
  2309.  
  2310.    SetColor(colornormal);
  2311.    SetTextStyle(SmallFont, HorizDir, 4);
  2312.    For i := 1 To nhiscores Do
  2313.     Begin
  2314.      If rank = i Then
  2315.       SetColor(colorhigh);
  2316.      SetTextJustify(CenterText, TopText);
  2317.      Str(i:2, buf);
  2318.      OutTextXY(40, 72+12*(i-1), buf);
  2319.      If hiscore[i].score <> 0 Then
  2320.       Begin
  2321.        Str(hiscore[i].score:7, buf);
  2322.        OutTextXY(92, 72+12*(i-1), buf);
  2323.        Str(hiscore[i].level:2, buf);
  2324.        OutTextXY(148, 72+12*(i-1), buf);
  2325.        Str(hiscore[i].rowsclear:4, buf);
  2326.        OutTextXY(192, 72+12*(i-1), buf);
  2327.        OutTextXY(248, 72+12*(i-1), hiscore[i].date);
  2328.        OutTextXY(320, 72+12*(i-1), hiscore[i].time);
  2329.        SetTextJustify(LeftText, TopText);
  2330.        OutTextXY(360, 72+12*(i-1), hiscore[i].name);
  2331.        OutTextXY(563, 72+12*(i-1), hiscore[i].version)
  2332.       End;
  2333.      If rank = i Then
  2334.       SetColor(colornormal)
  2335.     End;
  2336.  
  2337.    SetTextStyle(DefaultFont, HorizDir, 1);
  2338.    SetTextJustify(CenterText, TopText);
  2339.    SetColor(colornormal);
  2340.    OutTextXY(320, 300, 'Press Y to try again or N to exit.');
  2341.  
  2342.    SetVisualPage(page);
  2343.    page := 1-page;
  2344.    SetActivePage(page);
  2345.    ClearDevice;
  2346.  
  2347.    Repeat
  2348.     Repeat Until KeyPressed;
  2349.     ch := getkey;
  2350.    Until (hi(ch) In [21, 49]);
  2351.  
  2352.    endrun := hi(ch) = 49
  2353.   End;
  2354.  
  2355. { 12345678901234567890123456789012345678901234567890123456789012345678901234
  2356.   rank    score  level rows   date     time   name'
  2357.    00  0000000     00  0000 00/00/00 00:00:00 12345678901234567890123456789012
  2358. }
  2359.  
  2360.  Procedure cleanup;
  2361.  
  2362.   Var
  2363.    i          : integer;
  2364.  
  2365.   Procedure configflag(f : boolean);
  2366.    Begin
  2367.     If f Then
  2368.      WriteLn(fconfig, 'Yes')
  2369.     Else
  2370.      WriteLn(fconfig, 'No')
  2371.    End; {-configflag-}
  2372.  
  2373.   Begin {-cleanup-}
  2374.    dotext;
  2375.  
  2376.    Assign(fhiscore, hiscorename);
  2377.    filemode := 2;
  2378.    Rewrite(fhiscore);
  2379.    if ioresult = 0 then
  2380.     begin
  2381.      i := 1;
  2382.      While (i <= nhiscores) And (hiscore[i].score > 0) Do
  2383.       Begin
  2384.        Write(fhiscore, hiscore[i]);
  2385.        Inc(i)
  2386.       End;
  2387.      Close(fhiscore)
  2388.     end;
  2389.  
  2390.    Assign(fconfig, configname);
  2391.    filemode := 2;
  2392.    Rewrite(fconfig);
  2393.    if ioresult = 0 then
  2394.     begin
  2395.      WriteLn(fconfig, '# ', id, '':1, version, ' configuration file');
  2396.    { WriteLn(fconfig, '# ', copyright); }
  2397.      Write(fconfig, 'display=');
  2398.      Case display Of
  2399.       bw    : writeln(fconfig, 'BW');
  2400.       color : WriteLn(fconfig, 'Color');
  2401.       mono  : WriteLn(fconfig, 'Mono');
  2402.       plasma: WriteLn(fconfig, 'Plasma')
  2403.      End;
  2404.      writeln(fconfig, 'depth=', depth);
  2405.      WriteLn(fconfig, 'height=', height);
  2406.      WriteLn(fconfig, 'level=', initlevel);
  2407.      Write(fconfig, 'shownext=');
  2408.      configflag(shownext);
  2409.      write(fconfig, 'showguide=');
  2410.      configflag(showguide);
  2411.    { Write(fconfig, 'showshadow=');
  2412.      configflag(showshadow); }
  2413.      Write(fconfig, 'sound=');
  2414.      configflag(tones);
  2415.      WriteLn(fconfig, 'styleblocks=', styleblocktitles[styleblocks]);
  2416.      Write(fconfig, 'title=');
  2417.      configflag(title);
  2418.      Write(fconfig, 'tournament=');
  2419.      configflag(tournament);
  2420.      WriteLn(fconfig, 'tournamentgame=', tournamentgame);
  2421.      WriteLn(fconfig, 'xshape=', xshapetitles[xshape]);
  2422.  
  2423.      write(fconfig, 'palette=');
  2424.      for i := 0 to palettesiz-2 do
  2425.       write(fconfig, userpalette.colors[i], ',');
  2426.      writeln(fconfig, userpalette.colors[palettesiz-1]);
  2427.  
  2428.      write(fconfig, 'keybinding=');
  2429.      if binding <> nkeybindings then
  2430.       writeln(fconfig, keybindingtitles[binding])
  2431.      else
  2432.       begin
  2433.        for i := 1 to nkeys-1 do
  2434.     write(fconfig, keybinding[i], ',');
  2435.        writeln(fconfig, keybinding[nkeys]);
  2436.       end;
  2437.  
  2438.      Close(fconfig)
  2439.     end;
  2440.    numlock(false)
  2441.   End; {-cleanup-}
  2442.  
  2443.  Begin
  2444.   init;
  2445.   drawtitle;
  2446.   Repeat
  2447.    initgame;
  2448.    If Not endrun Then
  2449.     Begin
  2450.      drawscreen;
  2451.      play;
  2452.      postgame
  2453.     End;
  2454.   Until endrun;
  2455.   cleanup
  2456.  End.
  2457.  
  2458.