{█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
{█ █}
{█ Virtual Pascal Examples. Version 1.10 █}
{█ TRIPLEX: Presentation Manager Game. █}
{█ ─────────────────────────────────────────────────█}
{█ Copyright (C) 1995-96 fPrint UK Ltd █}
{█ █}
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
{ Original DOS version of this program is written by }
{ Pavel Molodchick (Åáóѽ «ñτ¿¬). Object oriented }
{ version for Presentation Manager by Vitaly Miryanov. }
program Triplex;
uses Os2Def, Os2PmApi, PmObj, Use32;
{$PMTYPE PM}
{$IFDEF VPDEMO}
{&Dynamic VP11Demo.Lib}
{$ENDIF}
{$R *.RES}
type
TriangleColor = (Blue, Green, Red, Hidden);
const
cmNewGame = 10101;
cmExit = 10102;
cmAbout = 10201;
idAbout = 11001;
const
idTimer = 1; { PM timer id }
LevelDeley = 10; { Decrease this delay to speed up game }
TimerScale = 10; { LevelDeley*TimerScale gives delay in msecs }
WellWidth = 12; { Width of the well in triangles }
WellHeight = 41; { Height of the well in triangles }
WallColor = Blue; { Color of the walls of the well }
FallenColor = Green; { Color of the fallen triangles }
NewColor = Red; { Color of the new triangle }
TriplexFlags = fcf_TitleBar + fcf_SysMenu + fcf_Menu + fcf_SizeBorder +
fcf_MinMax + fcf_TaskList + fcf_Icon;
{ Position of the triangular cell }
type
Cell = record
X,Y: ShortInt;
end;
{ Figure }
Figure = record
No: Integer; { Number of triangles in the figure }
Body: array[1..6] of Cell; { Position of the triangles }
end;
{ Main game window }
PTriplexWindow = ^TTriplexWindow;
TTriplexWindow = object(PMWindow)
R: RectL;
PS: HPS;
NextFigure: Integer;
Filled: Integer;
TimerCount: Integer;
Scale: PointL;
WellPos: PointL;
CurPos: Cell;
FigurePresent,GameOver: Boolean;
CurrentFigure: Figure;
Field: array[1..WellWidth,1..WellHeight] of Byte;
function HandleMessage(Window: HWnd; Msg: ULong; Mp1,Mp2 : MParam): MResult; virtual;
procedure StartupAction; virtual;
procedure ShowTriangle(X,Y: Integer; Color: TriangleColor);
procedure ShowFigure(X,Y: Integer; var Fig: Figure; Color: TriangleColor);
procedure RotateFigure(var Fig: Figure);
procedure MirrorFigure(var Fig: Figure);
function MoveAllowed(X,Y,Rotate: Integer; Mirror: Boolean): Boolean;
procedure MoveFigure(X,Y,Rotate: Integer; Mirror: Boolean);
procedure Melt;
procedure DrawWell;
procedure ReDraw(Window: HWnd);
procedure DrawNext(Color: TriangleColor);
procedure DrawFallen;
end;
TriplexApplication = object(PMApplication)
MainWindow: PTriplexWindow;
constructor Init;
destructor Done; virtual;
end;
const
FigureSet: array[1..32] of Figure = (
(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 ))),
(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 ))),
(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 ))),
(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 ))),
(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 ))),
(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 ))),
(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 ))),
(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 ))),
(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 ))),
(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 ))),
(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 ))),
(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 ))),
(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 ))),
(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))),
(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 ))),
(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 ))),
(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 ))),
(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 ))),
(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 ))),
(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 ))),
(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 ))),
(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 ))),
(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 ))),
(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 ))),
(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 ))),
(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))),
(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 ))),
(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 ))),
(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))),
(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 ))),
(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))),
(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 ))));
RotateMap: array[1..8,1..15] of Cell = ( { +60° }
((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),
(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),(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),
(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)),
((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),
(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)),
((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),
(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)),
((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),
(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)),
((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),
(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)),
((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),
(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)),
((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),
(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)));
{ Dialog window procedure for Help│About dialog }
function DlgProc(Window: HWnd; Msg: ULong; Mp1,Mp2: MParam): MResult; cdecl; export;
var
Swap: Swp;
begin
DlgProc := 0;
case Msg of
{ when the dialog is being initialized, center it on desktop }
wm_InitDlg:
begin
WinQueryWindowPos(Window, Swap);
WinSetWindowPos(Window, 0, (DesktopSize.X - Swap.cX) div 2,
(DesktopSize.Y - Swap.cY) div 2, 0, 0, swp_Move);
end;
{ if system message is received then dismiss the dialog box }
wm_Command:
begin
WinDismissDlg(Window, ulTrue);
Exit;
end;
end;
DlgProc := WinDefDlgProc(Window, Msg, Mp1, Mp2);
end;
{ TriplexApplication }
constructor TriplexApplication.Init;
begin
inherited Init;
MainWindow := New(PTriplexWindow, Init('Triplex Game', 'Triplex', TriplexFlags));
end;
destructor TriplexApplication.Done;
begin
Dispose(MainWindow, Done);
inherited Done;
end;
{ TTriplexWindow }
procedure TTriplexWindow.StartupAction;
var
Color: TriangleColor;
begin
WinStartTimer(Anchor, ClientWindow, idTimer, LevelDeley);
Randomize;
NextFigure := Random(32) + 1;
WinSetWindowPos(FrameWindow, 0, { Normal window size = 1/4 of a screen }
DesktopSize.X div 4, DesktopSize.Y div 4,
DesktopSize.X div 2, DesktopSize.Y div 2, swp_Move + swp_Size);
WinSetWindowPos(FrameWindow, 0, 0,0,0,0, swp_Maximize+swp_Activate+swp_Show);
end;
function TTriplexWindow.HandleMessage(Window: HWnd; Msg: ULong; Mp1,Mp2 : MParam): MResult;
var
X,Y: Integer;
begin
HandleMessage := 0;
case Msg of
wm_Timer:
if not GameOver then
if TimerCount <> 0 then Dec(TimerCount)
else
begin
TimerCount := TimerScale;
PS := WinGetPS(Window);
if not FigurePresent then
begin
FigurePresent := True;
CurPos.X := 2;
CurPos.Y := -2;
CurrentFigure := FigureSet[NextFigure];
DrawNext(Hidden); { Erase old next figure }
NextFigure := Random(32)+1;
DrawNext(NewColor); { Show new next figure }
if MoveAllowed(0,0,0,False) then ShowFigure(CurPos.X,CurPos.Y,CurrentFigure,NewColor)
else
begin
for X := 2 to WellWidth - 1 do
for Y := 1 to WellHeight - 1 do Field[X,Y] := 1;
WinInvalidateRect(Window, nil, False);
GameOver := True;
end;
end
else { Figure exists }
begin
if MoveAllowed(0,1,0,False) and MoveAllowed(0,2,0,False) then MoveFigure(0,2,0,False)
else DrawFallen;
end;
WinReleasePS(PS);
end;
wm_Char:
if (CharMsgMp1(Mp1).fs and kc_KeyUp) = 0 then { Key is Down }
if not GameOver then
begin
PS := WinGetPS(Window);
case CharMsgMp2(Mp2).VKey of
vk_Space: { Drop current figure }
begin
while MoveAllowed(0,1,0,False) and MoveAllowed(0,2,0,False) do MoveFigure(0,2,0,False);
DrawFallen;
end;
vk_Down: { Move the figure down }
if MoveAllowed(0,1,0,False) and MoveAllowed(0,2,0,False) then MoveFigure(0,2,0,False);
vk_Left: { Move the figure to the left }
if (CharMsgMp1(Mp1).fs and kc_Shift) = 0 then
begin
if MoveAllowed(-1,1,0,False) then MoveFigure(-1,1,0,False);
end
else
while MoveAllowed(-2,0,0,False) and MoveAllowed(-1,0,0,False) do MoveFigure(-2,0,0,False);
vk_Right: { Move the figure to the right }
if (CharMsgMp1(Mp1).fs and kc_Shift) = 0 then
begin
if MoveAllowed(1,1,0,False) then MoveFigure(1,1,0,False);
end
else
while MoveAllowed(2,0,0,False) and MoveAllowed(1,0,0,False) do MoveFigure(2,0,0,False);
vk_Up: { Rotate the figure }
begin
if (CharMsgMp1(Mp1).fs and kc_Shift) = 0 then
begin
if MoveAllowed(0,0,1,False) then MoveFigure(0,0,1,False);
end
else if MoveAllowed(0,0,5,False) then MoveFigure(0,0,5,False);
end;
{ Mirror transformation }
vk_Tab: if MoveAllowed(0,0,0,True) then MoveFigure(0,0,0,True);
end;
WinReleasePS(PS);
end;
wm_Paint:
begin
PS := WinBeginPaint(Window,0,nil);
ReDraw(Window);
WinEndPaint(PS);
end;
wm_Command:
case SmallWord(Mp1) of
cmNewGame:
begin
PS := WinGetPS(Window);
Filled := 0;
TimerCount := 0;
GameOver := False;
CurrentFigure.No := 0;
FillChar(Field, SizeOf(Field), 0);
ReDraw(Window);
FigurePresent := False;
WinReleasePS(PS);
end;
cmExit: WinPostMsg(0, wm_Quit, 0, 0);
cmAbout: WinDlgBox(hwnd_Desktop, Window, DlgProc, 0, idAbout, nil);
end;
wm_Destroy: WinStopTimer(Anchor, ClientWindow, idTimer);
else HandleMessage := WinDefWindowProc(Window, Msg, Mp1, Mp2);
end;
end;
{ Draws triangle }
procedure TTriplexWindow.ShowTriangle(X,Y: Integer; Color: TriangleColor);
var
X1,Y1: Integer;
XBias: Integer;
Vertex: array [1..3] of PointL;
const
ColorMap: array[TriangleColor] of Byte = (clr_Blue,clr_Green,clr_Red,clr_PaleGray);
begin
Y := WellHeight - Y;
if (Odd(X) <> Odd(Y))
then
begin
Vertex[3].X := X * Scale.X * 2 + WellPos.X - Scale.X+1; { LEFT }
Vertex[3].Y := Y * Scale.Y + WellPos.Y;
Vertex[1].X := Vertex[3].X + 2 * Scale.X - 2;
Vertex[1].Y := Vertex[3].Y - Scale.Y + 1;
Vertex[2].X := Vertex[1].X;
Vertex[2].Y := Vertex[1].Y + 2 * Scale.Y - 2;
XBias := -1;
end
else
begin
Vertex[3].X := X * Scale.X * 2+ WellPos.X + Scale.X - 1; { RIGHT }
Vertex[3].Y := Y * Scale.Y + WellPos.Y;
Vertex[2].X := Vertex[3].X - 2 * Scale.X + 2;
Vertex[2].Y := Vertex[3].Y + Scale.Y - 1;
Vertex[1].X := Vertex[2].X;
Vertex[1].Y := Vertex[2].Y - 2 * Scale.Y + 2;
XBias := 1;
end;
if Color <> Hidden then
begin
GpiSetColor(PS,clr_Black);
GpiMove(PS, Vertex[3]); { Move to starting point }
GpiPolyLine(PS, 3, Vertex[1]); { Draw 3 sides }
Inc(Vertex[1].X,XBias); Inc(Vertex[1].Y,1);
Inc(Vertex[2].X,XBias); Dec(Vertex[2].Y,1);
Dec(Vertex[3].X,XBias);
if Scale.Y >= 4 then
begin
GpiSetColor(PS,clr_Black);
GpiMove(PS, Vertex[3]);
GpiPolyLine(PS, 3, Vertex[1]);
Inc(Vertex[1].X,XBias); Inc(Vertex[1].Y,1);
Inc(Vertex[2].X,XBias); Dec(Vertex[2].Y,1);
Dec(Vertex[3].X,XBias);
end;
if Scale.Y >= 6 then
begin
GpiSetColor(PS,clr_White);
GpiMove(PS, Vertex[3]);
GpiPolyLine(PS, 3, Vertex[1]);
Inc(Vertex[1].X,XBias); Inc(Vertex[1].Y,1);
Inc(Vertex[2].X,XBias); Dec(Vertex[2].Y,1);
Dec(Vertex[3].X,XBias);
end;
end
else
Inc(Vertex[3].X, XBias);
GpiSetColor(PS,ColorMap[Color]);
GpiBeginPath(PS, 1); { Start the path bracket }
GpiMove(PS, Vertex[3]); { Move to starting point }
GpiPolyLine(PS, 2, Vertex[1]); { Draw two sides }
GpiEndPath(PS); { End the path bracket }
GpiFillPath(PS, 1, fpath_Alternate); { Draw and fill the path }
end;
{ Draws the figure }
procedure TTriplexWindow.ShowFigure(X,Y: Integer; var Fig: Figure; Color: TriangleColor);
var
I,X1,Y1: Integer;
begin
for I := 1 to Fig.No do
begin
X1 := X + Fig.Body[I].X;
Y1 := Y + Fig.Body[I].Y;
ShowTriangle(X1,Y1,Color);
if Color = FallenColor then Field[X1,Y1] := 1;
end;
end;
{ Rotates the figure }
procedure TTriplexWindow.RotateFigure(var Fig: Figure);
var
I,X,Y: Integer;
begin
for I := 1 to Fig.No do
begin
X := RotateMap[Fig.Body[I].X, Fig.Body[I].Y].X;
Y := RotateMap[Fig.Body[I].X, Fig.Body[I].Y].Y;
Fig.Body[I].X := X;
Fig.Body[I].Y := Y;
end;
end;
{ Mirror transformation }
procedure TTriplexWindow.MirrorFigure(var Fig: Figure);
var
I: Integer;
begin
for I := 1 to Fig.No do Fig.Body[I].X := 9 - Fig.Body[I].X;
end;
{ Checks whether it is possible to move the figure }
function TTriplexWindow.MoveAllowed(X,Y,Rotate: Integer; Mirror: Boolean): Boolean;
var
Fig: Figure;
I: Integer;
begin
Fig := CurrentFigure;
Inc(X,CurPos.X);
Inc(Y,CurPos.Y);
while Rotate > 0 do
begin
RotateFigure(Fig);
Dec(Rotate);
end;
if Mirror then MirrorFigure(Fig);
MoveAllowed := True;
for I := 1 to Fig.No do
if (X+Fig.Body[I].X > WellWidth ) or (X+Fig.Body[I].X < 1) or { X not within field }
(Y+Fig.Body[I].Y > WellHeight) or (Y+Fig.Body[I].Y < 1) { Y not within field }
then MoveAllowed := False { Fallen figure exists}
else if Field[X+Fig.Body[I].X,Y+Fig.Body[I].Y] <> 0 then MoveAllowed := False;
end;
{ Moves the figure }
procedure TTriplexWindow.MoveFigure(X,Y,Rotate: Integer; Mirror: Boolean);
var
I,J: Integer;
OldPos: Cell;
OldHide,NewDraw: array[1..6] of Boolean;
OldFigure: Figure;
begin
OldFigure := CurrentFigure;
OldPos := CurPos;
{ Move or transform the figure }
Inc(CurPos.X,X);
Inc(CurPos.Y,Y);
while Rotate > 0 do
begin
RotateFigure(CurrentFigure);
Dec(Rotate);
end;
if Mirror then MirrorFigure(CurrentFigure);
for I := 1 to 6 do
begin
OldHide[I] := True;
NewDraw[I] := True;
end;
{ Compare Old figure with a new one }
for I := 1 to OldFigure.No do
for J := 1 to CurrentFigure.No do
if (OldPos.X + OldFigure.Body[I].X = CurPos.X + CurrentFigure.Body[J].X) and
(OldPos.Y + OldFigure.Body[I].Y = CurPos.Y + CurrentFigure.Body[J].Y) then
begin
OldHide[I] := False;
NewDraw[J] := False;
end;
{ Hide Old figure }
for I := 1 to OldFigure.No do if OldHide[I] then
ShowTriangle(OldPos.X+OldFigure.Body[I].X,OldPos.Y+OldFigure.Body[I].Y,Hidden);
{ Show New figure }
for i := 1 to CurrentFigure.No do if NewDraw[I] then
ShowTriangle(CurPos.X+CurrentFigure.Body[I].X,CurPos.Y+CurrentFigure.Body[I].Y,NewColor);
TimerCount := TimerScale;
end;
{ Deletes row that is filled competely }
procedure TTriplexWindow.Melt;
var
X,Y,I: Integer;
Flag: Boolean;
begin
for Y := 1 to WellHeight-1 do
begin
Flag := True;
for X := 2 to WellWidth-1 do if Field[X,Y] = 0 then Flag := False;
if Flag then
begin
Inc(Filled);
for X := 2 to WellWidth - 1 do
begin
ShowTriangle(X,Y, Hidden); { Hide triangle }
Field[X,Y] := 0;
for I := Y - 1 downto 1 do
if Field[X,I] = 1 then
begin
ShowTriangle(X,I, Hidden); Field[X,I] := 0;
ShowTriangle(X,I+1,FallenColor); Field[X,I+1] := 1;
end;
end;
end;
end;
end;
{ Draws the well }
procedure TTriplexWindow.DrawWell;
var
I: Integer;
begin
for I := 1 to WellHeight do
begin
ShowTriangle(1,I,WallColor); { Walls }
ShowTriangle(WellWidth,I,WallColor);
Field[1,I] := 1; Field[WellWidth,I] := 1;
end;
for I := 2 to WellWidth - 1 do { Bottom line }
begin
ShowTriangle(I,WellHeight,WallColor);
Field[I,WellHeight] := 1;
end;
end;
{ Redraws entire window }
procedure TTriplexWindow.ReDraw(Window: HWnd);
var
X,Y: Integer;
P: PointL;
begin
WinQueryWindowRect(Window,R);
Scale.Y := (R.yTop - R.yBottom) div WellHeight;
Scale.X := Scale.Y;
WellPos.X := ((R.xRight - R.xLeft) - Scale.X * WellWidth) div 3;
WellPos.Y := 10;
WinFillRect(PS, R, clr_PaleGray);
DrawWell;
for X := 2 to WellWidth - 1 do
for Y := 2 to WellHeight - 1 do
if Field[X,Y] <> 0 then ShowTriangle(X,Y,FallenColor);
if not GameOver then
begin
ShowFigure(CurPos.X,CurPos.Y,CurrentFigure,NewColor);
DrawNext(NewColor);
end
else
begin
P.Y := (R.yTop - R.yBottom) div 2;
P.X := WellPos.X + Scale.X * 4;
GpiSetColor(PS, clr_Default);
GpiSetBackMix(PS, bm_OverPaint);
GpiCharStringAt(PS, P, 17, '*** GAME OVER ***');
end;
end;
{ Draws next figure, updates score }
procedure TTriplexWindow.DrawNext(Color: TriangleColor);
var
S: String[10];
R1: RectL;
begin
if not GameOver then
ShowFigure(-10,-2, FigureSet[NextFigure], Color); { Show/Hide next figure }
Str(Filled, S);
S := 'Score: ' + S;
R1.yBottom := (R.yTop - R.yBottom) div 3; R1.yTop := R1.yBottom + 20;
R1.xLeft := 0; R1.xRight := WellPos.X;
WinDrawText(PS,Length(S),@S[1],R1,clr_Black,clr_PaleGray,dt_Center+dt_EraseRect);
end;
{ Draws figure with a fallen color, deletes rows that are filled competely }
procedure TTriplexWindow.DrawFallen;
begin
FigurePresent := False;
ShowFigure(CurPos.X, CurPos.Y, CurrentFigure, FallenColor);
Melt;
TimerCount := 0;
end;
var
TriplexGame: TriplexApplication;
begin
TriplexGame.Init;
TriplexGame.Run;
TriplexGame.Done;
end.
