Programmer 7500/MAX_PROGRAMMERS.iso/INFO/CALC/DO.ZIP/DO.PAS

Pascal/Delphi Source File | 1988-10-08 | 6.9 KB | 295 lines

Program MathLine;

{Program by Dan Holloway, 39 Douglas drive     Herrin, Illinois 62948}

{An exercise in the use of command line parameters}

Uses Dos, Crt;

Var
 I1, I2, I3, I4, I5, I6     :  real;
 P1, P2, P3, P4, P5, P6     :  string;
 Code, I, A, B              :  integer;
 Answer, X , Y, Z           :  real;
 Fact, Factorials           :  real;

{-----------------------------------------------------------------------------}
procedure KickUp(var str : string);

{This procedure converts string to all uppercase}

 Var
 I   : integer;
begin
 for I := 1 to length(str) do
  str[I] := UpCase (str[I]);
 end;

{-----------------------------------------------------------------------------}
procedure KickDown(var str : string);

{This procedure converts string to all lowercase}

 Var
  I : integer;
begin
  for I := 1 to Length(str) do
   if (str[I] >= 'A') and (str[I] <= 'Z') then
   str[I] := Chr(Ord(str[I]) + 32)
end;

{-----------------------------------------------------------------------------}

procedure GraphYesNo;  {This procedure could easily be converted to}
 var                   {a function to produce color only if graphics card}
  C : integer;         {is available. exmp : if GraphYesNo then TextColor(B)}
begin
  if mem[0:$449] = 7 then
  writeln('Monochrome card'); {optional statement}
  if mem[0:$449] <> 7 then
  writeln('Color graphics adapter'); {optional statement}
  C := mem[0:449];
  writeln('Contents of location -mem- : ',C);  {optional statement}
end;

{-----------------------------------------------------------------------------}

procedure SoundOff;
Var I : integer;
Begin
  I := 1400;
  Repeat
    Sound(I);
    Delay(1);
    I := I + 1;
  Until I = 1410;
NoSound;           {If you forget this the sound keeps onnnnnnnn !}
end;

{-----------------------------------------------------------------------------}

procedure Hint;
Begin
    GraphYesNo;
    Randomize;
    B := Random(3) + 10;  {Add or restrict colors used}
    TextColor(B);
  writeln('                 Syntax as follows ....');
  writeln('                 Multiply    : do 3 x 4');
  writeln('                 Divide      : do 3 / 4');
  writeln('                 Add         : do 3 + 4');
  writeln('                 Subtract    : do 3 - 4');
  writeln('                 Power       : do power 2 5 [ where 2 = power ]');
  writeln('                 Root        : do root 3 9 [ where 3 = root ]');
  writeln('                 Factorial   : do factorial 5');
  SoundOff;
  GraphYesNo;
  GoToXY(1,25);
  Halt;
end;

{-----------------------------------------------------------------------------}

procedure Null;
Begin
  GraphYesNo;
  begin
    Randomize;
    B := Random(3) + 10;
    TextColor(B);
  end;
  writeln('             for help type  DO ?');
  writeln('__________________________________________________');
  SoundOff;
  GoToXY(1,25);
  Halt;
end;

{-----------------------------------------------------------------------------}

procedure Multiply;
Begin
 Answer := I1 * I3;
  GraphYesNo;
  begin
    Randomize;
    B := Random(3) + 10;
    TextColor(B)
  end;
 writeln('                  ',I1:2:3,' times ',I3:2:3,' is : ',Answer:6:6);
 SoundOff;
 writeln;
 writeln;
 Halt;
end;

{-----------------------------------------------------------------------------}

procedure Divide;
Begin
  GraphYesNo;
  begin
    Randomize;
    B := Random(3) + 10;
    TextColor(B)
  end;
  if I3 > 0 then
  begin
   Answer := I1 / I3;
   writeln('                ',I1:2:3,' divided by ',I3:2:3,' is : ',Answer:6:6);
  end;
   if I3 = 0 then writeln('Division by zero not allowed !');
   SoundOff;
   writeln;
   writeln;
   Halt;
end;

{-----------------------------------------------------------------------------}

procedure Root;
Begin
  GraphYesNo;
  begin
    Randomize;
    B := Random(3) + 10;
    TextColor(B)
  end;
    if I3 <= 0 then
    begin
      writeln('Cannot take root of negative number or zero !');
      writeln;
      writeln;
      Halt;
    end;
    if I2 = 0 then
    begin
       writeln('Root cannot be a zero !');
    end;
  if I2 > 0 then
  begin
    X := ln(I3);
    Y := X / I2;
    Z := Exp(Y);
    writeln('               root ',I2:2:3,' of ',I3:2:3,' is : ',Z:6:6);
    SoundOff;
    writeln;
    writeln;
    Halt;
  end;
end;

{-----------------------------------------------------------------------------}

procedure Power;
Begin
  GraphYesNo;
  begin
    Randomize;
    B := Random(3) + 10;
    TextColor(B)
  end;
  if I3 <= 0 then
  begin
   writeln('Base numbers cannot be negative or zero !');
   writeln;
   writeln;
   Halt;
  end;
  if I3 > 0 then
  begin
    X := ln(I3);
    Y := X * I2;
    Z := Exp(Y);
    writeln('               ',I3:2:3,' to power ',I2:2:3,' is : ',Z:6:6);
    SoundOff;
    writeln;
    writeln;
    Halt;
  end;
end;

{-----------------------------------------------------------------------------}

procedure Add;
Begin
  Answer := I1 + I3;
  GraphYesNo;
  begin
    Randomize;
    B := Random(3) + 10;
    TextColor(B)
  end;
  writeln('                 The sum of ',I1:2:6,' and ',I3:2:3,' is : ',Answer:3:9);
  SoundOff;
  writeln;
  writeln;
  Halt;
end;

{-----------------------------------------------------------------------------}

procedure Subtract;
Begin
  Answer := I1 - I3;
  GraphYesNo;
  begin
    Randomize;
    B := Random(3) + 10;
    TextColor(B)
  end;
  writeln('                 ',I1:2:3,' minus ',I3:2:3,' is : ',Answer:3:6);
  SoundOff;
  writeln;
  writeln;
  Halt;
end;

{-----------------------------------------------------------------------------}

procedure Factorial;
Begin
   Fact := 1;
    for I := 2 to Round(I2) do
    Fact := Fact * I;
   Factorials := Fact;
  GraphYesNo;
  begin
    Randomize;
    B := Random(3) + 10;
    TextColor(B)
  end;
   writeln('                factorial ',I2:2:3,' is : ',Factorials:2:3);
   SoundOff;
   writeln;
   writeln;
   Halt;
end;

{-----------------------------------------------------------------------------}

Begin
  P1 := ParamStr(1);  {Assign P1 as the first parameter, P2 the second, etc.}
  P2 := ParamStr(2);
  P3 := ParamStr(3);
  P4 := ParamStr(4);
  P5 := ParamStr(5);
  P6 := ParamStr(6);
  Val(P1, I1, Code);  {P1 is a string value. Use Val to allow integer value.}
  Val(P2, I2, Code);  {The integer value is used in the procedures to do the}
  Val(P3, I3, Code);  {calculations.  Simple, but it looks slick !}
  Val(P4, I4, Code);
  Val(P5, I5, Code);
  Val(P6, I6, Code);
  KickUp(P2);
  If P2 = 'X' then Multiply;
  If P2 = '/' then Divide;
  KickUp(P1);
  if P1 = '' then Null;
  if P1 = '?' then Hint;
  if P1 = 'ROOT' then Root;
  if P1 = 'POWER' then Power;
  if P1 = 'FACTORIAL' then Factorial;
  if P2 = ('+') then Add;
  if P2 = ('-') then Subtract;
end.