¿Hay algún juego PASCAL? Es urgente.

Write('El puntaje en el último juego fue :',LastScore

{$endif}

END); ;

DisplayPlayField(PlayField);

MarkField:=PlayField

FIN

PROCEDIMIENTO DoMainLoopMouse; >{El bucle principal del juego. Todo el juego se ejecuta en este procedimiento, el resto es

inicialización/finalización (como cargar y guardar puntuaciones altas, etc.)}

VAR X,Y,

MX,MY,MState,Dummy: LONGINT

EndOfGame:

LONGINT;

S : Cadena

COMENZAR

ALEatorizar

REPETIR

FillPlayField

BuildScreen;

EndOfGame:=0;

REPETIR

GetMouseState(MX,MY,MState); $IFDEF UseGraphics}

X:=2*((MX-GrFieldX) DIV ScalerX) +FieldX

Y:=((MY-GrFieldY) DIV ScalerY) +FieldY- 1;

{$ELSE}

X:=MX SHR 3

Y:=MI SHR 3; ENDIF}

IF PlayFieldPiecesLeft=0 ENTONCES

COMENZAR

INC(Score,1000

EndOfGame:=1; p>

COMENZAR

INC(Puntuación,1000);

EndOfGame:=1

FIN

ELSE;

COMENZAR

{$IFDEF UseGraphics}

IF (MX>=MenuX) AND ( MX<(MenuX+16*Length(GrNewGameLine))) ENTONCES

COMENZAR {X en el área en la que se puede hacer clic}

SI (MY>=MenuY) Y (MY<(MenuY+RowDispl *3+2)) ENTONCES

BEGIN

X:=65; {X no importa siempre que sea 60..69}

Y:=((MY-MenuY) DIV RowDispl)+4 ;

FIN;

FIN

{$ENDIF}

SI (X>=60) Y (X<=69 ) ENTONCES

COMENZAR

SI (MEstado Y Botón L) <>0 ENTONCES {Si se presiona el botón izquierdo,}

COMENZAR

SI Y =4 ENTONCES

EndOfGame:=1

SI Y=6 ENTONCES

EndOfGame: =2

SI (EndOfGame> 0) Y (PlayFieldPiecesLeft=0) ENTONCES

INC(Score,1000

SI Y=5 ENTONCES

COMENZAR

MostrarAyuda;

BuildScreen

FIN

{$IFDEF Linux}

SI Y=7 ENTONCES

COMENZAR

escribir(#27+'(K');

BuildScreen;

FINALIZAR;

{$ENDIF}

FIN;

FIN;

SI (X>=(CampoX-2)) Y (Y>=(CampoY-2)) ENTONCES

COMENZAR

DEC(X,CampoX-1

DE);

C(Y,FieldY-1);

X:=X SHR 1;

IF (X

COMENZAR

SI MarkField[X,Y]<>4 ENTONCES

COMENZAR

MarkField:=PlayField

MarkAfield(X, Y);

DisplayPlayField(MarkField);

{$ifdef UseGraphics}

SetFillStyle(SolidFill,negro); 420,440,540,460);

SetTextStyle(0,Horizdir,1);

Str(CubesToScore,S);

OuttextXY(420,440,'Marcado: '+S);

{$else}

TextColor(Blanco);

GotoXY(20,22); :20);

GotoXY(20,22);

Escribir('Marcado :',CubesToScore

{$endif}

END;

IF (MarkField[X,Y]=4) AND ((MState AND LButton) <>0) THEN

{Si se presiona el botón izquierdo,} p>

COMENZAR

REPETIR {esperar hasta que se suelte

El momento de presionar cuenta}

GetMouseState(X,Y,Dummy) ;

HASTA (Dummy AND LButton)=0;

Colapsar

MarkField:=PlayField

DisplayPlayField(MarkField);

p>

FIN

FIN

FIN

SI se presiona la tecla ENTONCES

COMENZAR

p>

X: =GetKey;

SI (CHR(X) IN ['X','x','Q','q']) O (X=27) ENTONCES

Fin del Juego :=2;

FIN;

FIN;

HASTA el Fin del Juego>0;

X:= SlipInScore(Puntuación);

SI X<>0 ENTONCES

COMENZAR

HideMouse

ShowHighScore;

{$IFDEF UseGraphics}

Str(Puntuación:5,S

OutTextXY(HighX+150,HighY+LineDistY*( 10-X),S) ;

GrInputStr(S,AltoX,AltoY+LineDistY*(10-X),16,12,10,FALSO,AlfaB

eta);

{$ELSE}

InputStr(S,AltoX,AltoY+12-X,10,FALSE,AlfaBeta); }

Puntuación más alta[X-1].Nombre:=S;

MostrarMouse

FIN

Última puntuación:=Puntuación;

HASTA EndOFGame=2

END;

CONST FileName='samegame.scr'; /p>

{$IFDEF UseGraphics}

gd,gm : INTEGER

Amigo : Tipo de paleta

{$ENDIF}

COMENZAR

{$IFDEF UseGraphics}

{$ifdef Win32}

ShowWindow(GetActiveWindow,0

{); $endif}

gm:=vgahi

gd:=vga

InitGraph(gd,gm,''); >si GraphResult <> grOk entonces

comenzar

Writeln('Controlador de gráfico ',gd,' modo gráfico ',gm,' no compatible'); >Detener(1);

fin;

SetFillStyle(SolidFill,1);

GetDefaultPalette(Pal); Pal);

{$ENDIF}

SI NO MousePresent ENTONCES

COMENZAR

Writeln('No se encontró ningún mouse. Hay un mouse). ¡requerido!');

HALT;

END;

PARA I:=0 A 9 HACER

HighScore[I]. Puntuación:=I*1500;

LoadHighScore(Nombre de archivo);

InitMouse;

{$ifndef Win32Graph}

CursorOff; /p>

{$endif}

{$IFDEF UseGraphics}

HighX:=450; HighY:=220; >

{$else}

HighX:=52; HighY:=10; {la posición de la tabla de puntuación más alta}

{$endif}

DoMainLoopMouse;

HideMouse;

DoneMouse;

{$ifndef Win32Graph}

CursorOn; $endif}

Guardar puntuación alta

{$IFDEF UseGraphics}

CloseGraph;

>{$ENDIF}

{$ifndef Win32Graph}

ClrScr

Writeln;

Writeln('Últimos juegos'#39 ' la puntuación fue: ',Puntuación);

{$endif}

END. ,v $

Revisión 1.3 2002/02/22 21:41:22 carl

* corrección de error de verificación de rango

Revisión 1.2 2001/11/11 21 :09:50 marco

* Gameunit, Fpctris y mismo juego arreglados para win32 GUI

Revisión 1.1 2001/05/03 21:39:33 peter

* movido al módulo propio

Revisión 1.2 2000/07/13 11:33:09 michael

+ registros eliminados

}