home *** CD-ROM | disk | FTP | other *** search
/ PC World 2003 February / PCWorld_2003-02_cd.bin / Software / Topware / devpascal / examples / Tetris / fpctris.pp next >
Text File  |  2000-09-13  |  26KB  |  860 lines
  1. {
  2.     $Id: fpctris.pp,v 1.1 2000/03/09 02:40:03 alex Exp $
  3.  
  4.     This program is both available in XTDFPC as in the FPC demoes.
  5.     Copyright (C) 1999 by Marco van de Voort
  6.  
  7.     FPCTris implements a simple Crt driven Tetrisish game to demonstrate the
  8.     Crt unit. (KeyPressed, ReadKey, GotoXY, Delay,TextColor,TextBackground)
  9.     Quality games cost money, so that's why this one is free.
  10.  
  11.     See the file COPYING.FPC, included in this distribution,
  12.     for details about the copyright.
  13.  
  14.     This program is distributed in the hope that it will be useful,
  15.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  16.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  17.  
  18.  **********************************************************************}
  19.  
  20. PROGRAM FPCTris;
  21. {$LONGSTRINGS OFF}
  22.  
  23. { Trying to make a tetris from zero as a demo for FPC.
  24.   Problems: - Colorsupport is a hack which handicaps creating a better
  25.                update mechanism. (is done now)
  26.             - Graph version input command has no cursor.
  27.             - Graph or text isn't decided runtime, but compilertime.
  28.             - Linux status graph version unknown at this moment.
  29.             - Graphic and textmode speed of the game is not the same.
  30.                The delay is fixed, and the time required to update is
  31.                not constant due to optimisations.
  32.  
  33.   Coordinate system:
  34.  
  35.    0  ->   TheWidth-1            A figure is coded in a LONGINT like this:
  36.    ---------
  37. 0 |   *     |                    ..*.            00100000    MSB
  38. | |   **    |                    ..*.            00100000
  39. V |   *     |                    .**.            01100000
  40.   |         |                    ....            00000000    LSB
  41.   |+   ++ ++|
  42.   |++ ++++++|                  so  00100000001000000110000000000000b
  43.   |+++++++++|
  44.    ---------
  45. TheHeight-1
  46.  
  47. }
  48.  
  49. Uses Crt,Dos,
  50. {$IFDEF UseGraphics}
  51.  Graph,
  52. {$ENDIF}
  53.  GameUnit;
  54.  
  55. {$DEFINE DoubleCache}
  56.  
  57. CONST TheWidth  = 11; {Watch out, also correct RowMask!}
  58.       TheHeight = 20;
  59. {$IFNDEF UseGraphics}
  60.       PosXField = 10; { Upper X,Y coordinates of playfield}
  61.       PosYField = 3;
  62. {$ENDIF}
  63.       MaxFigures= 16; {Maximum # figures place is reserved for.}
  64.       NrLevels  = 12; {Number of levels currenty defined}
  65. {      FieldSpace= 177;}
  66.  
  67. {$IFDEF UseGraphics}
  68.       DisplGrX=110;
  69.       DisplGrY=90;
  70.       DisplGrScale=16;
  71.       HelpY=130;
  72. {$ENDIF}
  73.  
  74.       {$IFDEF UseGraphics}
  75.        BaseX     =300;   {Coordinates of highscores}
  76.        BaseY     =HelpY+20+8*LineDistY;  {y coordinate relative to other options}
  77.       {$ELSE}
  78.        BaseX     =40;
  79.        BaseY     =9;
  80.       {$ENDIF}
  81.  
  82. TYPE TetrisFieldType = ARRAY [0..25] OF LONGINT;
  83.      LevelInfoType   = ARRAY [0..NrLevels-1] OF LONGINT;
  84.      FigureType      = LONGINT;    { actually array[0..4][0..4] of bit rounded up to a longint}
  85. {     CHARSET         = SET OF CHAR;}
  86.  
  87. {The figures, are converted to binary bitmaps on startup.}
  88.  
  89. CONST GraphFigures : ARRAY[0..4] OF String[80] =(
  90. '.*... .*... .*... ..*.. .*... .*... **... **... ..**. .**.. ..*.. *....',
  91. '.*... .*... .**.. .**.. .*... .**.. **... .*... ..*.. .**.. ..*.. **...',
  92. '**... .**.. ..*.. .*... .*... .*... ..... .*... ..*.. .**.. **.** .**..',
  93. '..... ..... ..... ..... .*... ..... ..... .***. ***.. .**.. ..*.. ..**.',
  94. '..... ..... ..... ..... ..... ..... ..... ..... ..... .**.. ..*.. .....');
  95.  
  96. {Their relative occurance : }
  97.  
  98.       FigureChance : ARRAY[0..MaxFigures-1] OF LONGINT =(
  99.   8,     8,    8,    8,     8,   8,   10,    1,   1,     1,    1,    1,0,0,0,0 );
  100.  
  101. {Scores per figure. Not necessarily used. Just for future use}
  102.  
  103.       FigureScore  : ARRAY[0..MaxFigures-1] OF LONGINT =(
  104.   2,     2,    4,    4,     1,   2,    2,   10,  10,    10,   20,   10,0,0,0,0 );
  105.  
  106. {Diverse AND/OR masks to manipulate graphics}
  107.  
  108. {general table to mask out a bit 31=msb 0=lsb}
  109.  AndTable : ARRAY[0..31] OF LONGINT=($80000000,$40000000,$20000000,$10000000,
  110.     $8000000,$4000000,$2000000,$1000000,$800000,$400000,$200000,$100000,
  111.     $80000,$40000,$20000,$10000,$8000,$4000,$2000,$1000,$800,$400,$200,$100,
  112.     $80,$40,$20,$10,8,4,2,1);
  113.  
  114. {Mask to isolate a row of a (FigureType)}
  115.  
  116.  MagicMasks : ARRAY[0..4] OF LONGINT = ($F8000000,$07C00000,$003E0000,$0001F000,$00000F80);
  117.  
  118. {Mask to check if a line is full; a bit for every column aligned to left.}
  119.  RowMask    = $FFE00000;
  120.  
  121. {Masks to calculate if the left or rightside is partially empty, write them
  122. in binary, and put 5 bits on a row. }
  123.  
  124.  LeftMask : ARRAY[0..4] OF LONGINT = ($84210800,$C6318C00,$E739CE00,$F7BDEF00,$FFFFFFE0);
  125.  RightMask: ARRAY[0..4] OF LONGINT = ($08421080,$18C63180,$39CE7380,$7BDEF780,$FFFFFF80);
  126.  
  127. {Allowed characters entering highscores}
  128.  
  129. {This constant/parameter is used to detect a certain bug. The bug was fixed, but
  130. I use the constant to remind where the bug was, and what is related to eachother.}
  131.  
  132.    Tune=-1;
  133.  
  134. {First array is a table to find the level for a given number of dissappeared lines
  135.  the second and third are the delaytime and iterationlevel per level.  }
  136.  
  137.   LevelBorders  : LevelInfoType = ( 10, 20, 30, 45, 60, 80,100,130,160,200,240,280);
  138.   DelayLevel    : LevelInfoType = (100, 90, 80, 70, 60, 60, 50, 40, 40, 20, 20,10);
  139.   IterationLevel: LevelInfoType = (  5,  5,  5,  5,  5,  4,  4,  4,  3,  3,  2, 2);
  140.  
  141. {Some frequently used chars in high-ascii and low-ascii. UseColor selects between
  142. them}
  143.   ColorString = #196#179#192#217#219;
  144.   DumbTermStr = '-|..*';
  145.  
  146. { A multiplication factor to reward killing more then one line with one figure}
  147.  
  148.   ProgressiveFactor :  ARRAY[1..5] OF LONGINT = (10,12,16,22,30);
  149.  
  150. VAR
  151.     TopX,TopY   : LONGINT;                      {Coordinates figure relative
  152.                                                   to left top of playfield}
  153.     FigureNr    : LONGINT;                      {Nr in Figure cache, second
  154.                                                   index in Figures}
  155.     {$IFDEF DoubleCache}
  156.     BackField,                                  {Copy of the screen for faster matching}
  157.     {$ENDIF}
  158.     MainField   : TetrisFieldType;              {The screen grid}
  159.     ColorField  : ARRAY[0..TheHeight-1,0..TheWidth-1] OF LONGINT; {The color info}
  160.     DelayTime   : LONGINT;                      {Delay time, can be used for
  161.                                                   implementing levels}
  162.     IterationPerDelay : LONGINT;                {Iterations of mainloop (incl delay)
  163.                                                  before the piece falls down a row}
  164.     TotalChance : LONGINT;                      {Sum of FigureChange array}
  165.     Lines       : LONGINT;                      {Completed lines}
  166.     NrFigures   : LONGINT;                      {# Figures currently used}
  167.     RightSizeArray,                             {Nunber of empty columns to the left }
  168.     LeftSizeArray,                              {or right of the figure/piece}
  169.     Figures     : ARRAY[0..MaxFigures-1,0..3] OF LONGINT; {All bitmap info of figures}
  170.  
  171.     NrFiguresLoaded : LONGINT;                  {Total figures available in GraphFigures}
  172.     CurrentCol  : LONGINT;                      {Color of current falling piece}
  173.     UseColor    : BOOLEAN;                      {Color/Mono mode}
  174.     Level       : LONGINT;                      {The current level number}
  175. {$IFNDEF UseGraphics}
  176.     Style       : String;                       {Contains all chars to create the field}
  177. {$ENDIF}
  178.     nonupdatemode  : BOOLEAN;                   {Helpmode/highscore screen or game mode}
  179. {$IFNDEF UseGraphics}
  180.     HelpMode    : BOOLEAN;
  181. {$ENDIF}
  182.     NextFigure  : LONGINT;                      {Next figure to fall}
  183.     Score       : LONGINT;                      {The score}
  184.  
  185.  
  186. FUNCTION RRotate(Figure:FigureType;ColumnsToDo:LONGINT):FigureType;
  187. {Rotate a figure to the right (=clockwise).
  188.  
  189. This new (v0.06) routine performs a ColumnsTodo x ColumnsToDo rotation,
  190. instead of always a 4x4 (v0.04) or 5x5 (v0.05) rotation.
  191.  
  192. This avoids weird, jumpy behaviour when rotating small pieces.}
  193.  
  194. VAR I,J, NewFig:LONGINT;
  195.  
  196. BEGIN
  197.  NewFig:=0;
  198.  FOR I:=0 TO ColumnsToDo-1 DO
  199.   FOR J:=0 TO ColumnsToDo-1 DO
  200.    IF Figure AND AndTable[I*5+J]<>0 THEN
  201.     NewFig:=NewFig OR AndTable[(ColumnsToDo-1-I)+5*(J)]; {}
  202.  RRotate:=NewFig;
  203. END;
  204.  
  205. { LeftSize and RightSize count the number of empty lines to the left and
  206. right of the character. On the below character LeftSize will return 2 and
  207. RightSize will return 1.
  208.  
  209.         ..*.
  210.         ..*.
  211.         ..*.
  212.         ..*.
  213. }
  214. FUNCTION RightSize(Fig:FigureType):LONGINT;
  215.  
  216. VAR I : LONGINT;
  217.  
  218. BEGIN
  219.  I:=0;
  220.  WHILE ((Fig AND RightMask[I])=0) AND (I<5) DO
  221.   INC(I);
  222.   IF I>4 THEN
  223.    HALT;
  224.  Rightsize:=I;
  225. END;
  226.  
  227. FUNCTION Leftsize(Fig:FigureType):LONGINT;
  228.  
  229. VAR I : LONGINT;
  230.  
  231. BEGIN
  232.  I:=0;
  233.  WHILE ((Fig AND LeftMask[I])=0)  AND (I<5) DO
  234.   INC(I);
  235.   IF I>4 THEN
  236.    HALT;
  237.  Leftsize:=I;
  238. END;
  239.  
  240. FUNCTION FigSym(Figure:LONGINT;RightSizeFig:LONGINT):LONGINT;
  241.  {Try to find the "symmetry" of a figure, the smallest square (1x1,2x2,3x3 etc)
  242.  in which the figure fits. This requires all figures designed to be aligned to
  243.  topleft.}
  244.  
  245. VAR ColumnsToDo : LONGINT;
  246.  
  247. BEGIN
  248.  {Determine which bottom rows aren't used}
  249.  
  250.  ColumnsToDo:=5;
  251.  WHILE ((Figure AND MagicMasks[ColumnsToDo-1])=0) AND (ColumnsToDo>1) DO
  252.   DEC(ColumnsToDo);
  253.  
  254.  {Compare with columns used, already calculated, and take the biggest}
  255.  IF ColumnsToDo<(5-RightSizeFig) THEN
  256.   ColumnsToDo:=5-RightSizeFig;
  257.  FigSym:=ColumnsToDo;
  258. END;
  259.  
  260.  
  261. PROCEDURE CreateFiguresArray;
  262. {Reads figures from ASCII representation into binary form, and creates the
  263.  rotated representations, and the number of empty columns to the right and
  264.  left per figure. }
  265.  
  266. VAR I,J,K,L,Symmetry : LONGINT;
  267.  
  268. BEGIN
  269.  NrFigures:=0; K:=1;
  270.  WHILE K<Length(GraphFigures[0]) DO
  271.   BEGIN
  272.    IF GraphFigures[0][K]=' ' THEN
  273.     INC(K);
  274.    L:=0;
  275.    FOR I:=0 TO 4 DO   {Rows}
  276.     FOR J:=0 TO 4 DO {Columns}
  277.      IF GraphFigures[I][K+J]='*' THEN
  278.       L:=L OR AndTable[I*5+J];
  279.     Figures[NrFigures][0]:=L;
  280.     INC(NrFigures);
  281.     INC(K,5);
  282.   END;
  283.  NrFiguresLoaded:=NrFigures;
  284.  FOR I:= 0 TO NrFigures-1 DO
  285.   BEGIN
  286.    RightSizeArray[I][0]:=RightSize(Figures[I][0]);
  287.    LeftSizeArray[I][0]:=LeftSize(Figures[I][0]);
  288.    Symmetry:=FigSym(Figures[I][0],RightSizeArray[I][0]);
  289.    FOR J:=0 TO 2 DO                              {Create the other 3 by rotating}
  290.     BEGIN
  291.      Figures[I][J+1]:=RRotate(Figures[I][J],Symmetry);
  292.      RightSizeArray[I][J+1]:=RightSize(Figures[I][J+1]);
  293.      LeftSizeArray[I][J+1]:=LeftSize(Figures[I][J+1]);
  294.     END;
  295.    END;
  296. {Clear main grid}
  297.  FillChar(MainField,SIZEOF(TetrisFieldType),0);
  298. END;
  299.  
  300. PROCEDURE CalculateTotalChance;
  301. {Called after a change in the the number of figures, normally 7 (standard)
  302. or NrFiguresLoaded (10 right now) to recalculate the total of the chance table}
  303.  
  304. VAR Temp:LONGINT;
  305.  
  306. BEGIN
  307.  TotalChance:=0;
  308.  FOR Temp:=0 TO NrFigures-1 DO INC(TotalChance,FigureChance[Temp]);
  309. END;
  310.  
  311. FUNCTION MatchPosition(Fig:FigureType;X,Y:LONGINT): BOOLEAN;
  312. {Most important routine. Tries to position the figure on the position
  313. IF it returns FALSE then the piece overlaps something on the background,
  314. or the lower limit of the playfield
  315. }
  316.  
  317. VAR I,J,K  : LONGINT;
  318.     Match: BOOLEAN;
  319.  
  320. BEGIN
  321.  Match:=TRUE;
  322.  FOR I:=0 TO 4 DO
  323.   BEGIN
  324.    K:=Fig;
  325.    K:=K AND MagicMasks[I];
  326.    IF K<>0 THEN
  327.     BEGIN
  328.      J:=5*(I)-X+Tune;
  329.      IF J>0 THEN
  330.       K:=K SHL J
  331.      ELSE
  332.       IF J<0 THEN
  333.        K:=K SHR -J;
  334.      IF (MainField[Y+I] AND K)<>0 THEN
  335.       Match:=FALSE;
  336.    END;
  337.   END;
  338.  I:=4;
  339.  IF (Fig AND MagicMasks[4])=0 THEN
  340.   DEC(I);
  341.  IF (Fig AND MagicMasks[3])=0 THEN
  342.   DEC(I);
  343.  IF (Fig AND MagicMasks[2])=0 THEN
  344.   DEC(I);
  345.  IF (Y+I)>=TheHeight THEN
  346.   Match:=FALSE;
  347.  MatchPosition:=Match;
  348. END;
  349.  
  350. PROCEDURE FixFigureInField(Fig:FigureType;X,Y:LONGINT;Clear:BOOLEAN);
  351. {Blends the figure into the background, or erases the figure from the
  352. background}
  353.  
  354. VAR I,J,K  : LONGINT;
  355.  
  356. BEGIN
  357.  FOR I:=0 TO 4 DO
  358.   BEGIN
  359.    K:=Fig;
  360.     K:=K AND MagicMasks[I];
  361.    IF K<>0 THEN
  362.     BEGIN
  363.      J:=5*I-X+Tune;
  364.      IF J>0 THEN
  365.       K:=K SHL J
  366.      ELSE
  367.       IF J<0 THEN
  368.        K:=K SHR (-J);
  369.      IF Clear THEN
  370.       BEGIN
  371.        K:=K XOR -1;
  372.        MainField[Y+I]:= MainField[Y+I] AND K;
  373.       END
  374.      ELSE
  375.       MainField[Y+I]:= MainField[Y+I] OR K;
  376.     END;
  377.  END;
  378. END;
  379.  
  380. PROCEDURE FixColField(ThisFig:LONGINT);
  381. {Puts color info of a figure into the colorgrid, simplified
  382. FixFigureInField on byte instead of bit manipulation basis.}
  383.  
  384. VAR I,J,K  : LONGINT;
  385.  
  386. BEGIN
  387.  FOR I:=0 TO 4 DO
  388.   BEGIN
  389.    K:=Figures[ThisFig][FigureNr];
  390.    IF (I+TopY)<=TheHeight THEN
  391.     FOR J:=0 TO 4 DO
  392.      BEGIN
  393.       IF (K AND AndTable[J+5*I])<>0 THEN
  394.        ColorField[TopY+I,TopX-Tune+J]:=CurrentCol
  395.      END;
  396.   END;
  397. END;
  398.  
  399. PROCEDURE RedrawScreen;
  400. {Frustrates the caching system so that the entire screen is redrawn}
  401.  
  402. VAR I : LONGINT;
  403.  
  404. BEGIN
  405.  FOR I:=0 TO TheHeight-1 DO
  406.   BackField[I]:=MainField[I] XOR -1;    {backup copy is opposite of MainField}
  407. END;
  408.  
  409. FUNCTION GetNextFigure:LONGINT;
  410.  
  411. VAR IndTotal,Temp,TheFigure : LONGINT;
  412.  
  413. BEGIN
  414. Temp:=RANDOM(TotalChance);
  415.  IndTotal:=0;
  416.  TheFigure:=0;
  417.  WHILE Temp>=IndTotal DO
  418.   BEGIN
  419.    INC(IndTotal,FigureChance[TheFigure]);
  420.    INC(TheFigure);
  421.   END;
  422.  dec(thefigure);
  423.  GetNextFigure:=TheFigure;
  424. END;
  425.  
  426. {$IFDEF UseGraphics}
  427.  {$I ftrisgr.inc}
  428. {$ELSE}
  429.  {$I ftristxt.inc}
  430. {$ENDIF}
  431.  
  432.  
  433. FUNCTION InitAFigure(VAR TheFigure:LONGINT) : BOOLEAN;
  434. {A new figure appears in the top of the screen. If return value=FALSE then
  435. the piece couldn't be created (when it is overlapping with the background.
  436. That's the game-over condition)}
  437.  
  438. VAR Temp : LONGINT;
  439.  
  440. BEGIN
  441.  TopX:=(TheWidth-4) DIV 2;             { Middle of Screen}
  442.  TopY:=0;
  443.  FigureNr:=1;
  444.  IF TheFigure<>-1 THEN
  445.   INC(Score,FigureScore[TheFigure]);
  446.  IF NOT NonUpdateMode THEN
  447.   FixScores;
  448.  Temp:=GetNextFigure;                   {Determine next char (after the one this
  449.                                       initafigure created has got down)}
  450.  TheFigure:=NextFigure;                 {Previous NextFigure becomes active now.}
  451.  NextFigure:=Temp;
  452.  InitAFigure:=MatchPosition(Figures[TheFigure][0],TopX,TopY);
  453.  ShowNextFigure(NextFigure);
  454.  CurrentCol:=RANDOM(14)+1;
  455. END;
  456.  
  457. PROCEDURE FixLevel(Lines:LONGINT);
  458.  
  459.  
  460. BEGIN
  461.  Level:=0;
  462.  WHILE (Lines>LevelBorders[Level]) AND (Level<HIGH(LevelBorders)) DO
  463.   INC(Level);
  464.  DelayTime:=DelayLevel[Level];
  465.  IterationPerDelay:=IterationLevel[Level];
  466. END;
  467.  
  468. PROCEDURE FixMainFieldLines;
  469. {Deletes full horizontal lines from the playfield will also get some
  470. score-keeping code in the future.}
  471.  
  472. VAR I,LocalLines : LONGINT;
  473.  
  474. BEGIN
  475.  I:=TheHeight-1;
  476.  LocalLines:=0;
  477.  WHILE I>=0 DO
  478.   BEGIN
  479.    IF (MainField[I] XOR RowMask)=0 THEN
  480.     BEGIN
  481.      Move(MainField[0],MainField[1],I*4);
  482.      Move(ColorField[0,0],ColorField[1,0],4*I*TheWidth);
  483.      MainField[0]:=0;
  484.      FillChar(ColorField[0,0],0,TheWidth);
  485.      INC(LocalLines);
  486.     END
  487.    ELSE
  488.     DEC(I);
  489.   END;
  490.  
  491.  INC(Lines,LocalLines);
  492.  
  493.  I:=Level;
  494.  FixLevel(Lines);
  495.  IF LocalLines<>0 THEN
  496.   BEGIN
  497.    INC(Score,ProgressiveFactor[LocalLines]*LocalLines);
  498.    ShowLines;
  499.   END;
  500.  {$IFDEF DoubleCache}
  501.   IF UseColor THEN
  502.    RedrawScreen;
  503.  {$ENDIF}
  504. END;
  505.  
  506. PROCEDURE DoFPCTris;
  507. {The main routine. Initialisation, keyboard loop}
  508.  
  509. VAR EndGame   : BOOLEAN;
  510.     FixHickup : LONGINT;
  511.     Counter   : LONGINT;
  512.     Temp,Key  : LONGINT;
  513.     TheFigure : LONGINT;                      {Current first index in Figures}
  514.  
  515. PROCEDURE TurnFigure;
  516. {Erases a figure from the grid, turns it if possible, and puts it back on
  517. again}
  518.  
  519. BEGIN
  520.   FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,TRUE);
  521.   IF MatchPosition(Figures[TheFigure][Temp],TopX,TopY) THEN
  522.    FigureNr:=Temp;
  523.   FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,FALSE);
  524. END;
  525.  
  526. PROCEDURE FixHighScores;
  527.  
  528. VAR I : LONGINT;
  529. {$IFNDEF UseGraphics}
  530.     J : LONGINT;
  531. {$ENDIF}
  532.     S : String;
  533.  
  534. BEGIN
  535. {$IFDEF UseGraphics}
  536.   Str(Score:5,S);
  537.   SetFillStyle(SolidFill,0);            {Clear part of playfield}
  538.   Bar(DisplGrX+DisplGrScale,DisplGrY + ((TheHeight DIV 2)-2)*DisplGrScale,
  539.       DisplGrX+(TheWidth-1)*(DisplGrScale), DisplGrY + DisplGrScale*((TheHeight DIV 2)+5));
  540.   SetTextStyle(0,Horizdir,2);
  541.   OuttextXY(DisplGrX+DisplGrScale,DisplGrY+ DisplGrScale*((TheHeight DIV 2)-1),'GAME OVER');
  542.   SetTextStyle(0,Horizdir,1);
  543.   OutTextXY(DisplGrX+DisplGrScale,DisplGrY+ DisplGrScale*((TheHeight DIV 2)+3),'Score= '+S);
  544. {$ELSE}
  545.  FOR J:=9 TO 22 DO
  546.     BEGIN
  547.      GotoXY(40,J);
  548.      Write(' ':38);
  549.     END;
  550.  IF UseColor THEN
  551.   TextColor(White);
  552.  GotoXY(40,23);
  553.  Writeln('Game Over, score = ',Score);
  554. {$ENDIF}
  555.  I:=SlipInScore(Score);
  556.  IF I<>0 THEN
  557.   BEGIN
  558.    NonUpdateMode:=TRUE;
  559. {$IFNDEF UseGraphics}
  560.    HelpMode:=FALSE;
  561. {$ENDIF}
  562.    ShowHighScore;
  563.    {$IFDEF UseGraphics}
  564.     OutTextXY(450,HelpY+20+(17-I+1)*LineDistY,S);
  565.     GrInputStr(S,300,HelpY+20+(17-I+1)*LineDistY,16,12,10,FALSE,AlfaBeta);
  566.    {$ELSE}
  567.     InputStr(S,40,21-I,10,FALSE,AlfaBeta);
  568.    {$ENDIF}
  569.    HighScore[I-1].Name:=S;
  570.   END;
  571.  ShowHighScore;
  572. END;
  573.  
  574. {$IFDEF UseGraphics}
  575. VAR
  576.     gd,gm : INTEGER;
  577.     Pal   : PaletteType;
  578. {$ENDIF}
  579.  
  580. BEGIN
  581. {$IFDEF UseGraphics}
  582.   gm:=vgahi;
  583.   gd:=vga;
  584.   InitGraph(gd,gm,'');
  585.   if GraphResult <> grOk then
  586.     begin
  587.       Writeln('Graph driver ',gd,' graph mode ',gm,' not supported');
  588.       Halt(1);
  589.     end;
  590.   SetFillStyle(SolidFill,1);
  591.   GetDefaultPalette(Pal);
  592.   SetAllPalette(Pal);
  593. {$ENDIF}
  594.  
  595.  {Here should be some terminal-detection for Linux}
  596.  nonupdatemode:=FALSE;
  597. {$IFNDEF UseGraphics}
  598.  HelpMode :=TRUE;
  599. {$ENDIF}
  600.  {$IFDEF Linux}
  601.   UseColor:=FALSE;
  602.  {$ELSE}
  603.   UseColor:=TRUE;
  604.  {$ENDIF}
  605.  ClrScr;
  606.  CursorOff;
  607.  RANDOMIZE;
  608.  HighX:=BaseX;
  609.  HighY:=BaseY;
  610.  CreateFiguresArray;                  { Load and precalculate a lot of stuff}
  611. {$IFNDEF UseGraphics}
  612.  IF UseColor THEN
  613.   Style:= ColorString
  614.  ELSE
  615.   Style:=DumbTermStr;
  616. {$ENDIF}
  617.  
  618.  NrFigures:=7;                        {Default standard tetris mode, only use
  619.                                         the first 7 standard figures}
  620.  CalculateTotalChance;                {Calculated the total of all weightfactors}
  621.  EndGame:=FALSE;                      {When TRUE, end of game has been detected}
  622.  FixHickup:=0;                        {Used to avoid unnecessary pauses with the "down key"}
  623.  CreateFrame;                         {Draws all background garbadge}
  624.  
  625.  TheFigure:=-1;
  626.  NextFigure:=GetNextFigure;              {Two figures have to be inited. The first
  627.                                         figure starts dropping, and that is this
  628.                                         one}
  629.  InitAFigure(TheFigure);              {The second figure is the figure to be
  630.                                        displayed as NEXT. That's this char :-)}
  631.  DisplMainField;                  {Display/update the grid}
  632.  Counter:=0;                          {counts up to IterationPerDelay}
  633.  DelayTime:=200;                      {Time of delay}
  634.  IterationPerDelay:=4;                {= # Delays per shift down of figure}
  635.  Lines:=0;                            {Lines that have disappeared}
  636.  Score:=0;
  637.  ShowLines;
  638.  REPEAT
  639.   IF KeyPressed THEN                  {The function name says it all}
  640.    BEGIN
  641.     Key:=ORD(READKEY);
  642.     IF Key=0 THEN                     {Function key?}
  643.      Key:=ORD(READKEY) SHL 8;
  644.     CASE Key OF                       {Check for all keys}
  645.      ArrU : BEGIN
  646.              Temp:=(FigureNr+3) AND 3;
  647.              IF ((TopX+LeftSizeArray[TheFigure][FigureNr])<0) THEN
  648.               BEGIN
  649.               IF  (LeftSizeArray[TheFigure][FigureNr]<=LeftSizeArray[TheFigure][Temp]) THEN
  650.                TurnFigure;
  651.               END
  652.              ELSE
  653.              IF (TopX+7-RightSizeArray[TheFigure][FigureNr])>TheWidth THEN
  654.               BEGIN
  655.               IF  (RightSizeArray[TheFigure][FigureNr]<=RightSizeArray[TheFigure][Temp]) THEN
  656.                TurnFigure;
  657.               END
  658.              ELSE
  659.               TurnFigure;
  660.            END;
  661.  
  662.     ArrL  : BEGIN
  663.              IF (TopX+LeftSizeArray[TheFigure][FigureNr])>=0 THEN
  664.               BEGIN
  665.                Temp:=TopX+1-LeftSizeArray[TheFigure][FigureNr];
  666.                FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,TRUE);
  667.                IF MatchPosition(Figures[TheFigure][FigureNr],TopX-1,TopY) THEN
  668.                 DEC(TopX);
  669.                FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,FALSE);
  670.               END;
  671.              END;
  672.  
  673.     ArrR  : BEGIN
  674.              IF (TopX+7-RightSizeArray[TheFigure][FigureNr])<=TheWidth THEN
  675.               BEGIN
  676.                FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,TRUE);
  677.                IF MatchPosition(Figures[TheFigure][FigureNr],TopX+1,TopY) THEN
  678.                 INC(TopX);
  679.                FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,FALSE);
  680.               END;
  681.              END;
  682.  
  683.     ArrD  : BEGIN
  684.              IF FixHickup=0 THEN
  685.               BEGIN
  686.              FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,TRUE);
  687.              Temp:=TopY;
  688.              WHILE MatchPosition(Figures[TheFigure][FigureNr],TopX,TopY+1) DO
  689.               INC(TopY);
  690.              Temp:=TopY-Temp;
  691.              INC(Score,Temp DIV 2);
  692.              FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,FALSE);
  693.              FixHickUp:=4;
  694.              END;
  695.             END;
  696.  
  697. ORD('q'),
  698.    ESC     : BEGIN
  699.              SetDefaultColor;
  700.              GotoXY(1,25);
  701.              EndGame:=TRUE;
  702.             END;
  703.  
  704. {$IFNDEF UseGraphics}
  705. ORD('C'),
  706.  ORD('c') : BEGIN
  707.              UseColor:=NOT UseColor;
  708.              IF UseColor THEN
  709.               Style:= ColorString
  710.              ELSE
  711.               BEGIN
  712.                SetDefaultColor;
  713.                Style:=DumbTermStr;
  714.               END;
  715.              CreateFrame;
  716.              RedrawScreen;
  717.              DisplMainField;
  718.             END;
  719.  ORD('S'),
  720.   ORD('s') : BEGIN
  721.               IF NOT nonupdatemode THEN
  722.                BEGIN
  723.                 NonUpdateMode:=TRUE;
  724.                 helpmode:=NOT helpmode;
  725.                END
  726.               ELSE
  727.                 HelpMode:=NOT helpmode;
  728.                CreateFrame;
  729.                ShowLines;
  730.                ShowNextFigure(NextFigure);
  731.               END;
  732. {$ENDIF}
  733. ORD('H'),
  734.  ORD('h') : BEGIN
  735.              nonupdatemode:=NOT nonupdatemode;
  736.              CreateFrame;
  737.              ShowLines;
  738.              ShowNextFigure(NextFigure);
  739.             END;
  740. ORD('E'),
  741.  ORD('e'): BEGIN                            {Extra figures on/off}
  742.             IF NrFigures<>NrFiguresLoaded THEN
  743.               NrFigures:=NrFiguresLoaded     {Extra figures}
  744.             ELSE
  745.               NrFigures:=7;                   {Standard Tetris figures}
  746.             CalculateTotalChance;             {Recalculate weight-totals}
  747.             IF UseColor THEN
  748.              SetDefaultColor;
  749.             ShowGameMode;
  750.            END;
  751.  
  752. ORD('p') : BEGIN                             {"p" : Pause}
  753.              Key:=ORD(ReadKey);
  754.             IF Key=0 THEN
  755.              Key:=ORD(ReadKey);
  756.            END;
  757. {$IFNDEF UseGraphics}
  758. {$IFDEF Linux}
  759.  ORD('i')  : write(#27+'(K');
  760. {$ENDIF}
  761. {$ENDIF}
  762.         END; {END OF Key CASE}
  763.       END { OF If KeyPressed}
  764.  
  765.   ELSE
  766.    BEGIN
  767.     {$IFDEF Linux}
  768.      GotoXY(50,10);      {Get cursor out of the way, CursorOn/Off
  769.                             doesn't work on telnet-terminals}
  770.     {$ENDIF}
  771.     Delay(DelayTime);
  772.    END;
  773.  
  774.   INC(Counter);
  775.   IF (Counter=IterationPerDelay) OR (FixHickup=1) THEN
  776.    BEGIN
  777.     IF FixHickup=1 THEN
  778.       Counter:=IterationPerDelay-1
  779.     ELSE
  780.      Counter:=0;
  781.     FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,TRUE);
  782.     FixHickup:=0;
  783.     IF MatchPosition(Figures[TheFigure][FigureNr],TopX,TopY+1) THEN
  784.      BEGIN
  785.       INC(TopY);
  786.       FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,FALSE);
  787.      END
  788.     ELSE
  789.     BEGIN
  790.       FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,FALSE);
  791.       FixColField(TheFigure);
  792.       IF InitAFigure(TheFigure) THEN
  793.         BEGIN
  794.          FixMainFieldLines;
  795.          FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,FALSE);
  796.          DisplMainField;
  797.          Delay(DelayTime*IterationPerDelay);
  798.         END
  799.       ELSE
  800.        BEGIN
  801.         FixFigureInField(Figures[TheFigure][FigureNr],TopX,TopY,FALSE);
  802.         EndGame:=TRUE;
  803.        END;
  804.     END;
  805.    END
  806.   ELSE
  807.    IF FixHickup>1 THEN
  808.     DEC(FixHickup);
  809.  DisplMainField;
  810.  UNTIL EndGame;
  811.  FixHighScores;
  812.  CursorOn;
  813.  SetDefaultColor;
  814.  GotoXY(1,25);
  815.  {$IFDEF UseGraphics}
  816.   TextMode(CO80);
  817.  {$ENDIF}
  818. END;
  819.  
  820. CONST FileName='fpctris.scr';
  821.  
  822. VAR I : LONGINT;
  823.  
  824. BEGIN
  825.  FOR I:=0 TO 9 DO
  826.   HighScore[I].Score:=(I+1)*750;
  827.  LoadHighScore(FileName);
  828.  DoFpcTris;
  829.  SaveHighScore;
  830. END.
  831.  
  832. {
  833.   $Log: fpctris.pp,v $
  834.   Revision 1.1  2000/03/09 02:40:03  alex
  835.   moved files
  836.  
  837.   Revision 1.7  2000/02/22 03:36:48  alex
  838.   fixed the warning
  839.  
  840.   Revision 1.5  2000/01/21 00:44:51  peter
  841.     * remove unused vars
  842.     * renamed to .pp
  843.  
  844.   Revision 1.4  2000/01/14 22:03:07  marco
  845.    * Changed some comments
  846.  
  847.   Revision 1.3  1999/12/31 17:03:50  marco
  848.  
  849.  
  850.   Graphical version +2fixes
  851.  
  852.   Revision 1.2  1999/06/01 19:24:32  peter
  853.     * updates from marco
  854.  
  855.   Revision 1.1  1999/05/27 21:36:33  peter
  856.     * new demo's
  857.     * fixed mandel for linux
  858.  
  859. }
  860.