PC World 2003 February/PCWorld_2003-02_cd.bin/Software/Topware/devpascal/examples/Tetris/fpctris.pp

Text File | 2000-09-13 | 25.0 KB | 860 lines

{
    $Id: fpctris.pp,v 1.1 2000/03/09 02:40:03 alex Exp $

    This program is both available in XTDFPC as in the FPC demoes.
    Copyright (C) 1999 by Marco van de Voort

    FPCTris implements a simple Crt driven Tetrisish game to demonstrate the
    Crt unit. (KeyPressed, ReadKey, GotoXY, Delay,TextColor,TextBackground)
    Quality games cost money, so that's why this one is free.

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}

PROGRAM FPCTris;
{$LONGSTRINGS OFF}

{ Trying to make a tetris from zero as a demo for FPC.
  Problems: - Colorsupport is a hack which handicaps creating a better
               update mechanism. (is done now)
            - Graph version input command has no cursor.
            - Graph or text isn't decided runtime, but compilertime.
            - Linux status graph version unknown at this moment.
            - Graphic and textmode speed of the game is not the same.
               The delay is fixed, and the time required to update is
               not constant due to optimisations.

  Coordinate system:

   0  ->   TheWidth-1            A figure is coded in a LONGINT like this:
   ---------
0 |   *     |                    ..*.            00100000    MSB
| |   **    |                    ..*.            00100000
V |   *     |                    .**.            01100000
  |         |                    ....            00000000    LSB
  |+   ++ ++|
  |++ ++++++|                  so  00100000001000000110000000000000b
  |+++++++++|
   ---------
TheHeight-1

}

Uses Crt,Dos,
{$IFDEF UseGraphics}
 Graph,
{$ENDIF}
 GameUnit;

{$DEFINE DoubleCache}

CONST TheWidth  = 11; {Watch out, also correct RowMask!}
      TheHeight = 20;
{$IFNDEF UseGraphics}
      PosXField = 10; { Upper X,Y coordinates of playfield}
      PosYField = 3;
{$ENDIF}
      MaxFigures= 16; {Maximum # figures place is reserved for.}
      NrLevels  = 12; {Number of levels currenty defined}
{      FieldSpace= 177;}

{$IFDEF UseGraphics}
      DisplGrX=110;
      DisplGrY=90;
      DisplGrScale=16;
      HelpY=130;
{$ENDIF}

      {$IFDEF UseGraphics}
       BaseX     =300;   {Coordinates of highscores}
       BaseY     =HelpY+20+8*LineDistY;  {y coordinate relative to other options}
      {$ELSE}
       BaseX     =40;
       BaseY     =9;
      {$ENDIF}

TYPE TetrisFieldType = ARRAY [0..25] OF LONGINT;
     LevelInfoType   = ARRAY [0..NrLevels-1] OF LONGINT;
     FigureType      = LONGINT;    { actually array[0..4][0..4] of bit rounded up to a longint}
{     CHARSET         = SET OF CHAR;}

{The figures, are converted to binary bitmaps on startup.}

CONST GraphFigures : ARRAY[0..4] OF String[80] =(
'.*... .*... .*... ..*.. .*... .*... **... **... ..**. .**.. ..*.. *....',
'.*... .*... .**.. .**.. .*... .**.. **... .*... ..*.. .**.. ..*.. **...',
'**... .**.. ..*.. .*... .*... .*... ..... .*... ..*.. .**.. **.** .**..',
'..... ..... ..... ..... .*... ..... ..... .***. ***.. .**.. ..*.. ..**.',
'..... ..... ..... ..... ..... ..... ..... ..... ..... .**.. ..*.. .....');

{Their relative occurance : }

      FigureChance : ARRAY[0..MaxFigures-1] OF LONGINT =(
  8,     8,    8,    8,     8,   8,   10,    1,   1,     1,    1,    1,0,0,0,0 );

{Scores per figure. Not necessarily used. Just for future use}

      FigureScore  : ARRAY[0..MaxFigures-1] OF LONGINT =(
  2,     2,    4,    4,     1,   2,    2,   10,  10,    10,   20,   10,0,0,0,0 );

{Diverse AND/OR masks to manipulate graphics}

{general table to mask out a bit 31=msb 0=lsb}
 AndTable : ARRAY[0..31] OF LONGINT=($80000000,$40000000,$20000000,$10000000,
    $8000000,$4000000,$2000000,$1000000,$800000,$400000,$200000,$100000,
    $80000,$40000,$20000,$10000,$8000,$4000,$2000,$1000,$800,$400,$200,$100,
    $80,$40,$20,$10,8,4,2,1);

{Mask to isolate a row of a (FigureType)}

 MagicMasks : ARRAY[0..4] OF LONGINT = ($F8000000,$07C00000,$003E0000,$0001F000,$00000F80);

{Mask to check if a line is full; a bit for every column aligned to left.}
 RowMask    = $FFE00000;

{Masks to calculate if the left or rightside is partially empty, write them
in binary, and put 5 bits on a row. }

 LeftMask : ARRAY[0..4] OF LONGINT = ($84210800,$C6318C00,$E739CE00,$F7BDEF00,$FFFFFFE0);
 RightMask: ARRAY[0..4] OF LONGINT = ($08421080,$18C63180,$39CE7380,$7BDEF780,$FFFFFF80);

{Allowed characters entering highscores}

{This constant/parameter is used to detect a certain bug. The bug was fixed, but
I use the constant to remind where the bug was, and what is related to eachother.}

   Tune=-1;

{First array is a table to find the level for a given number of dissappeared lines
 the second and third are the delaytime and iterationlevel per level.  }

  LevelBorders  : LevelInfoType = ( 10, 20, 30, 45, 60, 80,100,130,160,200,240,280);
  DelayLevel    : LevelInfoType = (100, 90, 80, 70, 60, 60, 50, 40, 40, 20, 20,10);
  IterationLevel: LevelInfoType = (  5,  5,  5,  5,  5,  4,  4,  4,  3,  3,  2, 2);

{Some frequently used chars in high-ascii and low-ascii. UseColor selects between
them}
  ColorString = #196#179#192#217#219;
  DumbTermStr = '-|..*';

{ A multiplication factor to reward killing more then one line with one figure}

  ProgressiveFactor :  ARRAY[1..5] OF LONGINT = (10,12,16,22,30);

VAR
    TopX,TopY   : LONGINT;                      {Coordinates figure relative
                                                  to left top of playfield}
    FigureNr    : LONGINT;                      {Nr in Figure cache, second
                                                  index in Figures}
    {$IFDEF DoubleCache}
    BackField,                                  {Copy of the screen for faster matching}
    {$ENDIF}
    MainField   : TetrisFieldType;              {The screen grid}
    ColorField  : ARRAY[0..TheHeight-1,0..TheWidth-1] OF LONGINT; {The color info}
    DelayTime   : LONGINT;                      {Delay time, can be used for
                                                  implementing levels}
    IterationPerDelay : LONGINT;                {Iterations of mainloop (incl delay)
                                                 before the piece falls down a row}
    TotalChance : LONGINT;                      {Sum of FigureChange array}
    Lines       : LONGINT;                      {Completed lines}
    NrFigures   : LONGINT;                      {# Figures currently used}
    RightSizeArray,                             {Nunber of empty columns to the left }
    LeftSizeArray,                              {or right of the figure/piece}
    Figures     : ARRAY[0..MaxFigures-1,0..3] OF LONGINT; {All bitmap info of figures}

    NrFiguresLoaded : LONGINT;                  {Total figures available in GraphFigures}
    CurrentCol  : LONGINT;                      {Color of current falling piece}
    UseColor    : BOOLEAN;                      {Color/Mono mode}
    Level       : LONGINT;                      {The current level number}
{$IFNDEF UseGraphics}
    Style       : String;                       {Contains all chars to create the field}
{$ENDIF}
    nonupdatemode  : BOOLEAN;                   {Helpmode/highscore screen or game mode}
{$IFNDEF UseGraphics}
    HelpMode    : BOOLEAN;
{$ENDIF}
    NextFigure  : LONGINT;                      {Next figure to fall}
    Score       : LONGINT;                      {The score}


FUNCTION RRotate(Figure:FigureType;ColumnsToDo:LONGINT):FigureType;
{Rotate a figure to the right (=clockwise).

This new (v0.06) routine performs a ColumnsTodo x ColumnsToDo rotation,
instead of always a 4x4 (v0.04) or 5x5 (v0.05) rotation.

This avoids weird, jumpy behaviour when rotating small pieces.}

VAR I,J, NewFig:LONGINT;

BEGIN
 NewFig:=0;
 FOR I:=0 TO ColumnsToDo-1 DO
  FOR J:=0 TO ColumnsToDo-1 DO
   IF Figure AND AndTable[I*5+J]<>0 THEN
    NewFig:=NewFig OR AndTable[(ColumnsToDo-1-I)+5*(J)]; {}
 RRotate:=NewFig;
END;

{ LeftSize and RightSize count the number of empty lines to the left and
right of the character. On the below character LeftSize will return 2 and
RightSize will return 1.

        ..*.
        ..*.
        ..*.
        ..*.
}
FUNCTION RightSize(Fig:FigureType):LONGINT;

VAR I : LONGINT;

BEGIN
 I:=0;
 WHILE ((Fig AND RightMask[I])=0) AND (I<5) DO
  INC(I);
  IF I>4 THEN
   HALT;
 Rightsize:=I;
END;

FUNCTION Leftsize(Fig:FigureType):LONGINT;

VAR I : LONGINT;

BEGIN
 I:=0;
 WHILE ((Fig AND LeftMask[I])=0)  AND (I<5) DO
  INC(I);
  IF I>4 THEN
   HALT;
 Leftsize:=I;
END;

FUNCTION FigSym(Figure:LONGINT;RightSizeFig:LONGINT):LONGINT;
 {Try to find the "symmetry" of a figure, the smallest square (1x1,2x2,3x3 etc)
 in which the figure fits. This requires all figures designed to be aligned to
 topleft.}

VAR ColumnsToDo : LONGINT;

BEGIN
 {Determine which bottom rows aren't used}

 ColumnsToDo:=5;
 WHILE ((Figure AND MagicMasks[ColumnsToDo-1])=0) AND (ColumnsToDo>1) DO
  DEC(ColumnsToDo);

 {Compare with columns used, already calculated, and take the biggest}
 IF ColumnsToDo<(5-RightSizeFig) THEN
  ColumnsToDo:=5-RightSizeFig;
 FigSym:=ColumnsToDo;
END;


PROCEDURE CreateFiguresArray;
{Reads figures from ASCII representation into binary form, and creates the
 rotated representations, and the number of empty columns to the right and
 left per figure. }

VAR I,J,K,L,Symmetry : LONGINT;

BEGIN
 NrFigures:=0; K:=1;
 WHILE K<Length(GraphFigures[0]) DO
  BEGIN
   IF GraphFigures[0][K]=' ' THEN
    INC(K);
   L:=0;
   FOR I:=0 TO 4 DO   {Rows}
    FOR J:=0 TO 4 DO {Columns}
     IF GraphFigures[I][K+J]='*' THEN
      L:=L OR AndTable[I*5+J];
    Figures[NrFigures][0]:=L;
    INC(NrFigures);
    INC(K,5);
  END;
 NrFiguresLoaded:=NrFigures;
 FOR I:= 0 TO NrFigures-1 DO
  BEGIN
   RightSizeArray[I][0]:=RightSize(Figures[I][0]);
   LeftSizeArray[I][0]:=LeftSize(Figures[I][0]);
   Symmetry:=FigSym(Figures[I][0],RightSizeArray[I][0]);
   FOR J:=0 TO 2 DO                              {Create the other 3 by rotating}
    BEGIN
     Figures[I][J+1]:=RRotate(Figures[I][J],Symmetry);
     RightSizeArray[I][J+1]:=RightSize(Figures[I][J+1]);
     LeftSizeArray[I][J+1]:=LeftSize(Figures[I][J+1]);
    END;
   END;
{Clear main grid}
 FillChar(MainField,SIZEOF(TetrisFieldType),0);
END;

PROCEDURE CalculateTotalChance;
{Called after a change in the the number of figures, normally 7 (standard)
or NrFiguresLoaded (10 right now) to recalculate the total of the chance table}

VAR Temp:LONGINT;

BEGIN
 TotalChance:=0;
 FOR Temp:=0 TO NrFigures-1 DO INC(TotalChance,FigureChance[Temp]);
END;

FUNCTION MatchPosition(Fig:FigureType;X,Y:LONGINT): BOOLEAN;
{Most important routine. Tries to position the figure on the position
IF it returns FALSE then the piece overlaps something on the background,
or the lower limit of the playfield
}

VAR I,J,K  : LONGINT;
    Match: BOOLEAN;

BEGIN
 Match:=TRUE;
 FOR I:=0 TO 4 DO
  BEGIN
   K:=Fig;
   K:=K AND MagicMasks[I];
   IF K<>0 THEN
    BEGIN
     J:=5*(I)-X+Tune;
     IF J>0 THEN
      K:=K SHL J
     ELSE
      IF J<0 THEN
       K:=K SHR -J;
     IF (MainField[Y+I] AND K)<>0 THEN
      Match:=FALSE;
   END;
  END;
 I:=4;
 IF (Fig AND MagicMasks[4])=0 THEN
  DEC(I);
 IF (Fig AND MagicMasks[3])=0 THEN
  DEC(I);
 IF (Fig AND MagicMasks[2])=0 THEN
  DEC(I);
 IF (Y+I)>=TheHeight THEN
  Match:=FALSE;
 MatchPosition:=Match;
END;

PROCEDURE FixFigureInField(Fig:FigureType;X,Y:LONGINT;Clear:BOOLEAN);
{Blends the figure into the background, or erases the figure from the
background}

VAR I,J,K  : LONGINT;

BEGIN
 FOR I:=0 TO 4 DO
  BEGIN
   K:=Fig;
    K:=K AND MagicMasks[I];
   IF K<>0 THEN
    BEGIN
     J:=5*I-X+Tune;
     IF J>0 THEN
      K:=K SHL J
     ELSE
      IF J<0 THEN
       K:=K SHR (-J);
     IF Clear THEN
      BEGIN
       K:=K XOR -1;
       MainField[Y+I]:= MainField[Y+I] AND K;
      END
     ELSE
      MainField[Y+I]:= MainField[Y+I] OR K;
    END;
 END;
END;

PROCEDURE FixColField(ThisFig:LONGINT);
{Puts color info of a figure into the colorgrid, simplified
FixFigureInField on byte instead of bit manipulation basis.}

VAR I,J,K  : LONGINT;

BEGIN
 FOR I:=0 TO 4 DO
  BEGIN
   K:=Figures[ThisFig][FigureNr];
   IF (I+TopY)<=TheHeight THEN
    FOR J:=0 TO 4 DO
     BEGIN
      IF (K AND AndTable[J+5*I])<>0 THEN
       ColorField[TopY+I,TopX-Tune+J]:=CurrentCol
     END;
  END;
END;

PROCEDURE RedrawScreen;
{Frustrates the caching system so that the entire screen is redrawn}

VAR I : LONGINT;

BEGIN
 FOR I:=0 TO TheHeight-1 DO
  BackField[I]:=MainField[I] XOR -1;    {backup copy is opposite of MainField}
END;

FUNCTION GetNextFigure:LONGINT;

VAR IndTotal,Temp,TheFigure : LONGINT;

BEGIN
Temp:=RANDOM(TotalChance);
 IndTotal:=0;
 TheFigure:=0;
 WHILE Temp>=IndTotal DO
  BEGIN
   INC(IndTotal,FigureChance[TheFigure]);
   INC(TheFigure);
  END;
 dec(thefigure);
 GetNextFigure:=TheFigure;
END;

{$IFDEF UseGraphics}
 {$I ftrisgr.inc}
{$ELSE}
 {$I ftristxt.inc}
{$ENDIF}


FUNCTION InitAFigure(VAR TheFigure:LONGINT) : BOOLEAN;
{A new figure appears in the top of the screen. If return value=FALSE then
the piece couldn't be created (when it is overlapping with the background.
That's the game-over condition)}

VAR Temp : LONGINT;

BEGIN
 TopX:=(TheWidth-4) DIV 2;             { Middle of Screen}
 TopY:=0;
 FigureNr:=1;
 IF TheFigure<>-1 THEN
  INC(Score,FigureScore[TheFigure]);
 IF NOT NonUpdateMode THEN
  FixScores;
 Temp:=GetNextFigure;                   {Determine next char (after the one this
                                      initafigure created has got down)}
 TheFigure:=NextFigure;                 {Previous NextFigure becomes active now.}
 NextFigure:=Temp;
 InitAFigure:=MatchPosition(Figures[TheFigure][0],TopX,TopY);
 ShowNextFigure(NextFigure);
 CurrentCol:=RANDOM(14)+1;
END;

PROCEDURE FixLevel(Lines:LONGINT);


BEGIN
 Level:=0;
 WHILE (Lines>LevelBorders[Level]) AND (Level<HIGH(LevelBorders)) DO
  INC(Level);
 DelayTime:=DelayLevel[Level];
 IterationPerDelay:=IterationLevel[Level];
END;

PROCEDURE FixMainFieldLines;
{Deletes full horizontal lines from the playfield will also get some
score-keeping code in the future.}

VAR I,LocalLines : LONGINT;

BEGIN
 I:=TheHeight-1;
 LocalLines:=0;
 WHILE I>=0 DO
  BEGIN
   IF (MainField[I] XOR RowMask)=0 THEN
    BEGIN
     Move(MainField[0],MainField[1],I*4);
     Move(ColorField[0,0],ColorField[1,0],4*I*TheWidth);
     MainField[0]:=0;
     FillChar(ColorField[0,0],0,TheWidth);
     INC(LocalLines);
    END
   ELSE
    DEC(I);
  END;

 INC(Lines,LocalLines);

 I:=Level;
 FixLevel(Lines);
 IF LocalLines<>0 THEN
  BEGIN
   INC(Score,ProgressiveFactor[LocalLines]*LocalLines);
   ShowLines;
  END;
 {$IFDEF DoubleCache}
  IF UseColor THEN
   RedrawScreen;
 {$ENDIF}
END;

PROCEDURE DoFPCTris;
{The main routine. Initialisation, keyboard loop}

VAR EndGame   : BOOLEAN;
    FixHickup : LONGINT;
    Counter   : LONGINT;
    Temp,Key  : LONGINT;
    TheFigure : LONGINT;                      {Current first index in Figures}

PROCEDURE TurnFigure;
{Erases a figure from the grid, turns it if possible, and puts it back on
again}

BEGIN
  FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,TRUE);
  IF MatchPosition(Figures[TheFigure][Temp],TopX,TopY) THEN
   FigureNr:=Temp;
  FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,FALSE);
END;

PROCEDURE FixHighScores;

VAR I : LONGINT;
{$IFNDEF UseGraphics}
    J : LONGINT;
{$ENDIF}
    S : String;

BEGIN
{$IFDEF UseGraphics}
  Str(Score:5,S);
  SetFillStyle(SolidFill,0);            {Clear part of playfield}
  Bar(DisplGrX+DisplGrScale,DisplGrY + ((TheHeight DIV 2)-2)*DisplGrScale,
      DisplGrX+(TheWidth-1)*(DisplGrScale), DisplGrY + DisplGrScale*((TheHeight DIV 2)+5));
  SetTextStyle(0,Horizdir,2);
  OuttextXY(DisplGrX+DisplGrScale,DisplGrY+ DisplGrScale*((TheHeight DIV 2)-1),'GAME OVER');
  SetTextStyle(0,Horizdir,1);
  OutTextXY(DisplGrX+DisplGrScale,DisplGrY+ DisplGrScale*((TheHeight DIV 2)+3),'Score= '+S);
{$ELSE}
 FOR J:=9 TO 22 DO
    BEGIN
     GotoXY(40,J);
     Write(' ':38);
    END;
 IF UseColor THEN
  TextColor(White);
 GotoXY(40,23);
 Writeln('Game Over, score = ',Score);
{$ENDIF}
 I:=SlipInScore(Score);
 IF I<>0 THEN
  BEGIN
   NonUpdateMode:=TRUE;
{$IFNDEF UseGraphics}
   HelpMode:=FALSE;
{$ENDIF}
   ShowHighScore;
   {$IFDEF UseGraphics}
    OutTextXY(450,HelpY+20+(17-I+1)*LineDistY,S);
    GrInputStr(S,300,HelpY+20+(17-I+1)*LineDistY,16,12,10,FALSE,AlfaBeta);
   {$ELSE}
    InputStr(S,40,21-I,10,FALSE,AlfaBeta);
   {$ENDIF}
   HighScore[I-1].Name:=S;
  END;
 ShowHighScore;
END;

{$IFDEF UseGraphics}
VAR
    gd,gm : INTEGER;
    Pal   : PaletteType;
{$ENDIF}

BEGIN
{$IFDEF UseGraphics}
  gm:=vgahi;
  gd:=vga;
  InitGraph(gd,gm,'');
  if GraphResult <> grOk then
    begin
      Writeln('Graph driver ',gd,' graph mode ',gm,' not supported');
      Halt(1);
    end;
  SetFillStyle(SolidFill,1);
  GetDefaultPalette(Pal);
  SetAllPalette(Pal);
{$ENDIF}

 {Here should be some terminal-detection for Linux}
 nonupdatemode:=FALSE;
{$IFNDEF UseGraphics}
 HelpMode :=TRUE;
{$ENDIF}
 {$IFDEF Linux}
  UseColor:=FALSE;
 {$ELSE}
  UseColor:=TRUE;
 {$ENDIF}
 ClrScr;
 CursorOff;
 RANDOMIZE;
 HighX:=BaseX;
 HighY:=BaseY;
 CreateFiguresArray;                  { Load and precalculate a lot of stuff}
{$IFNDEF UseGraphics}
 IF UseColor THEN
  Style:= ColorString
 ELSE
  Style:=DumbTermStr;
{$ENDIF}

 NrFigures:=7;                        {Default standard tetris mode, only use
                                        the first 7 standard figures}
 CalculateTotalChance;                {Calculated the total of all weightfactors}
 EndGame:=FALSE;                      {When TRUE, end of game has been detected}
 FixHickup:=0;                        {Used to avoid unnecessary pauses with the "down key"}
 CreateFrame;                         {Draws all background garbadge}

 TheFigure:=-1;
 NextFigure:=GetNextFigure;              {Two figures have to be inited. The first
                                        figure starts dropping, and that is this
                                        one}
 InitAFigure(TheFigure);              {The second figure is the figure to be
                                       displayed as NEXT. That's this char :-)}
 DisplMainField;                  {Display/update the grid}
 Counter:=0;                          {counts up to IterationPerDelay}
 DelayTime:=200;                      {Time of delay}
 IterationPerDelay:=4;                {= # Delays per shift down of figure}
 Lines:=0;                            {Lines that have disappeared}
 Score:=0;
 ShowLines;
 REPEAT
  IF KeyPressed THEN                  {The function name says it all}
   BEGIN
    Key:=ORD(READKEY);
    IF Key=0 THEN                     {Function key?}
     Key:=ORD(READKEY) SHL 8;
    CASE Key OF                       {Check for all keys}
     ArrU : BEGIN
             Temp:=(FigureNr+3) AND 3;
             IF ((TopX+LeftSizeArray[TheFigure][FigureNr])<0) THEN
              BEGIN
              IF  (LeftSizeArray[TheFigure][FigureNr]<=LeftSizeArray[TheFigure][Temp]) THEN
               TurnFigure;
              END
             ELSE
             IF (TopX+7-RightSizeArray[TheFigure][FigureNr])>TheWidth THEN
              BEGIN
              IF  (RightSizeArray[TheFigure][FigureNr]<=RightSizeArray[TheFigure][Temp]) THEN
               TurnFigure;
              END
             ELSE
              TurnFigure;
           END;

    ArrL  : BEGIN
             IF (TopX+LeftSizeArray[TheFigure][FigureNr])>=0 THEN
              BEGIN
               Temp:=TopX+1-LeftSizeArray[TheFigure][FigureNr];
               FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,TRUE);
               IF MatchPosition(Figures[TheFigure][FigureNr],TopX-1,TopY) THEN
                DEC(TopX);
               FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,FALSE);
              END;
             END;

    ArrR  : BEGIN
             IF (TopX+7-RightSizeArray[TheFigure][FigureNr])<=TheWidth THEN
              BEGIN
               FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,TRUE);
               IF MatchPosition(Figures[TheFigure][FigureNr],TopX+1,TopY) THEN
                INC(TopX);
               FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,FALSE);
              END;
             END;

    ArrD  : BEGIN
             IF FixHickup=0 THEN
              BEGIN
             FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,TRUE);
             Temp:=TopY;
             WHILE MatchPosition(Figures[TheFigure][FigureNr],TopX,TopY+1) DO
              INC(TopY);
             Temp:=TopY-Temp;
             INC(Score,Temp DIV 2);
             FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,FALSE);
             FixHickUp:=4;
             END;
            END;

ORD('q'),
   ESC     : BEGIN
             SetDefaultColor;
             GotoXY(1,25);
             EndGame:=TRUE;
            END;

{$IFNDEF UseGraphics}
ORD('C'),
 ORD('c') : BEGIN
             UseColor:=NOT UseColor;
             IF UseColor THEN
              Style:= ColorString
             ELSE
              BEGIN
               SetDefaultColor;
               Style:=DumbTermStr;
              END;
             CreateFrame;
             RedrawScreen;
             DisplMainField;
            END;
 ORD('S'),
  ORD('s') : BEGIN
              IF NOT nonupdatemode THEN
               BEGIN
                NonUpdateMode:=TRUE;
                helpmode:=NOT helpmode;
               END
              ELSE
                HelpMode:=NOT helpmode;
               CreateFrame;
               ShowLines;
               ShowNextFigure(NextFigure);
              END;
{$ENDIF}
ORD('H'),
 ORD('h') : BEGIN
             nonupdatemode:=NOT nonupdatemode;
             CreateFrame;
             ShowLines;
             ShowNextFigure(NextFigure);
            END;
ORD('E'),
 ORD('e'): BEGIN                            {Extra figures on/off}
            IF NrFigures<>NrFiguresLoaded THEN
              NrFigures:=NrFiguresLoaded     {Extra figures}
            ELSE
              NrFigures:=7;                   {Standard Tetris figures}
            CalculateTotalChance;             {Recalculate weight-totals}
            IF UseColor THEN
             SetDefaultColor;
            ShowGameMode;
           END;

ORD('p') : BEGIN                             {"p" : Pause}
             Key:=ORD(ReadKey);
            IF Key=0 THEN
             Key:=ORD(ReadKey);
           END;
{$IFNDEF UseGraphics}
{$IFDEF Linux}
 ORD('i')  : write(#27+'(K');
{$ENDIF}
{$ENDIF}
        END; {END OF Key CASE}
      END { OF If KeyPressed}

  ELSE
   BEGIN
    {$IFDEF Linux}
     GotoXY(50,10);      {Get cursor out of the way, CursorOn/Off
                            doesn't work on telnet-terminals}
    {$ENDIF}
    Delay(DelayTime);
   END;

  INC(Counter);
  IF (Counter=IterationPerDelay) OR (FixHickup=1) THEN
   BEGIN
    IF FixHickup=1 THEN
      Counter:=IterationPerDelay-1
    ELSE
     Counter:=0;
    FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,TRUE);
    FixHickup:=0;
    IF MatchPosition(Figures[TheFigure][FigureNr],TopX,TopY+1) THEN
     BEGIN
      INC(TopY);
      FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,FALSE);
     END
    ELSE
    BEGIN
      FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,FALSE);
      FixColField(TheFigure);
      IF InitAFigure(TheFigure) THEN
        BEGIN
         FixMainFieldLines;
         FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,FALSE);
         DisplMainField;
         Delay(DelayTime*IterationPerDelay);
        END
      ELSE
       BEGIN
        FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,FALSE);
        EndGame:=TRUE;
       END;
    END;
   END
  ELSE
   IF FixHickup>1 THEN
    DEC(FixHickup);
 DisplMainField;
 UNTIL EndGame;
 FixHighScores;
 CursorOn;
 SetDefaultColor;
 GotoXY(1,25);
 {$IFDEF UseGraphics}
  TextMode(CO80);
 {$ENDIF}
END;

CONST FileName='fpctris.scr';

VAR I : LONGINT;

BEGIN
 FOR I:=0 TO 9 DO
  HighScore[I].Score:=(I+1)*750;
 LoadHighScore(FileName);
 DoFpcTris;
 SaveHighScore;
END.

{
  $Log: fpctris.pp,v $
  Revision 1.1  2000/03/09 02:40:03  alex
  moved files

  Revision 1.7  2000/02/22 03:36:48  alex
  fixed the warning

  Revision 1.5  2000/01/21 00:44:51  peter
    * remove unused vars
    * renamed to .pp

  Revision 1.4  2000/01/14 22:03:07  marco
   * Changed some comments

  Revision 1.3  1999/12/31 17:03:50  marco


  Graphical version +2fixes

  Revision 1.2  1999/06/01 19:24:32  peter
    * updates from marco

  Revision 1.1  1999/05/27 21:36:33  peter
    * new demo's
    * fixed mandel for linux

}