Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/tools/wmgsmath.tst

Text File | 1988-05-03 | 5.3 KB | 248 lines

with Text_Io, TRIG_FUNCTIONS, Graphic, core_functions, numeric_primitives;
use  Text_Io, TRIG_FUNCTIONS, Graphic, core_functions, numeric_primitives;
procedure Math_Test is
  Pic   : View_Port;
  Done  : boolean := false;
  Reply : character;

package FI is new Float_Io(float);
use FI;

procedure Get_Input(Allowed : in string; Response : out character) is
  Reply : character;
begin
  loop
    get(Reply);
    put(ascii.bs);
    put(' ');
    put(ascii.bs);
    if Reply in 'A'..'Z' then
      Reply := character'val(character'pos(Reply) + 32);
    end if;
    for I in 1..Allowed'last loop
      if Reply = Allowed(I) then
        done := true;
        exit;
      end if;
    end loop;
    exit when done;
  end loop;
  Response := Reply;
end Get_Input;

procedure Show_Options is
begin
  new_line;
  put_line("    a) Sin");
  put_line("    b) Cos");
  put_line("    c) Tan");
  put_line("    d) Log");
  put_line("    e) Log10");
  put_line("    f) Truncate");
  put_line("    z) quit");
end Show_Options;

procedure Numeric_Test is
  Reply : character := ' ';

  procedure Tester(C : in character) is
    X : float;
  begin
    put("  X = ");
    get(X);
    Case C is
      when 'a' => put("Sin(X) = ");   put(Sin(X));
      when 'b' => put("Cos(X) = ");   put(Cos(X));
      when 'c' => put("Tan(X) = ");   put(Tan(X));
      when 'd' => put("Log(X) = ");   put(Log(X));
      when 'e' => put("Log10(X) = "); put(Log10(X));
      when 'f' => put("Truncate(X) = "); put(Truncate(X));
      when others => null;
    end case;
    new_line;
  end Tester;

begin  -- Numeric_Test
  Show_Options;
  Get_Input("abcdefz", Reply);
  if Reply = 'z' then
    done := true;
  else
    Tester(Reply);
  end if;
end Numeric_Test;

procedure Graphic_Test is
  X_Min, X_Max, Y_Min, Y_Max : float;
  X: float;

  procedure Show_Window is
  begin
    Set_Window(X_Min, Y_Min, X_Max, Y_Max);
    Set_Color(Red);
    Frame_Port;
    Move_To(X_Min, 0.0);
    Line_To(X_Max, 0.0);
    Move_To(0.0, Y_Min);
    Line_To(0.0, Y_Max);
    Set_Color(Green);
    put(ascii.esc);
    put("[0;68H(");
    put(X_Max, 3, 4);
    put(',');
    put(Y_Max, 3, 4);
    put(')');
    put(ascii.esc);
    put("[22;2H(");
    put(X_Max, 3, 4);
    put(',');
    put(Y_Max, 3, 4);
    put(')');
    Set_Mode(Graphics);
  end Show_Window;

  procedure Show_Sin is
    Inc : constant float := Pi / 30.0;
  begin
    X_Min := -Two_Pi;
    X_Max :=  Two_Pi;
    Y_Min := -1.5;
    Y_Max :=  1.5;
    Show_Window;
    X := X_Min;
    Move_To(X, Sin(X));
    while X <= X_Max loop
      X := X + Inc;
      Line_To(X, Sin(X));
    end loop;
  end Show_Sin;

  procedure Show_Cos is
    Inc : constant float := Pi / 30.0;
  begin
    X_Min := -Two_Pi;
    X_Max :=  Two_Pi;
    Y_Min := -1.5;
    Y_Max :=  1.5;
    Show_Window;
    X := X_Min;
    Move_To(X, Cos(X));
    while X <= X_Max loop
      X := X + Inc;
      Line_To(X, Cos(X));
    end loop;
  end Show_Cos;

  procedure Show_Tan is
    Inc : constant float := Pi / 30.0;
    Y, Last_Y : float;
  begin
    X_Min := -Two_Pi;
    X_Max :=  Two_Pi;
    Y_Min := -5.0;
    Y_Max :=  5.0;
    Show_Window;
    X := X_Min;
    Y := Tan(X);
    Move_To(X, Y);
    while X <= X_Max loop
      X := X + Inc;
      Last_Y := Y;
      Y := Tan(X);
      if abs(Y - Last_Y) > 5.0 then
        Move_To(X, Y);
      else
        Line_To(X, Y);
      end if;
    end loop;
  end Show_Tan;

  procedure Show_Log is
    Inc : float;
  begin
    X_Min := -1.0;
    X_Max :=  20.0;
    Y_Min := -5.0;
    Y_Max :=  5.0;
    Inc   := X_Max / 50.0;
    Show_Window;
    X := Inc;
    Move_To(X, Log(X));
    while X <= X_Max loop
      X := X + Inc;
      Line_To(X, Log(X));
    end loop;
  end Show_Log;

  procedure Show_Log10 is
    Inc : float;
  begin
    X_Min := -1.0;
    X_Max :=  20.0;
    Y_Min := -5.0;
    Y_Max :=  5.0;
    Show_Window;
    Inc   := X_Max / 50.0;
    X := Inc;
    Move_To(X, Log10(X));
    while X <= X_Max loop
      X := X + Inc;
      Line_To(X, Log10(X));
    end loop;
  end Show_Log10;

  procedure Show_Truncate is
    Inc : float := 0.2;
  begin
    X_Min := -20.0;
    X_Max :=  20.0;
    Y_Min := -20.0;
    Y_Max :=  20.0;
    Show_Window;
    X := X_Min;
    Move_To(X, Truncate(X));
    while X <= X_Max loop
      X := X + Inc;
      Line_To(X, Truncate(X));
    end loop;
  end Show_Truncate;

begin  -- Graphic_Test
  Show_Options;
  Get_Input("abcdefz", Reply);
  if Reply = 'z' then
    done := true;
  else
    Erase_Screen;
    case Reply is
      when 'a' => Show_Sin;
      when 'b' => Show_Cos;
      when 'c' => Show_Tan;
      when 'd' => Show_Log;
      when 'e' => Show_Log10;
      when 'f' => Show_Truncate;
      when others => null;
    end case;
    Set_Mode(Text);
  end if;
  put(ascii.esc);
  put("[23;0HPress <Space Bar> to continue");
  Get_Input(" ", Reply);
end Graphic_Test;

begin
  put("Numeric or Graphic: ");
  Create_Port(Pic, 5, 2, 70, 20);
  Select_Port(Pic);
  Set_Window(-10, -10, 10, 10);
  Get_Input("ng", Reply);
  loop
    if Reply = 'n' then
      Numeric_Test;
    else
      Graphic_Test;
    end if;
    exit when Done;
  end loop;
end Math_Test;