mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-14 16:29:48 +02:00
Graphical version
This commit is contained in:
marco
parent
3f1c1e087b
commit
ddbb4377dd
@ -6,10 +6,12 @@
|
||||
|
||||
SameGame is a standard game in GNOME and KDE. I liked it, and I
|
||||
automatically brainstormed how I would implement it.
|
||||
It turned out to be really easy, and is basically only 100 lines or so.
|
||||
It turned out to be really easy, and is basically only 100 lines or so,
|
||||
the rest is scorekeeping, helptext, menu etc.
|
||||
|
||||
The game demonstrates some features of the MSMOUSE unit, and some of
|
||||
the Crt unit.
|
||||
the Crt and Graph units. (depending whether it is compiled with
|
||||
UseGraphics or not)
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
@ -20,19 +22,66 @@
|
||||
|
||||
**********************************************************************}
|
||||
PROGRAM SameGame;
|
||||
Uses Crt,GameUnit;
|
||||
|
||||
CONST FieldX = 10; {Top left playfield coordinates}
|
||||
Uses Crt,Dos,
|
||||
{$IFDEF UseGraphics}
|
||||
Graph,
|
||||
{$ENDIF}
|
||||
GameUnit;
|
||||
|
||||
CONST
|
||||
GrFieldX = 10; {X topleft of playfield}
|
||||
GrFieldY = 70; {Y topleft of playfield}
|
||||
ScalerX = 22; {ScalerX x Scaler y dots
|
||||
must be approx a square}
|
||||
ScalerY = 20;
|
||||
FieldX = 10; {Top left playfield
|
||||
coordinates in squares(textmode)}
|
||||
FieldY = 3; {Top left playfield coordinates}
|
||||
PlayFieldXDimension = 20; {Dimensions of playfield}
|
||||
PlayFieldYDimension = 15;
|
||||
RowDispl = 15;
|
||||
MenuX = 480;
|
||||
MenuY = 120;
|
||||
grNewGameLine = 'NEW GAME';
|
||||
grHelpLine = 'HELP';
|
||||
grEndGame = 'END GAME';
|
||||
|
||||
|
||||
{Used colors. Colors[0..2] are the colors used on the playfield, Colors[3]
|
||||
is the background and Colors[4] is the color used to mark the pieces}
|
||||
Colors : ARRAY [0..4] OF LONGINT = (White,Blue,Red,Black,LightMagenta);
|
||||
|
||||
|
||||
TYPE PlayFieldType=ARRAY[0..PlayFieldXDimension-1,0..PlayFieldYDimension-1] OF BYTE;
|
||||
|
||||
{$IFDEF UseGraphics}
|
||||
PROCEDURE DisplayPlayField(CONST PlayField:PlayFieldType);
|
||||
{Screen routine, simply puts the array Playfield on screen.
|
||||
Both used for displaying the normal grid as the grid with a certain area marked}
|
||||
|
||||
VAR X,Y : LONGINT;
|
||||
LastOne,
|
||||
NumbLast : LONGINT;
|
||||
|
||||
BEGIN
|
||||
HideMouse;
|
||||
FOR Y:=0 TO PlayFieldYDimension-1 DO
|
||||
BEGIN
|
||||
X:=0;
|
||||
REPEAT
|
||||
LastOne:=PlayField[X,Y];
|
||||
NumbLast:=X;
|
||||
WHILE (PlayField[X,Y]=LastOne) AND (X<(PlayFieldXDimension-1))DO
|
||||
INC(X);
|
||||
SetFillStyle(SolidFill,Colors[LastOne]);
|
||||
Bar(GrFieldX+NumbLast*ScalerX,GrFieldY+Y*ScalerY,GrFieldX+X*ScalerX-1,GrFieldY+(Y+1)*ScalerY-1);
|
||||
UNTIL X>=(PlayFieldXDimension-1);
|
||||
END;
|
||||
ShowMouse;
|
||||
END;
|
||||
{$ELSE}
|
||||
|
||||
PROCEDURE DisplayPlayField(CONST PlayField:PlayFieldType);
|
||||
{Screen routine, simply puts the array Playfield on screen.
|
||||
Both used for displaying the normal grid as the grid with a certain area marked}
|
||||
@ -50,6 +99,7 @@ BEGIN
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
{$ENDIF}
|
||||
|
||||
PROCEDURE ShowHelp;
|
||||
{Shows some explanation of the game and waits for a key}
|
||||
@ -57,34 +107,59 @@ PROCEDURE ShowHelp;
|
||||
VAR I : LONGINT;
|
||||
|
||||
BEGIN
|
||||
FOR I:=2 TO 24 DO
|
||||
BEGIN
|
||||
GotoXY(1,I);
|
||||
ClrEol;
|
||||
END;
|
||||
GotoXY(1,3); TextColor(White);
|
||||
Write('SAMEGAME');
|
||||
SetDefaultColor;
|
||||
WriteLn(' is a small game, with a principle copied from some KDE game');
|
||||
WriteLn;
|
||||
WriteLn('I tried to implement it under Go32V2 to demonstrate the MsMouse unit');
|
||||
Writeln('When it worked, I tried to get it running under Linux. I succeeded,');
|
||||
Writeln('but the mouse unit of the API doesn'#39't work with GPM 1.17');
|
||||
Writeln;
|
||||
WriteLn('If you move over the playfield, aggregates of one color will be marked');
|
||||
Writeln('in purple. If you then press the left mouse button, that aggregate will');
|
||||
Writeln('disappear, and the playfield will collapse to the bottom-left. Please');
|
||||
Writeln('keep in mind that only an aggregate of two blocks or more will disappear.');
|
||||
Writeln;
|
||||
Writeln('For every aggregate you let disappear you get points, but the score is');
|
||||
Writeln('quadratic proportional to the number of blocks killed. So 4 times killing');
|
||||
Writeln(' a 4 block aggregate scores 4 points, and one time 16 blocks will score 64');
|
||||
Writeln('blocks. The purpose of the game is obtaining the highscore');
|
||||
Writeln;
|
||||
Writeln('If you manage to kill the entire playfield, you'#39'll get a bonus');
|
||||
Writeln;
|
||||
WriteLn('Press any key to get back to the game');
|
||||
GetKey;
|
||||
{$IFDEF UseGraphics}
|
||||
HideMouse;
|
||||
SetbkColor(black);
|
||||
SetViewPort(0,0,getmaxx,getmaxy,clipoff);
|
||||
ClearViewPort;
|
||||
SetTextStyle(0,Horizdir,2);
|
||||
OutTextXY(220,10,'SAMEGAME');
|
||||
SetTextStyle(0,Horizdir,1);
|
||||
OutTextXY(5,40+1*LineDistY,' is a small game, with a principle copied from some KDE game');
|
||||
OutTextXY(5,40+3*LineDistY,'I tried to implement it under Go32V2 to demonstrate the MsMouse unit');
|
||||
OutTextXY(5,40+4*LineDistY,'When it worked, I tried to get it running under Linux. I succeeded,');
|
||||
OutTextXY(5,40+5*LineDistY,'but the mouse unit of the API doesn'#39't work with GPM 1.17');
|
||||
OutTextXY(5,40+7*LineDistY,'If you move over the playfield, aggregates of one color will be marked');
|
||||
OutTextXY(5,40+8*LineDistY,'in purple. If you then press the left mouse button, that aggregate will');
|
||||
OutTextXY(5,40+9*LineDistY,'disappear, and the playfield will collapse to the bottom-left. Please');
|
||||
OutTextXY(5,40+10*LineDistY,'keep in mind that only an aggregate of two blocks or more will disappear.');
|
||||
OutTextXY(5,40+12*LineDistY,'For every aggregate you let disappear you get points, but the score is');
|
||||
OutTextXY(5,40+13*LineDistY,'quadratic proportional to the number of blocks killed. So 4 times killing');
|
||||
OutTextXY(5,40+14*LineDistY,' a 4 block aggregate scores 4 points, and one time 16 blocks will score 64');
|
||||
OutTextXY(5,40+15*LineDistY,'blocks. The purpose of the game is obtaining the highscore');
|
||||
OutTextXY(5,40+17*LineDistY,'If you manage to empty the entire playfield, you'#39'll get a bonus');
|
||||
OutTextXY(5,40+19*LineDistY,'Press any key to get back to the game');
|
||||
ShowMouse;
|
||||
{$ELSE}
|
||||
FOR I:=2 TO 24 DO
|
||||
BEGIN
|
||||
GotoXY(1,I);
|
||||
ClrEol;
|
||||
END;
|
||||
GotoXY(1,3); TextColor(White);
|
||||
Write('SAMEGAME');
|
||||
SetDefaultColor;
|
||||
WriteLn(' is a small game, with a principle copied from some KDE game');
|
||||
WriteLn;
|
||||
WriteLn('I tried to implement it under Go32V2 to demonstrate the MsMouse unit');
|
||||
Writeln('When it worked, I tried to get it running under Linux. I succeeded,');
|
||||
Writeln('but the mouse unit of the API doesn'#39't work with GPM 1.17');
|
||||
Writeln;
|
||||
WriteLn('If you move over the playfield, aggregates of one color will be marked');
|
||||
Writeln('in purple. If you then press the left mouse button, that aggregate will');
|
||||
Writeln('disappear, and the playfield will collapse to the bottom-left. Please');
|
||||
Writeln('keep in mind that only an aggregate of two blocks or more will disappear.');
|
||||
Writeln;
|
||||
Writeln('For every aggregate you let disappear you get points, but the score is');
|
||||
Writeln('quadratic proportional to the number of blocks killed. So 4 times killing');
|
||||
Writeln(' a 4 block aggregate scores 4 points, and one time 16 blocks will score 64');
|
||||
Writeln('blocks. The purpose of the game is obtaining the highscore');
|
||||
Writeln;
|
||||
Writeln('If you manage to empty the entire playfield, you'#39'll get a bonus');
|
||||
Writeln;
|
||||
WriteLn('Press any key to get back to the game');
|
||||
{$ENDIF}
|
||||
GetKey;
|
||||
END;
|
||||
|
||||
VAR MarkField,PlayField : PlayFieldType; {The playfield, and the marked form}
|
||||
@ -96,6 +171,7 @@ PROCEDURE ShowButtons;
|
||||
{Shows the clickable buttons}
|
||||
|
||||
BEGIN
|
||||
{$IFNDEF UseGraphics}
|
||||
TextColor(Yellow); TextBackGround(Blue);
|
||||
GotoXY(60,5); Write('NEW game');
|
||||
GotoXY(60,6); Write('HELP');
|
||||
@ -103,7 +179,14 @@ BEGIN
|
||||
{$IFDEF Linux}
|
||||
GotoXY(60,8); Write('Force IBM charset');
|
||||
{$ENDIF}
|
||||
SetDefaultColor;
|
||||
SetDefaultColor;
|
||||
{$ELSE}
|
||||
SetTextStyle(0,Horizdir,1);
|
||||
OutTextXY(MenuX,MenuY,grNewGameLine);
|
||||
OutTextXY(MenuX,MenuY+RowDispl,grHelpLine);
|
||||
OutTextXY(MenuX,MenuY+2*RowDispl,grEndGame);
|
||||
{$ENDIF}
|
||||
|
||||
END;
|
||||
|
||||
FUNCTION PlayFieldPiecesLeft:LONGINT;
|
||||
@ -123,11 +206,20 @@ END;
|
||||
PROCEDURE ShowScore;
|
||||
{Simply procedure to update the score}
|
||||
|
||||
VAR S : String;
|
||||
|
||||
BEGIN
|
||||
{$IFDEF UseGraphics}
|
||||
Str(Score:5,S);
|
||||
SetFillStyle(SolidFill,0);
|
||||
Bar(300,440,450,458);
|
||||
OutTextXY(300,440,'Score :'+S);
|
||||
{$ELSE}
|
||||
TextColor(White);
|
||||
GotoXY(20,23); Write(' ':20);
|
||||
GotoXY(20,23); Write('Score : ',Score);
|
||||
SetDefaultColor;
|
||||
{$ENDIF}
|
||||
END;
|
||||
|
||||
FUNCTION CubesToScore : LONGINT;
|
||||
@ -237,11 +329,25 @@ PROCEDURE BuildScreen;
|
||||
{Some procedures that build the screen}
|
||||
|
||||
BEGIN
|
||||
ClrScr; Score:=0;
|
||||
{$IFDEF UseGraphics}
|
||||
setbkcolor(black);
|
||||
setviewport(0,0,getmaxx,getmaxy,clipoff);
|
||||
clearviewport;
|
||||
{$ELSE}
|
||||
ClrScr;
|
||||
{$ENDIF}
|
||||
Score:=0;
|
||||
ShowScore;
|
||||
ShowButtons;
|
||||
ShowHighScore;
|
||||
ShowMouse;
|
||||
{$IFDEF UseGraphics}
|
||||
|
||||
SetTextStyle(0,Horizdir,2);
|
||||
OuttextXY(10,10,'SameGame v0.03, (C) by Marco v/d Voort. ');
|
||||
SetTextStyle(0,Horizdir,1);
|
||||
OuttextXY(50,40,'A demo for the FPC RTL and API units Crt,(MS)Mouse and Graph');
|
||||
{$ELSE}
|
||||
GotoXY(1,1);
|
||||
TextColor(Yellow);
|
||||
Write('SameGame v0.02');
|
||||
@ -250,6 +356,7 @@ BEGIN
|
||||
TextColor(Yellow); Write('FPC');
|
||||
TextColor(White); Write(' API or MsMouse unit. By Marco van de Voort');
|
||||
SetDefaultColor;
|
||||
{$ENDIF}
|
||||
IF LastScore<>0 THEN
|
||||
BEGIN
|
||||
GotoXY(10,20);
|
||||
@ -267,6 +374,7 @@ VAR X,Y,
|
||||
MX,MY,MState,Dummy : LONGINT;
|
||||
EndOfGame : LONGINT;
|
||||
S : String;
|
||||
DoneSomething : BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
RANDOMIZE;
|
||||
@ -276,8 +384,14 @@ BEGIN
|
||||
EndOfGame:=0;
|
||||
REPEAT
|
||||
GetMouseState(MX,MY,MState);
|
||||
X:=MX SHR 3;
|
||||
Y:=MY SHR 3;
|
||||
{$IFDEF UseGraphics}
|
||||
X:=2*((MX-GrFieldX) DIV ScalerX) +FieldX;
|
||||
Y:=((MY-GrFieldY) DIV ScalerY) +FieldY-1;
|
||||
{$ELSE}
|
||||
X:=MX SHR 3;
|
||||
Y:=MY SHR 3;
|
||||
{$ENDIF}
|
||||
DoneSomething:=FALSE;
|
||||
IF PlayFieldPiecesLeft=0 THEN
|
||||
BEGIN
|
||||
INC(Score,1000);
|
||||
@ -285,10 +399,21 @@ BEGIN
|
||||
END
|
||||
ELSE
|
||||
BEGIN
|
||||
{$IFDEF UseGraphics}
|
||||
IF (MX>=MenuX) AND (MX<(MenuX+16*Length(GrNewGameLine))) THEN
|
||||
BEGIN {X in clickable area}
|
||||
IF (MY>=MenuY) AND (MY<(MenuY+RowDispl*3+2)) THEN
|
||||
BEGIN
|
||||
X:=65; {X doesn't matter as long as it is 60..69}
|
||||
Y:=((MY-MenuY) DIV RowDispl)+4;
|
||||
END;
|
||||
END;
|
||||
{$ENDIF}
|
||||
IF (X>=60) AND (X<=69) THEN
|
||||
BEGIN
|
||||
IF (MState AND LButton) <>0 THEN {If leftbutton pressed,}
|
||||
BEGIN
|
||||
DoneSomething:=TRUE;
|
||||
IF Y=4 THEN
|
||||
EndOfGame:=1;
|
||||
IF Y=6 THEN
|
||||
@ -311,12 +436,15 @@ BEGIN
|
||||
END;
|
||||
IF (X>=(FieldX-2)) AND (Y>=(FieldY-2)) THEN
|
||||
BEGIN
|
||||
DEC(X,FieldX-1); DEC(Y,FieldY-1);
|
||||
|
||||
DEC(X,FieldX-1);
|
||||
DEC(Y,FieldY-1);
|
||||
X:=X SHR 1;
|
||||
IF (X<PlayFieldXDimension) AND (Y<PlayFieldYDimension) THEN
|
||||
BEGIN
|
||||
IF MarkField[X,Y]<>4 THEN
|
||||
BEGIN
|
||||
DoneSomething:=TRUE;
|
||||
MarkField:=PlayField;
|
||||
MarkAfield(X,Y);
|
||||
DisplayPlayField(MarkField);
|
||||
@ -326,8 +454,10 @@ BEGIN
|
||||
GotoXY(20,22);
|
||||
Write('Marked :',CubesToScore);
|
||||
END;
|
||||
IF (MState AND LButton) <>0 THEN {If leftbutton pressed,}
|
||||
IF (MarkField[X,Y]=4) AND ((MState AND LButton) <>0) THEN
|
||||
{If leftbutton pressed,}
|
||||
BEGIN
|
||||
DoneSomething:=TRUE;
|
||||
REPEAT {wait untill it's released.
|
||||
The moment of pressing counts}
|
||||
GetMouseState(X,Y,Dummy);
|
||||
@ -335,13 +465,13 @@ BEGIN
|
||||
Colapse;
|
||||
MarkField:=PlayField;
|
||||
DisplayPlayField(MarkField);
|
||||
END;
|
||||
END;
|
||||
END
|
||||
END
|
||||
END;
|
||||
IF KeyPressed THEN
|
||||
BEGIN
|
||||
X:=GetKey;
|
||||
IF (X=ORD('X')) OR (X=ORD('x')) THEN
|
||||
IF (CHR(X) IN ['X','x','Q','q']) OR (X=27) THEN
|
||||
EndOfGame:=2;
|
||||
END;
|
||||
END;
|
||||
@ -350,9 +480,17 @@ BEGIN
|
||||
X:=SlipInScore(Score);
|
||||
IF X<>0 THEN
|
||||
BEGIN
|
||||
HideMouse;
|
||||
ShowHighScore;
|
||||
InputStr(S,HighX,HighY+12-X,10,FALSE,AlfaBeta);
|
||||
{$IFDEF UseGraphics}
|
||||
Str(Score:5,S);
|
||||
OutTextXY(HighX+150,HighY+LineDistY*(10-X),S);
|
||||
GrInputStr(S,HighX,HighY+LineDistY*(10-X),16,12,10,FALSE,AlfaBeta);
|
||||
{$ELSE}
|
||||
InputStr(S,HighX,HighY+12-X,10,FALSE,AlfaBeta);
|
||||
{$ENDIF}
|
||||
HighScore[X-1].Name:=S;
|
||||
ShowMouse;
|
||||
END;
|
||||
LastScore:=Score;
|
||||
UNTIL EndOFGame=2;
|
||||
@ -361,8 +499,26 @@ END;
|
||||
CONST FileName='samegame.scr';
|
||||
|
||||
VAR I : LONGINT;
|
||||
Error : LONGINT;
|
||||
{$IFDEF UseGraphics}
|
||||
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}
|
||||
IF NOT MousePresent THEN
|
||||
BEGIN
|
||||
Writeln('No mouse found. A mouse is required!');
|
||||
@ -373,7 +529,11 @@ BEGIN
|
||||
LoadHighScore(FileName);
|
||||
InitMouse;
|
||||
CursorOff;
|
||||
HighX:=52; HighY:=10; {the position of the highscore table}
|
||||
{$IFDEF UseGraphics}
|
||||
HighX:=450; HighY:=220; {the position of the highscore table}
|
||||
{$else}
|
||||
HighX:=52; HighY:=10; {the position of the highscore table}
|
||||
{$endif}
|
||||
|
||||
DoMainLoopMouse;
|
||||
|
||||
@ -381,13 +541,21 @@ BEGIN
|
||||
DoneMouse;
|
||||
CursorOn;
|
||||
SaveHighScore;
|
||||
{$IFDEF UseGraphics}
|
||||
CloseGraph;
|
||||
{$ENDIF}
|
||||
ClrScr;
|
||||
Writeln;
|
||||
Writeln('Last games'#39' score was : ',Score);
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 1999-06-01 19:24:33 peter
|
||||
Revision 1.3 1999-12-31 17:04:22 marco
|
||||
|
||||
|
||||
Graphical version
|
||||
|
||||
Revision 1.2 1999/06/01 19:24:33 peter
|
||||
* updates from marco
|
||||
|
||||
Revision 1.1 1999/05/27 21:36:34 peter
|
||||
|
||||
Loading…
Reference in New Issue
Block a user