* Fixes for Quad Win32 GUI mode

This commit is contained in:
marco 2002-02-25 12:23:05 +00:00
parent 3cae6d109b
commit bde6b63ef0
3 changed files with 175 additions and 30 deletions

View File

@ -260,8 +260,9 @@ You have to remove all the cards to win, and the highscore record
the time. QUAD loads some pictures from quaddata.dat. the time. QUAD loads some pictures from quaddata.dat.
TODO: TODO:
- Use graphical versions of highscore. - Use graphical versions of highscore. (done in win32 GUI mode)
HISTORY HISTORY
v0.02 : Win32 GUI mode.
v0.01 : v0.01 :
- Initial FPC port. - Initial FPC port.

View File

@ -35,6 +35,7 @@ INTERFACE
{$endif} {$endif}
{$ifdef win32} {$ifdef win32}
{$define MouseAPI} {$define MouseAPI}
{$define UseGraphics} {Mandatory}
{$endif} {$endif}
{$IFDEF Ver70} {$IFDEF Ver70}
{$define MouseAPI} {$define MouseAPI}
@ -298,6 +299,9 @@ BEGIN
FOR I:=0 TO 9 DO FOR I:=0 TO 9 DO
BEGIN BEGIN
HighScore[I].Name:=InitNames[I]; HighScore[I].Name:=InitNames[I];
If Negative Then
HighScore[I].Score:=-100*(10-I)
Else
HighScore[I].Score:=(I+1)*750; HighScore[I].Score:=(I+1)*750;
END; END;
ScorePath:=FileName; ScorePath:=FileName;
@ -336,6 +340,7 @@ BEGIN
INC(I); INC(I);
IF I<>0 THEN IF I<>0 THEN
BEGIN BEGIN
IF I>1 THEN IF I>1 THEN
FOR J:=0 TO I-2 DO FOR J:=0 TO I-2 DO
HighScore[J]:=HighScore[J+1]; HighScore[J]:=HighScore[J+1];
@ -359,7 +364,7 @@ BEGIN
BEGIN BEGIN
OutTextXY(HighX,HighY+(9-I)*LineDistY,HighScore[I].Name); OutTextXY(HighX,HighY+(9-I)*LineDistY,HighScore[I].Name);
IF Negative THEN IF Negative THEN
Str(-HighScore[I].Score:5,S) Str((-HighScore[I].Score):5,S)
ELSE ELSE
Str(HighScore[I].Score:5,S); Str(HighScore[I].Score:5,S);
OutTextXY(HighX+150,HighY+(9-I)*LineDistY,S); OutTextXY(HighX+150,HighY+(9-I)*LineDistY,S);
@ -910,7 +915,10 @@ BEGIN
END. END.
{ {
$Log$ $Log$
Revision 1.4 2002-02-22 21:40:09 carl Revision 1.5 2002-02-25 12:23:05 marco
* Fixes for Quad Win32 GUI mode
Revision 1.4 2002/02/22 21:40:09 carl
* fix compilation problem * fix compilation problem
Revision 1.3 2001/12/11 11:10:27 marco Revision 1.3 2001/12/11 11:10:27 marco

View File

@ -22,8 +22,25 @@ Inspired by: Jos Dickman''s triple memory!
Old version requires egavga.bgi. FPC doesn't require BGI's (VGA and VESA Old version requires egavga.bgi. FPC doesn't require BGI's (VGA and VESA
support are built in the Graph, others are ignored).} support are built in the Graph, others are ignored).}
Uses Crt,Dos,Graph, {$ifdef Linux}
GameUnit; {Supplied with FPC demoes package. Wrapper for {$define Unix}
{$endif}
{$Define UseGraphics}
{$ifdef UseGraphics}
{$ifdef Win32}
{$define Win32Graph} // Needed for GameUnit.
{$APPTYPE GUI}
{$endif}
{$endif}
Uses
{$ifdef Win32}
WinCrt,Windows,
{$else}
Crt,
{$endif}
Dos,Graph,GameUnit; {Supplied with FPC demoes package. Wrapper for
mousesupport (via msmouse or api), and contains mousesupport (via msmouse or api), and contains
highscore routines} highscore routines}
@ -34,6 +51,13 @@ Const nox = 10;
ComprBufferSize = 20000; {Buffer for diskread- RLE'ed data} ComprBufferSize = 20000; {Buffer for diskread- RLE'ed data}
PicsFilename = 'quaddata.dat'; {Name of picturesfile} PicsFilename = 'quaddata.dat'; {Name of picturesfile}
ScoreFileName = 'quad.scr'; ScoreFileName = 'quad.scr';
{$IFDEF UseGraphics}
DisplGrX=110;
DisplGrY=90;
DisplGrScale=16;
HelpY=130;
{$ENDIF}
Type Type
pByte = ^Byte; {BufferTypes} pByte = ^Byte; {BufferTypes}
@ -79,6 +103,7 @@ Var b : array[1..nox,1..noy] Of card;
bgidirec : string; bgidirec : string;
time : time_record; time : time_record;
{ {
Procedure fatal(fcall:String); Procedure fatal(fcall:String);
Begin Begin
@ -97,13 +122,38 @@ Procedure ginit640x480x16(direc:String);
Var grd,grmode: integer; Var grd,grmode: integer;
Begin Begin
{$ifdef Win32}
{$ifndef Debug}
ShowWindow(GetActiveWindow,0);
{$endif}
grmode:=vgaHI;
grd:=vga;
Direc:='';
{$else}
closegraph; closegraph;
grd := 9;{ detect;} grd := 9;{ detect;}
grmode := 2;{ m800x600x16;} grmode := 2;{ m800x600x16;}
{$endif}
initgraph(grd,grmode,direc); initgraph(grd,grmode,direc);
{$ifndef Win32}
setgraphmode(2); setgraphmode(2);
{$endif}
End; End;
procedure WaitForMouse;
var ms_mx,ms_my,ms_but : LONGINT;
begin
Repeat
GetMouseState(ms_mx,ms_my,ms_but);
Until ms_but=0;
Repeat
GetMouseState(ms_mx,ms_my,ms_but);
Until ms_but<>0;
end;
Procedure clean_board; Procedure clean_board;
Var x,y: byte; Var x,y: byte;
@ -349,7 +399,9 @@ Begin
Until c>nof; Until c>nof;
delay(75); delay(75);
{$ifndef Win32}
gotoxy(1,1); gotoxy(1,1);
{$endif}
c := 1; c := 1;
Repeat Repeat
@ -402,31 +454,59 @@ Begin
Until keypressed; Until keypressed;
End; End;
{$ifdef Win32Graph}
Procedure ClearTextCoord(x1,y1,x2,y2:Longint);
Begin
SetFillStyle(SolidFill,0); {Clear part of playfield}
Bar ((x1+1) * DisplGrScale, (Y1+1)*DisplGrScale,(x2+1) * DisplGrScale, (Y2+1)*DisplGrScale);
End;
{$endif}
Procedure win; Procedure win;
Var m,s: string; Var m,s: string;
I,J : LONGINT; I,J : LONGINT;
Const GameOver='Game Over, turns needed = ';
Begin Begin
hidemouse; hidemouse;
fire_works; // fire_works;
cleardevice; cleardevice;
{$ifndef Win32}
closegraph; closegraph;
textmode(co80+font8x8); textmode(co80+font8x8);
clrscr; clrscr;
{$endif}
I:=SlipInScore(Turns); I:=SlipInScore(Turns);
{$ifndef Win32}
GotoXY(1,23); GotoXY(1,23);
Writeln('Game Over, turns needed = ',Turns); Writeln(GameOver,Turns);
FOR J:=9 TO 22 DO FOR J:=9 TO 22 DO
BEGIN BEGIN
GotoXY(20,J); GotoXY(20,J);
Write(' ':38); Write(' ':38);
END; END;
{$else}
SetColor(White);
ClearTextCoord(20,9,58,22);
Str(Turns,S);
S:=GameOver+S;
OutTextXY(5,40+9*LineDistY,S);
OutTextXY(5,40+23*LineDistY,'Press mouse to continue');
WaitForMouse;
{$endif}
IF I<>0 THEN IF I<>0 THEN
BEGIN BEGIN
ShowHighScore; ShowHighScore;
{$IFDEF USEGRAPHICS} {$IFDEF USEGRAPHICS}
GrInputStr(S,20,21-I,16,12,10,FALSE,AlfaBeta); SetColor(Black);
Bar(5,40+23*LineDisty,5+8*26,40+23*LineDisty+8);
SetColor(White);
OutTextXY(5,40+23*LineDistY,'Please enter your name');
GrInputStr(S,300,HelpY+20+(17-I+1)*LineDistY,16,12,10,FALSE,AlfaBeta);
{$ELSE} {$ELSE}
InputStr(S,20,21-I,10,FALSE,AlfaBeta); InputStr(S,20,21-I,10,FALSE,AlfaBeta);
{$ENDIF} {$ENDIF}
@ -440,7 +520,13 @@ Begin
HighScore[I-1].Name:=S; HighScore[I-1].Name:=S;
END; END;
ShowHighScore; ShowHighScore;
{$ifdef Win32}
Bar(5,40+23*LineDisty,5+8*26,40+23*LineDisty+8);
OutTextXY(5,40+23*LineDistY,'Press mouse to continue');
WaitForMouse;
{$else}
ginit640x480x16(bgidirec); ginit640x480x16(bgidirec);
{$endif}
off := false; off := false;
clean_board; clean_board;
set_board; set_board;
@ -488,7 +574,9 @@ Begin
inc(c); inc(c);
Until c>9; Until c>9;
turns := 0; turns := 0;
{$ifndef Win32}
gotoxy(1,1); gotoxy(1,1);
{$endif}
readln; readln;
off := false; off := false;
@ -590,8 +678,12 @@ Begin
{$I+} {$I+}
If ioresult<>0 Then If ioresult<>0 Then
BEGIN BEGIN
{$ifdef Win32}
MessageBox(GetActiveWindow,'Error','Fatal error, couldn''t find graphics data file quaddata.dat',WM_QUIT);
{$else}
TextMode(CO80); TextMode(CO80);
Writeln('Fatal error, couldn''t find graphics data file quaddata.dat'); Writeln('Fatal error, couldn''t find graphics data file quaddata.dat');
{$endif}
HALT; HALT;
END; END;
@ -628,16 +720,28 @@ VAR I : LONGINT;
Begin Begin
Randomize; {Initialize random generator} Randomize; {Initialize random generator}
Negative:=TRUE; {Higher highscore is worse} Negative:=TRUE; {Higher highscore is worse}
{$ifdef Win32}
HighX :=300; {Coordinates of highscores}
HighY :=130+20+8*LineDistY; {y coordinate relative to other options}
{$else}
HighX:=20; HighY:=9; {coordinates for highscores} HighX:=20; HighY:=9; {coordinates for highscores}
{$endif}
GetMem(PicData,PicBufferSize); {Allocate room for pictures} GetMem(PicData,PicBufferSize); {Allocate room for pictures}
load_pics(PicData); {Load picture data from file} load_pics(PicData); {Load picture data from file}
FOR I:=0 TO 9 DO {Create default scores} FOR I:=0 TO 9 DO {Create default scores}
begin
HighScore[I].Score:=-100*I; {Negative, because then the HighScore[I].Score:=-100*I; {Negative, because then the
"highest" score is best} "highest" score is best}
If HighScore[I].Score>0 Then
Writeln('ohoh');
End;
LoadHighScore(ScoreFileName); {Try to load highscore file} LoadHighScore(ScoreFileName); {Try to load highscore file}
closegraph; // closegraph;
{$ifNdef FPC}
bgidirec := 'd:\prog\bp\bgi'; bgidirec := 'd:\prog\bp\bgi';
{$ENDIF}
ginit640x480x16(bgidirec); ginit640x480x16(bgidirec);
setcolor(card_border); setcolor(card_border);
ok := true; ok := true;
@ -660,17 +764,23 @@ Begin
showmouse; showmouse;
End; End;
Begin
Begin
Negative:=True;
clean; clean;
Repeat Repeat
interpret; interpret;
Until exit1=true; Until (exit1=true) {$ifdef Debug} or (turns=1) {$endif};
{$ifndef Win32}
closegraph; closegraph;
textmode(co80); {$endif}
Freemem(PicData,PicBufferSize); Freemem(PicData,PicBufferSize);
clrscr;
SaveHighScore; SaveHighScore;
{$ifndef Win32}
Textmode(co80);
clrscr;
HideMouse;
Writeln('Thanks for playing Quadruple Memory'); Writeln('Thanks for playing Quadruple Memory');
Writeln('Feel free to distribute this software.'); Writeln('Feel free to distribute this software.');
Writeln; Writeln;
@ -679,9 +789,35 @@ Begin
Writeln('Inspired by: Jos Dickman''s triple memory!'); Writeln('Inspired by: Jos Dickman''s triple memory!');
Writeln('FPC conversion and cleanup by Marco van de Voort'); Writeln('FPC conversion and cleanup by Marco van de Voort');
Writeln; Writeln;
ShowMouse;
{$else}
SetbkColor(black);
SetColor(White);
SetViewPort(0,0,getmaxx,getmaxy,clipoff);
ClearViewPort;
SetTextStyle(0,Horizdir,2);
SetTextStyle(0,Horizdir,1);
OutTextXY(220,10,'QUAD');
OutTextXY(5,40+1*LineDistY,'Thanks for playing Quadruple Memory');
OutTextXY(5,40+2*LineDistY,'Feel free to distribute this software.');
OutTextXY(5,40+4*LineDistY,'Programmed by: Justin Pierce');
OutTextXY(5,40+5*LineDistY,'Graphics by: Whitney Pierce');
OutTextXY(5,40+6*LineDistY,'Inspired by: Jos Dickman''s triple memory!');
OutTextXY(5,40+7*LineDistY,'FPC conversion and cleanup by Marco van de Voort');
OutTextXY(5,40+9*LineDistY,'Press mouse to continue');
WaitForMouse;
{$endif}
{$ifdef Win32}
CloseGraph;
{$endif}
End. End.
$Log$ $Log$
Revision 1.1 2001-05-03 21:39:33 peter Revision 1.2 2002-02-25 12:23:05 marco
* Fixes for Quad Win32 GUI mode
Revision 1.1 2001/05/03 21:39:33 peter
* moved to own module * moved to own module
Revision 1.2 2000/07/13 11:33:08 michael Revision 1.2 2000/07/13 11:33:08 michael