Task: Mandelbrot set



C#: using System;
using System.Drawing;
using System.Drawing.Imaging;
using System.Threading;
using System.Windows.Forms;




public class MandelbrotSetForm : Form
{
    const double MaxValueExtent = 2.0;
    Thread thread;

    static double CalcMandelbrotSetColor(ComplexNumber c)
    {
        
        const int MaxIterations = 1000;
        const double MaxNorm = MaxValueExtent * MaxValueExtent;

        int iteration = 0;
        ComplexNumber z = new ComplexNumber();
        do
        {
            z = z * z + c;
            iteration++;
        } while (z.Norm() < MaxNorm && iteration < MaxIterations);
        if (iteration < MaxIterations)
            return (double)iteration / MaxIterations;
        else
            return 0; 
    }

    static void GenerateBitmap(Bitmap bitmap)
    {
        double scale = 2 * MaxValueExtent / Math.Min(bitmap.Width, bitmap.Height);
        for (int i = 0; i < bitmap.Height; i++)
        {
            double y = (bitmap.Height / 2 - i) * scale;
            for (int j = 0; j < bitmap.Width; j++)
            {
                double x = (j - bitmap.Width / 2) * scale;
                double color = CalcMandelbrotSetColor(new ComplexNumber(x, y));
                bitmap.SetPixel(j, i, GetColor(color));
            }
        }
    }

    static Color GetColor(double value)
    {
        const double MaxColor = 256;
        const double ContrastValue = 0.2;
        return Color.FromArgb(0, 0,
            (int)(MaxColor * Math.Pow(value, ContrastValue)));
    }
    
    public MandelbrotSetForm()
    {
        
        this.Text = "Mandelbrot Set Drawing";
        this.BackColor = System.Drawing.Color.Black;
        this.BackgroundImageLayout = System.Windows.Forms.ImageLayout.Stretch;
        this.MaximizeBox = false;
        this.StartPosition = FormStartPosition.CenterScreen;
        this.FormBorderStyle = FormBorderStyle.FixedDialog;
        this.ClientSize = new Size(640, 640);
        this.Load += new System.EventHandler(this.MainForm_Load);
    }

    void MainForm_Load(object sender, EventArgs e)
    {
        thread = new Thread(thread_Proc);
        thread.IsBackground = true;
        thread.Start(this.ClientSize);
    }

    void thread_Proc(object args)
    {
        
        Size size = (Size)args;
        int width = 16;
        while (width * 2 < size.Width)
        {
            int height = width * size.Height / size.Width;
            Bitmap bitmap = new Bitmap(width, height, PixelFormat.Format24bppRgb);
            GenerateBitmap(bitmap);
            this.BeginInvoke(new SetNewBitmapDelegate(SetNewBitmap), bitmap);
            width *= 2;
            Thread.Sleep(200);
        }
        
        Bitmap finalBitmap = new Bitmap(size.Width, size.Height, PixelFormat.Format24bppRgb);
        GenerateBitmap(finalBitmap);
        this.BeginInvoke(new SetNewBitmapDelegate(SetNewBitmap), finalBitmap);
    }

    void SetNewBitmap(Bitmap image)
    {
        if (this.BackgroundImage != null)
            this.BackgroundImage.Dispose();
        this.BackgroundImage = image;
    }

    delegate void SetNewBitmapDelegate(Bitmap image);

    static void Main()
    {
        Application.Run(new MandelbrotSetForm());
    }
}

struct ComplexNumber
{
    public double Re;
    public double Im;

    public ComplexNumber(double re, double im)
    {
        this.Re = re;
        this.Im = im;
    }

    public static ComplexNumber operator +(ComplexNumber x, ComplexNumber y)
    {
        return new ComplexNumber(x.Re + y.Re, x.Im + y.Im);
    }

    public static ComplexNumber operator *(ComplexNumber x, ComplexNumber y)
    {
        return new ComplexNumber(x.Re * y.Re - x.Im * y.Im,
            x.Re * y.Im + x.Im * y.Re);
    }

    public double Norm()
    {
        return Re * Re + Im * Im;
    }
}






VB: option explicit


















Class ImgClass
  Private ImgL,ImgH,ImgDepth,bkclr,loc,tt
  private xmini,xmaxi,ymini,ymaxi,dirx,diry
  public ImgArray()  
  private filename   
  private Palette,szpal 
  
  Public Property Let depth (x) 
  if depth=8 or depth =24 then 
    Imgdepth=depth
  else 
    Imgdepth=8
  end if
  bytepix=imgdepth/8
  end property        
  
  Public Property Let Pixel (x,y,color)
  If (x>=ImgL) or x<0 then exit property
  if y>=ImgH or y<0 then exit property
  ImgArray(x,y)=Color   
  End Property
  
  Public Property Get Pixel (x,y)
  If (x<ImgL) And (x>=0) And (y<ImgH) And (y>=0) Then
    Pixel=ImgArray(x,y)
  End If
  End Property
  
  Public Property Get ImgWidth ()
  ImgWidth=ImgL-1
  End Property
  
  Public Property Get ImgHeight ()
  ImgHeight=ImgH-1
  End Property     
  
  
  Public Default Function Init(name,w,h,orient,dep,bkg,mipal)
  
  dim i,j
  ImgL=w
  ImgH=h
  tt=timer
  set0 0,0   
  redim imgArray(ImgL-1,ImgH-1)
  bkclr=bkg
  if bkg<>0 then 
    for i=0 to ImgL-1 
      for j=0 to ImgH-1 
        imgarray(i,j)=bkg
      next
    next  
  end if 
  Select Case orient
    Case 1: dirx=1 : diry=1   
    Case 2: dirx=-1 : diry=1
    Case 3: dirx=-1 : diry=-1
    Case 4: dirx=1 : diry=-1
  End select    
  filename=name
  ImgDepth =dep
  
  if imgdepth=8 then  
    loadpal(mipal)
  end if       
  set init=me
  end function

  private sub loadpal(mipale)
    if isarray(mipale) Then
      palette=mipale
      szpal=UBound(mipale)+1
    Else
      szpal=256  
    
  
   End if  
  End Sub
  public sub set0 (x0,y0) 
    if x0<0 or x0>=imgl or y0<0 or y0>imgh then err.raise 9 
    xmini=-x0
    ymini=-y0
    xmaxi=xmini+imgl-1
    ymaxi=ymini+imgh-1 
    
  end sub

    
  Private Sub Class_Terminate
  if err <>0 then wscript.echo "Error " & err.number
  wscript.echo "writing bmp to file"
    savebmp
    wscript.echo "opening " & filename
    CreateObject("Shell.Application").ShellExecute filename
  wscript.echo timer-tt & " seconds"
  End Sub


 
 function long2wstr( x)  
      dim k1,k2,x1
      k1=  (x and &hffff&)
      k2=((X And &h7fffffff&) \ &h10000&) Or (&H8000& And (x<0))
      long2wstr=chrw(k1) & chrw(k2)
    end function 
    
    function int2wstr(x)
        int2wstr=ChrW((x and &h7fff) or (&H8000 And (X<0)))
    End Function


  Public Sub SaveBMP
    
    Dim s,ostream, x,y,loc
   
    const hdrs=54 
    dim bms:bms=ImgH* 4*(((ImgL*imgdepth\8)+3)\4)  
    dim palsize:if (imgdepth=8) then palsize=szpal*4 else palsize=0

    with  CreateObject("ADODB.Stream") 
      .Charset = "UTF-16LE"    
      .Type =  2
      .open 
      
      
      
      
      .writetext ChrW(&h4d42)                           
      .writetext long2wstr(hdrs+palsize+bms)            
      .writetext long2wstr(0)                           
      .writetext long2wstr (hdrs+palsize)               
       
      .writetext long2wstr(40)                          
      .writetext long2wstr(Imgl)                        
      .writetext long2wstr(imgh)                        
      .writetext int2wstr(1)                            
      .writetext int2wstr(imgdepth)                     
      .writetext long2wstr(&H0)                         
       
      .writetext long2wstr(bms)                         
      .writetext long2wstr(&Hc4e)                       
      .writetext long2wstr(&hc43)                       
      .writetext long2wstr(szpal)                       
      .writetext long2wstr(&H0)                         
     
      
      
       Dim x1,x2,y1,y2
       If dirx=-1 Then x1=ImgL-1 :x2=0 Else x1=0:x2=ImgL-1
       If diry=-1 Then y1=ImgH-1 :y2=0 Else y1=0:y2=ImgH-1 
       
      Select Case imgdepth
      
      Case 32
        For y=y1 To y2  step diry   
          For x=x1 To x2 Step dirx
           
           .writetext long2wstr(Imgarray(x,y))
          Next
        Next
        
      Case 8
        
        For x=0 to szpal-1
          .writetext long2wstr(palette(x))  
        Next
        
        dim pad:pad=ImgL mod 4
        For y=y1 to y2 step diry
          For x=x1 To x2 step dirx*2
             .writetext chrw((ImgArray(x,y) and 255)+ &h100& *(ImgArray(x+dirx,y) and 255))
          Next
          
          if pad and 1 then .writetext  chrw(ImgArray(x2,y))
          if pad >1 then .writetext  chrw(0)
         Next
         
      Case Else
        WScript.Echo "ColorDepth not supported : " & ImgDepth & " bits"
      End Select

      
      Dim outf:Set outf= CreateObject("ADODB.Stream") 
      outf.Type    = 1 
      outf.Open
      .position=2              
      .CopyTo outf
      .close
      outf.savetofile filename,2   
      outf.close
    end with
  End Sub
End Class

function mandelpx(x0,y0,maxit)
   dim x,y,xt,i,x2,y2
   i=0:x2=0:y2=0
   Do While i< maxit
     i=i+1
     xt=x2-y2+x0
     y=2*x*y+y0
     x=xt 
     x2=x*x:y2=y*y 
     If (x2+y2)>=4 Then Exit do
   loop 
   if i=maxit then
      mandelpx=0
   else   
     mandelpx = i
   end if  
end function   

Sub domandel(x1,x2,y1,y2) 
 Dim i,ii,j,jj,pix,xi,yi,ym
 ym=X.ImgHeight\2
 
 xi=Abs((x1-x2)/X.ImgWidth)
 yi=Abs((y2-0)/(X.ImgHeight\2))
 j=0
 For jj=0.  To y2 Step yi
   i=0
   For ii=x1 To x2 Step xi
      pix=mandelpx(ii,jj,256)
      
      X.imgarray(i,ym-j)=pix
      X.imgarray(i,ym+j)=pix
      i=i+1   
   Next
   j=j+1   
 next
End Sub


Dim i,x

dim pp(255)
for i=1 to 255
   pp(i)=rgb(0,0,255*(i/255)^.25)  
next  
 
dim fn:fn=CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2)& "\mandel.bmp"
Set X = (New ImgClass)(fn,580,480,1,8,0,pp)
domandel -2.,1.,-1.2,1.2
Set X = Nothing