home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
games
/
mathmatt.zip
/
MATHMATT.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1988-03-24
|
9KB
|
494 lines
{$I+,K+,R+}
program mattmath(input,output);
var
score,num1,num2,answer,WrongCount:byte;
DoSound:boolean;
WrongNum1:array[1..10] of byte;
WrongNum2:array[1..10] of byte;
WrongOp:array[1..10] of byte;
procedure Setup;
var UseSound:char;
begin
GraphColorMode;
gotoXY(4,15);
write ('Do you want to include sound? (Y/N)');
read (UseSound);
if UseSound='y' then
UseSound:='Y';
if UseSound='Y' then
begin
DoSound:=TRUE;
end
else
begin
DoSound:=FALSE;
end;
ClrScr;
end;
procedure hesitation;
var x:integer;
begin
for x:=1 to 2500 do
begin
end;
end;
procedure BigWait;
var x:integer;
begin
for x:=1 to 30000 do
begin
end;
end;
procedure stars;
var
Reps,row:integer;
col,color:byte;
begin
for Reps:=1 to 1000 do
begin
Row:=random(320);
Col:=random(200);
Color:=random(5);
Plot(Row,Col,Color);
end;
end;
procedure title;
var
Col,Color:byte;
row,Blip,Reps,x:integer; {repetitions & screen coordinates}
begin
x:=0;
repeat {begin procedure}
for Reps:=1 to 2000 do
begin {begin for loop}
Row:=random(320);
Col:=random(200);
Color:=random(5);
Plot(Row,Col,Color);
case Reps of
100:begin
GotoXY(18,15);
write('MATT');
if DoSound then
begin
sound(440);
delay(20);
end;
end;
250:begin
GotoXY(18,15);
write('MATH');
if DoSound then
begin
sound(660);
delay(20);
end;
end;
500:begin
GotoXY(18,15);
write('MATT');
if DoSound then
begin
sound(260);
delay(20);
end;
end;
750:begin
GotoXY(18,15);
write('MATH');
if DoSound then
begin
sound(1000);
delay(20);
end;
end;
1000:begin
GotoXY(18,15);
write('MATT');
if DoSound then
begin
sound(880);
delay(20);
end;
end;
1250:begin
GotoXY(18,15);
write('MATH');
if DoSound then
begin
sound(360);
delay(20);
end;
end;
1500:begin
GotoXY(18,15);
write('MATT');
if DoSound then
begin
sound(500);
delay(20);
end;
end;
1750:begin
GotoXY(18,15);
write('MATT');
if DoSound then
begin
sound(750);
delay(20);
end;
end;
end;
NoSound;
end;
GotoXY(15,15);
write(' ');
x:=x+1;
until x=2;
end; {end procedure}
procedure GoodNoise;
var pitch:integer;
begin
if DoSound then
begin
for pitch:=440 to 1100 do
begin
sound(pitch);
delay(1);
end;
NoSound;
end;
end;
procedure BadNoise;
var pitch:integer;
begin
if DoSound then
begin
for pitch:=440 downto 1 do
begin
sound(pitch);
delay(1);
end;
NoSound;
end;
end;
procedure conclusion;
var pitch,counter,fore,x:integer;
sign:char;
begin
gotoxy(15,15);
if score < 5 then
writeln('Keep Trying!!');
if score >5 then
writeln('Good Job!');
if score >=8 then
writeln(' In fact, EXCELLENT JOB!!');
if score =10 then
begin {begin perfect score routine}
BigWait;
for fore:=1 to 15 do
begin
GotoXY(12,fore);
TextColor(fore);
write('PERFECTAMUNDO!!!');
if DoSound then
begin
for pitch:=440 to 1000 do
begin
sound(pitch);
delay(1);
end;
for pitch:=1000 downto 440 do
begin
sound(pitch);
delay(1);
end;
end;
end; {end perfect score routine}
NoSound;
end;
if WrongCount>0 then
begin
for x:=1 to 8 do
BigWait;
GotoXY(2,5);
writeln(' These are the ones to practice:');
writeln;
for x:=1 to WrongCount do
begin
if WrongOp[x]=1 then {establish sign for wrong listing}
begin
sign:='+';
end
else
begin
sign:='-'
end;
writeln(' ',WrongNum1[x],Sign,WrongNum2[x]);
writeln;
end;
end;
end;
procedure Storeit(var Op:byte);
begin
WrongCount:=WrongCount+1;
WrongNum1[WrongCount]:=Num1;
WrongNum2[WrongCount]:=Num2;
WrongOp[WrongCount]:=Op;
end;
procedure Fixit (var Op:byte);
var x:byte;
begin
if Op=1 then
begin
GotoXY(10,11);
write('If you add ',Num1,' and ',Num2);
GotoXY(10,12);
writeln('Then the answer is ',Num1+Num2);
for x:=1 to 35 do
BigWait;
end
else
begin
GotoXY(5,12);
writeln('Actually, ',Num1,' take away ',Num2,' is ',Num1-Num2, '! ');
for x:=1 to 35 do
BigWait;
end;
Storeit(Op);
end;
procedure question;
const
MaxRow=23;
MidRow=15;
MidCol=20;
var
Row,Counter,Op,x:byte;
strlen:string[3];
begin
score:=0;
for counter:=1 to 10 do
begin
GotoXY(1,2);
writeln('Question Number:',Counter);
writeln('Score:',Score);
Num1:=random(16);
while (Num1=0) or (Num1<7) do
Num1:=random(16);
Num2:=random(Num1);
while Num2=0 do
Num2:=random(Num1);
Op:=random(3);
if Op=0 then
Op:=1;
if Op=1 then
begin
GotoXY(17,25);
write('ADDITION');
end
else
begin
GotoXY(15,25);
write('SUBTRACTION');
end;
for Row:=1 to MidRow do {get first number}
begin
GotoXY(MidCol,Row);
write(Num1:2);
if Row <> MidRow then
hesitation;
GotoXY(MidCol,Row-1);
write(' ');
end;
for Row:=MaxRow downto MidRow+1 do {get second number}
begin
GotoXY(MidCol,Row);
Write(Num2:2);
if Row<>MidRow-1 then
hesitation;
GotoXY(MidCol,Row+1);
write(' ');
end;
GotoXY(MidCol,Row+1);
write('__');
if ( (Op=1) and (Num1+Num2<10)) or ((Op=2) and (Num1-Num2<10)) then
begin
GotoXY(MidCol+1,Row+2);
readln(answer);
end
else
begin
GotoXY(MidCol,Row+2);
readln(answer);
end;
str(answer,strlen);
if length(strlen)>1 then
begin
GotoXY(MidCol,Row+2);
write(answer,' ');
end;
if Op=1 then {right answer test -- addition}
begin
if answer=Num1+Num2 then
begin
Score:=Score+1;
GotoXY(17,22);
write('RIGHT!!!');
GoodNoise;
for x:=1 to 5 do
BigWait;
end
else
begin
GotoXY(19,22);
write('SORRY!');
BadNoise;
for x:=1 to 5 do
BigWait;
Fixit(Op);
end;
end;
if Op=2 then {Right answer test --Subtraction}
begin
if (answer=Num1-Num2) then
begin
Score:=Score+1;
GotoXY(15,22);
write('TERRIFIC!!');
GoodNoise;
for x:=1 to 5 do
BigWait;
end
else
begin
GotoXY(10,25);
write('NOPE! TRY THE NEXT ONE!');
BadNoise;
for x:=1 to 5 do
BigWait;
Fixit(Op);
end;
end;
GraphColorMode;
Stars;
end; {end of counter loop}
end; {end of question/answer loop}
begin
Setup;
GraphColorMode;
Title;
WrongCount:=0;
Question;
Conclusion;
end.