[Shootout-list] Mandelbrot Ada bench

Pascal Obry pascal@obry.net
Sat, 19 Mar 2005 15:28:41 +0100


Here is a new version of the Mandelbrot Ada bench (works properly
compared to previous version and should be faster).

-- The Great Computer Language Shootout
-- http://shootout.alioth.debian.org
--
-- Contributed by Jim Rogers
-- Fixed by Pascal Obry on 2005/03/19

with Ada.Text_IO;         use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
with Ada.Command_Line;    use Ada.Command_Line;
with Interfaces;          use Interfaces;

procedure Mandelbrot is
   type Real is digits 15;
   Iter                   : constant := 50;
   Limit                  : constant Real := 2.0;
   Limit2                 : constant Real := Limit * Limit;
   Width, Height          : Positive;
   Bit_Num                : Natural := 0;
   Byte_Acc               : Unsigned_8 := 0;
   Zr, Zi, Cr, Ci, Tr, Ti : Real;
   L, Zr2, Zi2            : Real;
begin
   Width := Positive'Value (Argument (1));

   Height := Width;

   Put_Line ("P4");
   Put (Item => Width, Width => 0);
   Put (" ");
   Put (Item => Height, Width => 0);
   New_Line;

   for Y in 0 .. Height - 1 loop
      for X in 0 .. Width - 1 loop
         Zr := 0.0;
         Zi := 0.0;
         Cr := 2.0 * Real (X) / Real (Width) - 1.5;
         Ci := 2.0 * Real (Y) / Real (Height) - 1.0;

         for I in 1 .. Iter loop
            Zr2 := Zr ** 2;
            Zi2 := Zi ** 2;
            Tr  := Zr2 - Zi2 + Cr;
            Ti  := 2.0 * Zr * Zi + Ci;
            Zr  := Tr;
            Zi  := Ti;
            L   := Zr2 + Zi2;
            exit when L > Limit2;
         end loop;

         if L > Limit2 then
            Byte_Acc := Shift_Left (Byte_Acc, 1) or 16#00#;
         else
            Byte_Acc := Shift_Left (Byte_Acc, 1) or 16#01#;
         end if;

         Bit_Num := Bit_Num + 1;

         if Bit_Num = 8 then
            Put (Character'Val(Byte_Acc));
         elsif X = Width - 1 then
            Byte_Acc := Shift_Left (Byte_Acc, 8 - Width mod 8);
            Put (Character'Val (Byte_Acc));
         end if;

         Byte_Acc := 0;
         Bit_Num  := 0;
      end loop;
   end loop;
end Mandelbrot;

Pascal.

-- 

--|------------------------------------------------------
--| Pascal Obry                           Team-Ada Member
--| 45, rue Gabriel Peri - 78114 Magny Les Hameaux FRANCE
--|------------------------------------------------------
--|              http://www.obry.org
--| "The best way to travel is by means of imagination"
--|
--| gpg --keyserver wwwkeys.pgp.net --recv-key C1082595