Shareware Overload/ShartewareOverload.cdr/games/mathmatt.zip/MATHMATT.PAS

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.