home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / vp21beta.zip / OEXMPSRC.RAR / TRIPLEX / TRIPLEX.PAS < prev    next >
Pascal/Delphi Source File  |  2000-08-15  |  21KB  |  609 lines
  1. {█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
  2. {█                                                       █}
  3. {█      Virtual Pascal Examples. Version 2.1.            █}
  4. {█      TRIPLEX: Presentation Manager Game.              █}
  5. {█      ─────────────────────────────────────────────────█}
  6. {█      Copyright (C) 1995-2000 vpascal.com              █}
  7. {█                                                       █}
  8. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  9.  
  10. { Original DOS version of this program is written by      }
  11. { Pavel Molodchick (Åáóѽ î«½«ñτ¿¬). Object oriented      }
  12. { version for Presentation Manager by Vitaly Miryanov.    }
  13.  
  14. program Triplex;
  15.  
  16. {$PMTYPE PM}
  17. {&Use32+}
  18. {$R *.RES}
  19.  
  20. uses
  21.   Os2Def, Os2PmApi, PmObj;
  22.  
  23. type
  24.   TriangleColor = (Blue, Green, Red, Hidden);
  25.  
  26. const
  27.   cmNewGame     = 10101;
  28.   cmExit        = 10102;
  29.   cmAbout       = 10201;
  30.   idAbout       = 11001;
  31.  
  32. const
  33.   idTimer       = 1;            { PM timer id                                 }
  34.   LevelDeley    = 500;          { Decrease this delay to speed up game        }
  35.   TimerScale    = 10;           { LevelDeley*TimerScale gives delay in msecs  }
  36.   WellWidth     = 12;           { Width of the well in triangles              }
  37.   WellHeight    = 41;           { Height of the well in triangles             }
  38.   WallColor     = Blue;         { Color of the walls of the well              }
  39.   FallenColor   = Green;        { Color of the fallen triangles               }
  40.   NewColor      = Red;          { Color of the new triangle                   }
  41.  
  42.   TriplexFlags = fcf_TitleBar + fcf_SysMenu + fcf_Menu + fcf_SizeBorder +
  43.                  fcf_MinMax + fcf_TaskList + fcf_Icon;
  44.  
  45. { Position of the triangular cell }
  46.  
  47. type
  48.   Cell = record
  49.     X,Y: ShortInt;
  50.   end;
  51.  
  52. { Figure }
  53.  
  54.   Figure = record
  55.     No: Integer;                { Number of triangles in the figure }
  56.     Body: array[1..6] of Cell;  { Position of the triangles         }
  57.   end;
  58.  
  59. { Main game window }
  60.  
  61.   PTriplexWindow = ^TTriplexWindow;
  62.   TTriplexWindow = object(PMWindow)
  63.     R: RectL;
  64.     PS: HPS;
  65.     NextFigure: Integer;
  66.     Filled: Integer;
  67.     TimerCount: Integer;
  68.     Scale: PointL;
  69.     WellPos: PointL;
  70.     CurPos: Cell;
  71.     FigurePresent,GameOver: Boolean;
  72.     CurrentFigure: Figure;
  73.     Field: array[1..WellWidth,1..WellHeight] of Byte;
  74.     function HandleMessage(Window: HWnd; Msg: ULong; Mp1,Mp2 : MParam): MResult; virtual;
  75.     procedure StartupAction; virtual;
  76.     procedure ShowTriangle(X,Y: Integer;  Color: TriangleColor);
  77.     procedure ShowFigure(X,Y: Integer; var Fig: Figure; Color: TriangleColor);
  78.     procedure RotateFigure(var Fig: Figure);
  79.     procedure MirrorFigure(var Fig: Figure);
  80.     function  MoveAllowed(X,Y,Rotate: Integer; Mirror: Boolean): Boolean;
  81.     procedure MoveFigure(X,Y,Rotate: Integer; Mirror: Boolean);
  82.     procedure Melt;
  83.     procedure DrawWell;
  84.     procedure ReDraw(Window: HWnd);
  85.     procedure DrawNext(Color: TriangleColor);
  86.     procedure DrawFallen;
  87.   end;
  88.  
  89.   TriplexApplication = object(PMApplication)
  90.     MainWindow: PTriplexWindow;
  91.     constructor Init;
  92.     destructor Done; virtual;
  93.   end;
  94.  
  95. const
  96.   FigureSet: array[1..32] of Figure = (
  97.     (No:1; Body:((X:4; Y:8 ), (X:0; Y:0 ), (X:0; Y:0 ), (X:0; Y:0 ), (X:0; Y:0 ), (X:0; Y:0 ))),
  98.     (No:2; Body:((X:4; Y:8 ), (X:5; Y:8 ), (X:0; Y:0 ), (X:0; Y:0 ), (X:0; Y:0 ), (X:0; Y:0 ))),
  99.     (No:3; Body:((X:4; Y:8 ), (X:5; Y:8 ), (X:5; Y:9 ), (X:0; Y:0 ), (X:0; Y:0 ), (X:0; Y:0 ))),
  100.     (No:4; Body:((X:3; Y:9 ), (X:4; Y:9 ), (X:4; Y:10), (X:4; Y:8 ), (X:0; Y:0 ), (X:0; Y:0 ))),
  101.     (No:4; Body:((X:4; Y:8 ), (X:5; Y:8 ), (X:5; Y:9 ), (X:6; Y:9 ), (X:0; Y:0 ), (X:0; Y:0 ))),
  102.     (No:4; Body:((X:4; Y:7 ), (X:4; Y:8 ), (X:5; Y:8 ), (X:5; Y:9 ), (X:0; Y:0 ), (X:0; Y:0 ))),
  103.     (No:4; Body:((X:4; Y:8 ), (X:5; Y:8 ), (X:5; Y:9 ), (X:5; Y:10), (X:0; Y:0 ), (X:0; Y:0 ))),
  104.     (No:5; Body:((X:3; Y:9 ), (X:4; Y:9 ), (X:4; Y:10), (X:4; Y:8 ), (X:5; Y:8 ), (X:0; Y:0 ))),
  105.     (No:5; Body:((X:3; Y:9 ), (X:4; Y:9 ), (X:4; Y:10), (X:4; Y:8 ), (X:4; Y:7 ), (X:0; Y:0 ))),
  106.     (No:5; Body:((X:4; Y:7 ), (X:4; Y:8 ), (X:5; Y:8 ), (X:5; Y:9 ), (X:6; Y:9 ), (X:0; Y:0 ))),
  107.     (No:5; Body:((X:5; Y:8 ), (X:5; Y:9 ), (X:5; Y:10), (X:4; Y:10), (X:4; Y:9 ), (X:0; Y:0 ))),
  108.     (No:5; Body:((X:3; Y:9 ), (X:4; Y:9 ), (X:4; Y:10), (X:5; Y:10), (X:5; Y:9 ), (X:0; Y:0 ))),
  109.     (No:5; Body:((X:4; Y:7 ), (X:4; Y:8 ), (X:5; Y:8 ), (X:5; Y:9 ), (X:5; Y:10), (X:0; Y:0 ))),
  110.     (No:6; Body:((X:5; Y:8 ), (X:5; Y:9 ), (X:5; Y:10), (X:4; Y:8 ), (X:4; Y:9 ), (X:4; Y:10))),
  111.     (No:6; Body:((X:4; Y:11), (X:4; Y:10), (X:5; Y:10), (X:5; Y:9 ), (X:6; Y:9 ), (X:6; Y:8 ))),
  112.     (No:6; Body:((X:3; Y:11), (X:4; Y:11), (X:4; Y:10), (X:5; Y:10), (X:5; Y:9 ), (X:6; Y:9 ))),
  113.     (No:6; Body:((X:4; Y:9 ), (X:4; Y:10), (X:5; Y:10), (X:5; Y:9 ), (X:5; Y:8 ), (X:5; Y:7 ))),
  114.     (No:6; Body:((X:3; Y:9 ), (X:4; Y:9 ), (X:4; Y:10), (X:5; Y:10), (X:5; Y:9 ), (X:5; Y:8 ))),
  115.     (No:6; Body:((X:4; Y:11), (X:4; Y:10), (X:5; Y:10), (X:5; Y:9 ), (X:4; Y:9 ), (X:5; Y:8 ))),
  116.     (No:6; Body:((X:4; Y:10), (X:5; Y:10), (X:5; Y:9 ), (X:6; Y:9 ), (X:4; Y:9 ), (X:5; Y:8 ))),
  117.     (No:6; Body:((X:4; Y:9 ), (X:4; Y:8 ), (X:4; Y:11), (X:4; Y:10), (X:5; Y:10), (X:5; Y:9 ))),
  118.     (No:6; Body:((X:4; Y:11), (X:4; Y:10), (X:5; Y:10), (X:5; Y:9 ), (X:5; Y:8 ), (X:5; Y:7 ))),
  119.     (No:6; Body:((X:4; Y:11), (X:4; Y:10), (X:5; Y:10), (X:5; Y:9 ), (X:6; Y:9 ), (X:4; Y:9 ))),
  120.     (No:6; Body:((X:4; Y:11), (X:4; Y:10), (X:5; Y:10), (X:5; Y:9 ), (X:6; Y:9 ), (X:5; Y:8 ))),
  121.     (No:6; Body:((X:4; Y:7 ), (X:4; Y:8 ), (X:4; Y:9 ), (X:4; Y:10), (X:5; Y:7 ), (X:5; Y:8 ))),
  122.     (No:6; Body:((X:4; Y:7 ), (X:4; Y:8 ), (X:5; Y:7 ), (X:5; Y:8 ), (X:5; Y:9 ), (X:5; Y:10))),
  123.     (No:6; Body:((X:4; Y:9 ), (X:4; Y:10), (X:5; Y:10), (X:5; Y:9 ), (X:6; Y:9 ), (X:6; Y:8 ))),
  124.     (No:6; Body:((X:5; Y:8 ), (X:3; Y:11), (X:4; Y:11), (X:4; Y:10), (X:5; Y:10), (X:5; Y:9 ))),
  125.     (No:6; Body:((X:3; Y:9 ), (X:4; Y:9 ), (X:4; Y:8 ), (X:4; Y:11), (X:4; Y:10), (X:5; Y:10))),
  126.     (No:6; Body:((X:4; Y:10), (X:5; Y:10), (X:5; Y:9 ), (X:6; Y:9 ), (X:6; Y:8 ), (X:5; Y:8 ))),
  127.     (No:6; Body:((X:4; Y:9 ), (X:4; Y:10), (X:5; Y:10), (X:5; Y:9 ), (X:6; Y:9 ), (X:6; Y:10))),
  128.     (No:6; Body:((X:4; Y:9 ), (X:4; Y:8 ), (X:5; Y:8 ), (X:5; Y:9 ), (X:6; Y:9 ), (X:6; Y:8 ))));
  129.  
  130.   RotateMap: array[1..8,1..15] of Cell = ( { +60° }
  131.     ((X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:0;Y:0),
  132.      (X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:0;Y:0)),
  133.     ((X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:2;Y:11),(X:2;Y:12),(X:3;Y:12),
  134.      (X:3;Y:13),(X:4;Y:13),(X:4;Y:14),(X:5;Y:14),(X:0;Y:0),(X:0;Y:0),(X:0;Y:0)),
  135.     ((X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:2;Y:9),(X:2;Y:10),(X:3;Y:10),(X:3;Y:11),
  136.      (X:4;Y:11),(X:4;Y:12),(X:5;Y:12),(X:5;Y:13),(X:6;Y:13),(X:0;Y:0),(X:0;Y:0)),
  137.     ((X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:2;Y:7),(X:2;Y:8),(X:3;Y:8),(X:3;Y:9),(X:4;Y:9),
  138.      (X:4;Y:10),(X:5;Y:10),(X:5;Y:11),(X:6;Y:11),(X:6;Y:12),(X:7;Y:12),(X:0;Y:0)),
  139.     ((X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:2;Y:6),(X:3;Y:6),(X:3;Y:7),(X:4;Y:7),(X:4;Y:8),
  140.      (X:5;Y:8),(X:5;Y:9),(X:6;Y:9),(X:6;Y:10),(X:7;Y:10),(X:7;Y:11),(X:0;Y:0)),
  141.     ((X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:3;Y:5),(X:4;Y:5),(X:4;Y:6),(X:5;Y:6),
  142.      (X:5;Y:7),(X:6;Y:7),(X:6;Y:8),(X:7;Y:8),(X:7;Y:9),(X:0;Y:0),(X:0;Y:0)),
  143.     ((X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:4;Y:4),(X:5;Y:4),(X:5;Y:5),
  144.      (X:6;Y:5),(X:6;Y:6),(X:7;Y:6),(X:7;Y:7),(X:0;Y:0),(X:0;Y:0),(X:0;Y:0)),
  145.     ((X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:0;Y:0),
  146.      (X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:0;Y:0),(X:0;Y:0)));
  147.  
  148. { Dialog window procedure for Help│About dialog }
  149.  
  150. function DlgProc(Window: HWnd; Msg: ULong; Mp1,Mp2: MParam): MResult; cdecl; export;
  151. var
  152.   Swap: Swp;
  153. begin
  154.   DlgProc := 0;
  155.   case Msg of
  156.     { when the dialog is being initialized, center it on desktop }
  157.     wm_InitDlg:
  158.       begin
  159.         WinQueryWindowPos(Window, Swap);
  160.         WinSetWindowPos(Window, 0, (DesktopSize.X - Swap.cX) div 2,
  161.           (DesktopSize.Y - Swap.cY) div 2, 0, 0, swp_Move);
  162.       end;
  163.     { if system message is received then dismiss the dialog box }
  164.     wm_Command:
  165.       begin
  166.         WinDismissDlg(Window, ulTrue);
  167.         Exit;
  168.       end;
  169.   end;
  170.   DlgProc := WinDefDlgProc(Window, Msg, Mp1, Mp2);
  171. end;
  172.  
  173. { TriplexApplication }
  174.  
  175. constructor TriplexApplication.Init;
  176. begin
  177.   inherited Init;
  178.   MainWindow := New(PTriplexWindow, Init('Triplex Game', 'Triplex', TriplexFlags));
  179. end;
  180.  
  181. destructor TriplexApplication.Done;
  182. begin
  183.   Dispose(MainWindow, Done);
  184.   inherited Done;
  185. end;
  186.  
  187. { TTriplexWindow }
  188.  
  189. procedure TTriplexWindow.StartupAction;
  190. var
  191.   Color: TriangleColor;
  192. begin
  193.   WinStartTimer(Anchor, ClientWindow, idTimer, LevelDeley);
  194.   Randomize;
  195.   NextFigure := Random(32) + 1;
  196.   WinSetWindowPos(FrameWindow, 0, { Normal window size = 1/4 of a screen }
  197.     DesktopSize.X div 4, DesktopSize.Y div 4,
  198.     DesktopSize.X div 2, DesktopSize.Y div 2, swp_Move + swp_Size);
  199.   WinSetWindowPos(FrameWindow, 0, 0,0,0,0, swp_Maximize+swp_Activate+swp_Show);
  200. end;
  201.  
  202. function TTriplexWindow.HandleMessage(Window: HWnd; Msg: ULong; Mp1,Mp2 : MParam): MResult;
  203. var
  204.   X,Y: Integer;
  205. begin
  206.   HandleMessage := 0;
  207.   case Msg of
  208.     wm_Timer:
  209.       if not GameOver then
  210.       if TimerCount <> 0 then Dec(TimerCount)
  211.      else
  212.       begin
  213.         TimerCount := TimerScale;
  214.         PS := WinGetPS(Window);
  215.         if not FigurePresent then
  216.         begin
  217.           FigurePresent := True;
  218.           CurPos.X := 2;
  219.           CurPos.Y := -2;
  220.           CurrentFigure := FigureSet[NextFigure];
  221.           DrawNext(Hidden);             { Erase old next figure }
  222.           NextFigure := Random(32)+1;
  223.           DrawNext(NewColor);           { Show new next figure  }
  224.           if MoveAllowed(0,0,0,False) then ShowFigure(CurPos.X,CurPos.Y,CurrentFigure,NewColor)
  225.          else
  226.           begin
  227.             for X := 2 to WellWidth - 1 do
  228.             for Y := 1 to WellHeight - 1 do Field[X,Y] := 1;
  229.             WinInvalidateRect(Window, nil, False);
  230.             GameOver := True;
  231.           end;
  232.         end
  233.       else                      { Figure exists }
  234.         begin
  235.           if MoveAllowed(0,1,0,False) and MoveAllowed(0,2,0,False) then MoveFigure(0,2,0,False)
  236.             else DrawFallen;
  237.         end;
  238.         WinReleasePS(PS);
  239.       end;
  240.  
  241.     wm_Char:
  242.       if (CharMsgMp1(Mp1).fs and kc_KeyUp) = 0 then { Key is Down }
  243.       if not GameOver then
  244.       begin
  245.         PS := WinGetPS(Window);
  246.         case CharMsgMp2(Mp2).VKey of
  247.           vk_Space:             { Drop current figure }
  248.             begin
  249.               while MoveAllowed(0,1,0,False) and MoveAllowed(0,2,0,False) do MoveFigure(0,2,0,False);
  250.               DrawFallen;
  251.             end;
  252.  
  253.           vk_Down:              { Move the figure down }
  254.             if MoveAllowed(0,1,0,False) and MoveAllowed(0,2,0,False) then MoveFigure(0,2,0,False);
  255.  
  256.            vk_Left:             { Move the figure to the left }
  257.              if (CharMsgMp1(Mp1).fs and kc_Shift) = 0 then
  258.              begin
  259.                if MoveAllowed(-1,1,0,False) then MoveFigure(-1,1,0,False);
  260.              end
  261.             else
  262.              while MoveAllowed(-2,0,0,False) and MoveAllowed(-1,0,0,False) do MoveFigure(-2,0,0,False);
  263.  
  264.            vk_Right:            { Move the figure to the right }
  265.              if (CharMsgMp1(Mp1).fs and kc_Shift) = 0 then
  266.              begin
  267.                if MoveAllowed(1,1,0,False) then MoveFigure(1,1,0,False);
  268.              end
  269.             else
  270.              while MoveAllowed(2,0,0,False) and MoveAllowed(1,0,0,False) do MoveFigure(2,0,0,False);
  271.  
  272.            vk_Up:               { Rotate the figure }
  273.              begin
  274.                if (CharMsgMp1(Mp1).fs and kc_Shift) = 0 then
  275.                begin
  276.                  if MoveAllowed(0,0,1,False) then MoveFigure(0,0,1,False);
  277.                end
  278.               else if MoveAllowed(0,0,5,False) then MoveFigure(0,0,5,False);
  279.              end;
  280.                                 { Mirror transformation }
  281.            vk_Tab: if MoveAllowed(0,0,0,True) then MoveFigure(0,0,0,True);
  282.  
  283.         end;
  284.  
  285.         WinReleasePS(PS);
  286.       end;
  287.  
  288.     wm_Paint:
  289.       begin
  290.         PS := WinBeginPaint(Window,0,nil);
  291.         ReDraw(Window);
  292.         WinEndPaint(PS);
  293.       end;
  294.  
  295.     wm_Command:
  296.       case SmallWord(Mp1) of
  297.         cmNewGame:
  298.           begin
  299.             PS := WinGetPS(Window);
  300.             Filled := 0;
  301.             TimerCount := 0;
  302.             GameOver := False;
  303.             CurrentFigure.No := 0;
  304.             FillChar(Field, SizeOf(Field), 0);
  305.             ReDraw(Window);
  306.             FigurePresent := False;
  307.             WinReleasePS(PS);
  308.           end;
  309.  
  310.         cmExit:  WinPostMsg(0, wm_Quit, 0, 0);
  311.         cmAbout: WinDlgBox(hwnd_Desktop, Window, DlgProc, 0, idAbout, nil);
  312.       end;
  313.  
  314.     wm_Destroy: WinStopTimer(Anchor, ClientWindow, idTimer);
  315.  
  316.     else HandleMessage := WinDefWindowProc(Window, Msg, Mp1, Mp2);
  317.    end;
  318. end;
  319.  
  320. { Draws triangle }
  321.  
  322. procedure TTriplexWindow.ShowTriangle(X,Y: Integer; Color: TriangleColor);
  323. var
  324.   X1,Y1: Integer;
  325.   XBias: Integer;
  326.   Vertex: array [1..3] of PointL;
  327. const
  328.   ColorMap: array[TriangleColor] of Byte = (clr_Blue,clr_Green,clr_Red,clr_PaleGray);
  329. begin
  330.   Y := WellHeight - Y;
  331.   if (Odd(X) <> Odd(Y))
  332.     then
  333.     begin
  334.       Vertex[3].X := X * Scale.X * 2 + WellPos.X - Scale.X+1; { LEFT }
  335.       Vertex[3].Y := Y * Scale.Y + WellPos.Y;
  336.       Vertex[1].X := Vertex[3].X + 2 * Scale.X - 2;
  337.       Vertex[1].Y := Vertex[3].Y - Scale.Y + 1;
  338.       Vertex[2].X := Vertex[1].X;
  339.       Vertex[2].Y := Vertex[1].Y + 2 * Scale.Y - 2;
  340.       XBias := -1;
  341.     end
  342.    else
  343.     begin
  344.       Vertex[3].X := X * Scale.X * 2+ WellPos.X + Scale.X - 1; { RIGHT }
  345.       Vertex[3].Y := Y * Scale.Y + WellPos.Y;
  346.       Vertex[2].X := Vertex[3].X - 2 * Scale.X + 2;
  347.       Vertex[2].Y := Vertex[3].Y + Scale.Y - 1;
  348.       Vertex[1].X := Vertex[2].X;
  349.       Vertex[1].Y := Vertex[2].Y - 2 * Scale.Y + 2;
  350.       XBias := 1;
  351.     end;
  352.     if Color <> Hidden then
  353.     begin
  354.       GpiSetColor(PS,clr_Black);
  355.       GpiMove(PS, Vertex[3]);                { Move to starting point }
  356.       GpiPolyLine(PS, 3, Vertex[1]);         { Draw 3 sides           }
  357.       Inc(Vertex[1].X,XBias); Inc(Vertex[1].Y,1);
  358.       Inc(Vertex[2].X,XBias); Dec(Vertex[2].Y,1);
  359.       Dec(Vertex[3].X,XBias);
  360.       if Scale.Y >= 4 then
  361.       begin
  362.         GpiSetColor(PS,clr_Black);
  363.         GpiMove(PS, Vertex[3]);
  364.         GpiPolyLine(PS, 3, Vertex[1]);
  365.         Inc(Vertex[1].X,XBias); Inc(Vertex[1].Y,1);
  366.         Inc(Vertex[2].X,XBias); Dec(Vertex[2].Y,1);
  367.         Dec(Vertex[3].X,XBias);
  368.       end;
  369.       if Scale.Y >= 6 then
  370.       begin
  371.         GpiSetColor(PS,clr_White);
  372.         GpiMove(PS, Vertex[3]);
  373.         GpiPolyLine(PS, 3, Vertex[1]);
  374.         Inc(Vertex[1].X,XBias); Inc(Vertex[1].Y,1);
  375.         Inc(Vertex[2].X,XBias); Dec(Vertex[2].Y,1);
  376.         Dec(Vertex[3].X,XBias);
  377.       end;
  378.     end
  379.       else
  380.         Inc(Vertex[3].X, XBias);
  381.     GpiSetColor(PS,ColorMap[Color]);
  382.     GpiBeginPath(PS, 1);                   { Start the path bracket }
  383.     GpiMove(PS, Vertex[3]);                { Move to starting point }
  384.     GpiPolyLine(PS, 2, Vertex[1]);         { Draw two sides         }
  385.     GpiEndPath(PS);                        { End the path bracket   }
  386.     GpiFillPath(PS, 1, fpath_Alternate);   { Draw and fill the path }
  387. end;
  388.  
  389. { Draws the figure }
  390.  
  391. procedure TTriplexWindow.ShowFigure(X,Y: Integer; var Fig: Figure; Color: TriangleColor);
  392. var
  393.   I,X1,Y1: Integer;
  394. begin
  395.   for I := 1 to Fig.No do
  396.   begin
  397.     X1 := X + Fig.Body[I].X;
  398.     Y1 := Y + Fig.Body[I].Y;
  399.     ShowTriangle(X1,Y1,Color);
  400.     if Color = FallenColor then Field[X1,Y1] := 1;
  401.   end;
  402. end;
  403.  
  404. { Rotates the figure }
  405.  
  406. procedure TTriplexWindow.RotateFigure(var Fig: Figure);
  407. var
  408.   I,X,Y: Integer;
  409. begin
  410.   for I := 1 to Fig.No do
  411.   begin
  412.     X := RotateMap[Fig.Body[I].X, Fig.Body[I].Y].X;
  413.     Y := RotateMap[Fig.Body[I].X, Fig.Body[I].Y].Y;
  414.     Fig.Body[I].X := X;
  415.     Fig.Body[I].Y := Y;
  416.   end;
  417. end;
  418.  
  419. { Mirror transformation }
  420.  
  421. procedure TTriplexWindow.MirrorFigure(var Fig: Figure);
  422. var
  423.   I: Integer;
  424. begin
  425.   for I := 1 to Fig.No do Fig.Body[I].X := 9 - Fig.Body[I].X;
  426. end;
  427.  
  428. { Checks whether it is possible to move the figure }
  429.  
  430. function TTriplexWindow.MoveAllowed(X,Y,Rotate: Integer; Mirror: Boolean): Boolean;
  431. var
  432.   Fig: Figure;
  433.   I: Integer;
  434. begin
  435.   Fig := CurrentFigure;
  436.   Inc(X,CurPos.X);
  437.   Inc(Y,CurPos.Y);
  438.   while Rotate > 0 do
  439.   begin
  440.     RotateFigure(Fig);
  441.     Dec(Rotate);
  442.   end;
  443.   if Mirror then MirrorFigure(Fig);
  444.   MoveAllowed := True;
  445.   for I := 1 to Fig.No do
  446.     if (X+Fig.Body[I].X > WellWidth ) or (X+Fig.Body[I].X < 1) or { X not within field  }
  447.        (Y+Fig.Body[I].Y > WellHeight) or (Y+Fig.Body[I].Y < 1)    { Y not within field  }
  448.       then MoveAllowed := False                                   { Fallen figure exists}
  449.       else if Field[X+Fig.Body[I].X,Y+Fig.Body[I].Y] <> 0 then MoveAllowed := False;
  450. end;
  451.  
  452. { Moves the figure }
  453.  
  454. procedure TTriplexWindow.MoveFigure(X,Y,Rotate: Integer; Mirror: Boolean);
  455. var
  456.   I,J: Integer;
  457.   OldPos: Cell;
  458.   OldHide,NewDraw: array[1..6] of Boolean;
  459.   OldFigure: Figure;
  460. begin
  461.   OldFigure := CurrentFigure;
  462.   OldPos := CurPos;
  463.   { Move or transform the figure }
  464.   Inc(CurPos.X,X);
  465.   Inc(CurPos.Y,Y);
  466.   while Rotate > 0 do
  467.   begin
  468.     RotateFigure(CurrentFigure);
  469.     Dec(Rotate);
  470.   end;
  471.   if Mirror then MirrorFigure(CurrentFigure);
  472.   for I := 1 to 6 do
  473.   begin
  474.     OldHide[I] := True;
  475.     NewDraw[I] := True;
  476.   end;
  477.   { Compare Old figure with a new one }
  478.   for I := 1 to OldFigure.No do
  479.   for J := 1 to CurrentFigure.No do
  480.   if (OldPos.X + OldFigure.Body[I].X = CurPos.X + CurrentFigure.Body[J].X) and
  481.      (OldPos.Y + OldFigure.Body[I].Y = CurPos.Y + CurrentFigure.Body[J].Y) then
  482.   begin
  483.     OldHide[I] := False;
  484.     NewDraw[J] := False;
  485.   end;
  486.   { Hide Old figure }
  487.   for I := 1 to OldFigure.No do if OldHide[I] then
  488.     ShowTriangle(OldPos.X+OldFigure.Body[I].X,OldPos.Y+OldFigure.Body[I].Y,Hidden);
  489.   { Show New figure }
  490.   for i := 1 to CurrentFigure.No do if NewDraw[I] then
  491.     ShowTriangle(CurPos.X+CurrentFigure.Body[I].X,CurPos.Y+CurrentFigure.Body[I].Y,NewColor);
  492.   TimerCount := TimerScale;
  493. end;
  494.  
  495. { Deletes row that is filled competely }
  496.  
  497. procedure TTriplexWindow.Melt;
  498. var
  499.   X,Y,I: Integer;
  500.   Flag: Boolean;
  501. begin
  502.   for Y := 1 to WellHeight-1 do
  503.   begin
  504.     Flag := True;
  505.     for X := 2 to WellWidth-1 do if Field[X,Y] = 0 then Flag := False;
  506.     if Flag then
  507.     begin
  508.       Inc(Filled);
  509.       for X := 2 to WellWidth - 1 do
  510.       begin
  511.         ShowTriangle(X,Y, Hidden);      { Hide triangle }
  512.         Field[X,Y] := 0;
  513.         for I := Y - 1 downto 1 do
  514.         if Field[X,I] = 1 then
  515.         begin
  516.           ShowTriangle(X,I, Hidden);       Field[X,I] := 0;
  517.           ShowTriangle(X,I+1,FallenColor); Field[X,I+1] := 1;
  518.         end;
  519.       end;
  520.     end;
  521.   end;
  522. end;
  523.  
  524. { Draws the well }
  525.  
  526. procedure TTriplexWindow.DrawWell;
  527. var
  528.   I: Integer;
  529. begin
  530.   for I := 1 to WellHeight do
  531.   begin
  532.     ShowTriangle(1,I,WallColor);               { Walls }
  533.     ShowTriangle(WellWidth,I,WallColor);
  534.     Field[1,I] := 1; Field[WellWidth,I] := 1;
  535.   end;
  536.   for I := 2 to WellWidth - 1 do               { Bottom line }
  537.   begin
  538.     ShowTriangle(I,WellHeight,WallColor);
  539.     Field[I,WellHeight] := 1;
  540.   end;
  541. end;
  542.  
  543. { Redraws entire window }
  544.  
  545. procedure TTriplexWindow.ReDraw(Window: HWnd);
  546. var
  547.   X,Y: Integer;
  548.   P: PointL;
  549. begin
  550.   WinQueryWindowRect(Window,R);
  551.   Scale.Y := (R.yTop - R.yBottom) div WellHeight;
  552.   Scale.X := Scale.Y;
  553.   WellPos.X := ((R.xRight - R.xLeft) - Scale.X * WellWidth) div 3;
  554.   WellPos.Y := 10;
  555.   WinFillRect(PS, R, clr_PaleGray);
  556.   DrawWell;
  557.   for X := 2 to WellWidth - 1 do
  558.   for Y := 2 to WellHeight - 1 do
  559.     if Field[X,Y] <> 0 then ShowTriangle(X,Y,FallenColor);
  560.   if not GameOver then
  561.   begin
  562.     ShowFigure(CurPos.X,CurPos.Y,CurrentFigure,NewColor);
  563.     DrawNext(NewColor);
  564.   end
  565.  else
  566.   begin
  567.     P.Y := (R.yTop - R.yBottom) div 2;
  568.     P.X := WellPos.X + Scale.X * 4;
  569.     GpiSetColor(PS, clr_Default);
  570.     GpiSetBackMix(PS, bm_OverPaint);
  571.     GpiCharStringAt(PS, P, 17, '*** GAME OVER ***');
  572.   end;
  573. end;
  574.  
  575. { Draws next figure, updates score }
  576.  
  577. procedure TTriplexWindow.DrawNext(Color: TriangleColor);
  578. var
  579.   S: String[10];
  580.   R1: RectL;
  581. begin
  582.   if not GameOver then
  583.     ShowFigure(-10,-2, FigureSet[NextFigure], Color); { Show/Hide next figure }
  584.   Str(Filled, S);
  585.   S := 'Score: ' + S;
  586.   R1.yBottom := (R.yTop - R.yBottom) div 3; R1.yTop := R1.yBottom + 20;
  587.   R1.xLeft := 0; R1.xRight := WellPos.X;
  588.   WinDrawText(PS,Length(S),@S[1],R1,clr_Black,clr_PaleGray,dt_Center+dt_EraseRect);
  589. end;
  590.  
  591. { Draws figure with a fallen color, deletes rows that are filled competely }
  592.  
  593. procedure TTriplexWindow.DrawFallen;
  594. begin
  595.   FigurePresent := False;
  596.   ShowFigure(CurPos.X, CurPos.Y, CurrentFigure, FallenColor);
  597.   Melt;
  598.   TimerCount := 0;
  599. end;
  600.  
  601. var
  602.   TriplexGame: TriplexApplication;
  603.  
  604. begin
  605.   TriplexGame.Init;
  606.   TriplexGame.Run;
  607.   TriplexGame.Done;
  608. end.
  609.