Code:
Program CasseBriques;
{ =======================================
v1.3 Août 2017 - Nemo_59
HP Pascal v2.1 pour HP50g-HP49g+
--------------------------------------- }
Uses SystemHP,CrtHPmini_49,GraphHP,GameHP_49,
MathsHP_49, SoundHP_49;
Ressource Breakout;
Const NbTableau=5; HzMur=200; MsMur=5; HzBord=600; MsBord=5;
HzRqt=800; MsRqt=5; HzOut=100; MsOut=500;
Mvt : Array[1..8, 1..3, 1..2] Of Byte =
{ Chaque déplacement de la balle est décomposé en 3 mouvements de 1x1 pixel}
1, 0, 1,-1, 1,-1 { Direction 1 -3---2- }
, 0,-1, 1,-1, 1,-1 { Direction 2 4-----1 }
, 0,-1,-1,-1,-1,-1 { Direction 3 ------- }
,-1, 0,-1,-1,-1,-1 { Direction 4 ---O--- }
,-1, 0,-1, 1,-1, 1 { Direction 5 ------- }
, 0, 1,-1, 1,-1, 1 { Direction 6 5-----8 }
, 0, 1, 1, 1, 1, 1 { Direction 7 -6---7- }
, 1, 1, 1, 0, 1, 1;{ Direction 8 }
Tableau : Array[1..NbTableau, 0..15] Of String[14] =
'..............', { Tableau 1 }
'..............',
'..............',
'XXXXXXXXXXXXXX',
'XXXXXXXXXXXXXX',
'XXXXXXXXXXXXXX',
'XXXXXXXXXXXXXX',
'XXXXXXXXXXXXXX',
'..............',
'..............',
'..............',
'..............',
'..............',
'..............',
'..............',
'..............',
'..............', { Tableau 2 }
'..............',
'XXXXXXXXXXXXXX',
'XXXXXXXXXXXXXX',
'..............',
'..............',
'XXXXXXXXXXXXXX',
'XXXXXXXXXXXXXX',
'XXXXXXXXXXXXXX',
'..............',
'..............',
'..............',
'..............',
'..............',
'..............',
'..............',
'..............', { Tableau 3 }
'..X........X..',
'...X......X...',
'..XXXXXXXXXX..',
'..XX.XXXX.XX..',
'.XXXXXXXXXXXX.',
'XXXXXXXXXXXXXX',
'XXXXXXXXXXXXXX',
'X.X........X.X',
'X.X........X.X',
'...XXX..XXX...',
'...XXX..XXX...',
'..............',
'..............',
'..............',
'..............',
'..............', { Tableau 4 }
'..............',
'....XXXXXX....',
'..XXXXXXXXXX..',
'.XX.XXXXXX.XX.',
'XX...XXXX...XX',
'XXX.XXXXXX.XXX',
'XXXXXXXXXXXXXX',
'XX.XXXXXXXX.XX',
'XXX........XXX',
'.XXXX....XXXX.',
'..XXXXXXXXXX..',
'.....XXXX.....',
'..............',
'..............',
'..............',
'..............', { Tableau 5 }
'..............',
'....XXXXXX....',
'..XX.XXXXXXX..',
'.XX.XXXXX...XX',
'XX.XXXXX.XX.XX',
'X...XXXX.XX.XX',
'X.XX.XX.XX.XXX',
'X.XX.XX...XXXX',
'X.XX.XX.XXXXXX',
'.XXXXXX.XXXXX.',
'..XXXXX.XXXX..',
'....XXXXXX....',
'..............',
'..............',
'..............';
Static BestScore:Integer=350;
Var i, j, Rx, Bx, By, Bx2, By2,
Dir, Choc, b, Vies, LrgRqt,
Vitesse, Difficulte, Niveau, NBrique, TotBrique : Byte;
TapeMur, Perdu, GagneNiveau, SoundOn: Boolean;
Score,k : Integer;
c: Char;
{--------------------------}
Procedure DessineMur;
Begin
PutBloc(10,10,g_Level);
GotoXY(11,6); Write(Niveau);
GotoXY(3,8); Write('Press ENTER to play');
If SoundOn Then Begin
Beep(349,100); Beep(392,200); Beep(349,100); Beep(392,200); Beep(493,200); Beep(523,400);End
Else c:=ReadKey;
Clearbar(5,5,95,70);
TotBrique:=0;
Box(0,0,100,80);
For i:=1 To 14 Do
For j:=0 To 15 Do
If Tableau[((Niveau-1) MOD NbTableau)+1,j][i]='X' Then Begin
Bar((i-1)*7+2,j*4+2,i*7,j*4+4); TotBrique:=TotBrique+1;
If SoundOn Then Beep(Random(1000)+200,15);
End;
Bar(Rx,78,Rx+LrgRqt,79);
GotoXY(26,2); Write(Score);
GotoXY(26,5); Write(BestScore);
GotoXY(26,8); Write(Vies);
GotoXY(26,11);Write(Niveau);
Perdu:=False; GagneNiveau:=False;
Vitesse:=Difficulte-(Niveau Div (NbTableau+1)*3);
If Vitesse<2 Then Vitesse:=1;
NBrique:=0;
End;
{--------------------------}
Procedure BougeRaquette;
Var D : Char;
Begin
D:=' ';
For j:=1 To Vitesse Do Begin
If RightPressed Then D:='R';
If LeftPressed Then D:='L';
End;
Case D Of
'R': If Rx<86 Then
Begin
ClearLineV(Rx,78,79);
LineV(Rx+LrgRqt+1,78,79);
Rx:=Rx+1;
End;
'L': If Rx>1 Then
Begin
ClearLineV(Rx+LrgRqt,78,79);
LineV(Rx-1,78,79);
Rx:=Rx-1;
End;
End;
End;
{------------------------------}
Procedure BougeBalle;
Var Mx,My : Integer; Interm : Byte;
Begin
Interm:=1;
Repeat
BougeRaquette;
Bx2:=Bx+Mvt[Dir,Interm,1];
By2:=By+Mvt[Dir,Interm,2];
If Bx2>=99 Then Begin
Case Dir Of
1: Dir:=4;
2: Dir:=3;
7: Dir:=6;
8: Dir:=5;
End;
Bx2:=98; If SoundOn Then Beep(HzBord,MsBord);
Exit;
End;
If Bx2<=0 Then Begin
Case Dir Of
3: Dir:=2;
4: Dir:=1;
5: Dir:=8;
6: Dir:=7;
End;
Bx2:=2; If SoundOn Then Beep(HzBord,MsBord);
Exit;
End;
If By2<=0 Then Begin
Case Dir Of
1: Dir:=8;
2: Dir:=7;
3: Dir:=6;
4: Dir:=5;
End;
By2:=4; If SoundOn Then Beep(HzBord,MsBord);
Exit;
End;
BougeRaquette;
If By2=77 Then Begin
k:=Bx2; k:=k-Rx+1;
If Dir in [7,8] And (k=-1 Or (k=-2 And LeftPressed)) Then k:=0;
If Dir in [5,6] And (k=15 Or (k=16 And RightPressed)) Then k:=14;
If k>=0 And k<=LrgRqt+1 Then Begin
Case k Of
0 : Dir:=4;
1,2 : Case Dir Of 5,6: Dir:=4; 7,8: Dir:=2; End;
3..11 : Dir:=9-Dir;
12,13: Case Dir Of 5,6: Dir:=3; 7,8: Dir:=1; End;
14 : Dir:=1;
End;
If SoundOn Then Beep(HzRqt,MsRqt);
End Else Begin
Perdu:=True; ClearBar(Bx,By,Bx+1,By+1);
If SoundOn Then Beep(HzOut,MsOut);
End;
Exit;
End;
Choc:=0; TapeMur:=False;
ClearBar(Bx,By,Bx+1,By+1);
If Point(Bx2,By2) Then Choc:=1;
If Point(Bx2+1,By2) Then Choc:=Choc+2;
If Point(Bx2+1,By2+1) Then Choc:=Choc+4;
If Point(Bx2,By2+1) Then Choc:=Choc+8;
Bar(Bx,By,Bx+1,By+1);
Case Dir Of
1,2: Case Choc Of
1,3: Begin TapeMur:=True; Dir:=9-Dir; End;
2 : Begin TapeMur:=True; Dir:=Dir+4; End;
6,4: Begin TapeMur:=True; Dir:=Dir+2; End;
End;
3,4: Case Choc Of
2,3: Begin TapeMur:=True; Dir:=Dir+2; End;
1 : Begin TapeMur:=True; Dir:=Dir+4; End;
9,8: Begin TapeMur:=True; Dir:=5-Dir; End;
End;
5,6: Case Choc Of
4,12: Begin TapeMur:=True; Dir:=9-Dir; End;
8 : Begin TapeMur:=True; Dir:=Dir-4; End;
1,9 : Begin TapeMur:=True; Dir:=Dir+2; End;
End;
7,8: Case Choc Of
8,12: Begin TapeMur:=True; Dir:=9-Dir; End;
4 : Begin TapeMur:=True; Dir:=Dir-4; End;
2,6 : Begin TapeMur:=True; Dir:=Dir-2; End;
End;
End;
If TapeMur Then Begin
NBrique:=NBrique+1;
Mx:=((Bx2-1) Div 7)*7 + 1;
My:=((By2-1) Div 4)*4 + 1;
ClearBar(Mx,My,Mx+6,My+3);
If SoundOn Then Begin Beep(HzMur,MsMur); Beep(HzMur*2,MsMur); End;
Score:=Score+5; GotoXY(26,2); Write(Score); Interm:=3;
End;
Interm:=Interm+1;
If By2<77 Then Begin
ClearBar(Bx,By,Bx+1,By+1);
Bar(Bx2,By2,Bx2+1,By2+1);
End;
Bx:=Bx2; By:=By2;
Until Interm=4;
End;
Procedure Parametres(c :Char);
Begin
If Ord(c)=16 Then Halt;
Case c Of
'A' : Begin ClearBar(118,22,125,44); PutSprite(118,22,Check); Difficulte:=15; End;
'B' : Begin ClearBar(118,22,125,44); PutSprite(118,31,Check); Difficulte:=11; End;
'C' : Begin ClearBar(118,22,125,44); PutSprite(118,40,Check); Difficulte:=8; End;
'D': Begin
If SoundOn Then SoundOn:=False Else SoundOn:=True;
ClearBar(63,49,70,61);
If SoundOn Then PutSprite(64,49,Check) Else PutSprite(64,56,Check);
End;
End;
End;
Procedure Initialisation;
Begin
EnableInterrupt;ClearBar(0,0,130,79);
If SoundOn Then SoundOn:=False Else SoundOn:=True;
AppearCool(Instructions);
Parametres(Chr(68));
Case Difficulte Of
15 : Parametres(Chr(65));
11 : Parametres(Chr(66));
8 : Parametres(Chr(67));
End;
While KeyPressed Do c:=ReadKey;
Repeat
c:=ReadKey;
If SoundOn Then Beep(440,20);
Parametres(c);
Until Ord(c)=13;
DisappearCool;
End;
{-------- Programme principal -----------}
Begin
AppearCool(Breakout2); LineV(128,0,59); LineV(129,0,59);
GotoXY(7,11); Write('Press ENTER to Play');
GotoXY(7,12); Write('Press DEL<- to Exit');
c:=ReadKey; If c=Chr(16) Then Halt;
DisappearCool;
SoundOn:=True; Difficulte:=15; Contraste(15);
Repeat
Initialisation;
Score:=0; Vies:=6; Niveau:=1; Rx:=35; LrgRqt:=13;
ClrScr; PutBloc(100,0,Menu);
Repeat
{Nouveau Niveau}
Vies:=Vies+2; DessineMur;
DisableInterrupt;
Repeat
{Nouvelle balle}
By:=75; Bx:=Rx+5; Dir:=Random(3)+1;
GotoXY(26,8); Write(Vies);
Repeat BougeRaquette; Until UpPressed Or ExitPressed Or EnterPressed;
If SoundOn Then Beep(740,300);
Bx:=Rx+6;
Perdu:=False;
Repeat
BougeBalle;
If NBrique=TotBrique Then GagneNiveau:=True;
Until GagneNiveau Or Perdu Or ExitPressed;
ClearBar(Bx,By,Bx+1,By+1);
If Perdu Then Vies:=Vies-1; GotoXY(26,8); Write(Vies);
Until Vies=0 Or GagneNiveau Or ExitPressed;
Niveau:=Niveau+1;
EnableInterrupt;
Until Vies=0 Or ExitPressed;
GotoXY(8,8); Write('GAME OVER'); Box(30,46,68,54);
If Score>BestScore Then Begin
ClearBar(1,1,99,79);PutBloc(4,6,Best);
BestScore:=Score;
If SoundOn Then Begin
Beep(233,400);Beep(349,400);Beep( 311,133);Beep( 293,133);Beep( 261,133);Beep( 466,400);Beep( 349,400);
Beep( 311,133);Beep( 293,133);Beep( 261,133 );Beep(466,400 );Beep(349,400 );Beep(311,133 );
Beep(293,133 );Beep(311,133 );Beep(260,533);
End;
End;
GotoXY(5,11); Write('ENTER to replay');
GotoXY(5,12); Write(' DEL<- to exit');
ClearBar(1,78,99,79);
Repeat Until EnterPressed Or ExitPressed;
Until ExitPressed;
End.
Search
Member List
Calendar
Help
/
Pascal language for HP49-50
