Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Posting-Version: version B 2.10.2 (Tek) 9/28/84 based on 9/17/84; site tekigm.UUCP
Path: utzoo!watmath!clyde!burl!ulysses!mhuxr!mhuxt!houxm!ihnp4!qantel!hplabs!tektronix!tekig3!tekigm!timothym
From: timothym@tekigm.UUCP (Timothy D Margeson)
Newsgroups: net.sources
Subject: Mandelbrot source for Turbo Pascal on PC's
Message-ID: <583@tekigm.UUCP>
Date: Fri, 4-Oct-85 19:04:57 EDT
Article-I.D.: tekigm.583
Posted: Fri Oct  4 19:04:57 1985
Date-Received: Sun, 6-Oct-85 14:41:31 EDT
Distribution: net
Organization: Tektronix, Beaverton OR
Lines: 820

For those of you who take the time to read this, here is a short blurb about
this program, and how to use it.

Every thing required to compile this file is included. It is in normal ASCII
format and does not require passing the article through any shells. You will
have to remove everything above the cut line for the compiler to be happy.

After compiling the program into a .com file:

Type MANDEL (I suggest this name for obvious reasons). The program will load
into memory and run. There will be a screen clear and a short delay as the
data arrays are being set up.

You will be given a menu of options available. Press the number desired -
WITHOUT - pressing the ENTER key.

MAIN MENU OPTION 1 -

             Create a new data file.  With this option, you will be
	     prompted to key the following information;

	     The horizontal picture reslution (0 to 319 pixels max.)
	     The vertical picture resolution (0 to 199 pixels max.)

	     The starting point of the horizontal axis (-2.0 to start)
	     The starting point of the vertical axis (-1.25 to start)

	     The length of the horizontal axis (2.5 to start)
	     The length of the vertical axis (2.5 to start)

	     The number of iterations (100 to start)

	     The name of the file to store data in (1.dat, 2.dat, etc)

  Follow each entry - WITH - pressing the ENTER key.

  NOTE- for a 199 by 199 picture, you will need 80kbytes available on the
  default drive. 128kbytes for a 319 by 199 picture.

  I recommend using the values given above for your first few attempts as
  these will not take a long time to compute (yes, the program can take a
  while, I have waited > 24 hours for some pictures). 

  While the program is calculating, a screen display shows the progress of
  the program by showing the current X and Y coordinates being worked on.


  After the calculation is complete, you are asked whether to plot the data
  now. Respond Y or N depending.....

  If you selected N you will be put back into the main menu described above.
  A Y response is essentially the same as selecting option 2 from the main 
  menu, except that you do not have to enter the filename.


MAIN MENU OPTION 2 -
	
	This option permits you to display Mandelbrot data files that have
	been calculated.

	Respond to the filename prompt by typing in desired filename, then
	press the ENTER key. 

	After finding the file, the program prompts for the colors to use
	for the display, and how calculate the color range. The IBM color
	display leaves alot to be desired. You can only have four colors
	showing at any one time. I prefer palette 3, and a background of
	0 for most displays.

	The last prompt is for where the program is to begin an averageing
	technique to show as much detail as possible in the areas close to
	the Mandelbrot set. Try values from 1 to 2 to start.

  The program will now read the data file from the disk. This too can take
  a while, especially from a floppy disk. After the file is loaded, the
  display will change from the default to the 320x200 color mode, and the
  data will be plotted to the screen.

    PRESS ANY KEY TO EXIT DISPLAY MODE ***********************************

  You will be prompted whether you want the information about the display
  sent to the printer, press Y if yes, N if not. Do not press ENTER. You
  will be asked if you wish to redisplay the picture, pressing N sends you
  back to the main menu, Y will go through the display option list again,
  but will not reread the disk file. This is handy for trying various 
  options on each of the data files.


MAIN MENU OPTION 3 -
 
	This option displays any of the .DAT and >PAR files on the default
	drive.


MAIN MENU OPTION 4 -

	To exit the program press 4.



---------------- REMOVE EVRERYTHING INCLUDING THIS LINE ------------------

Program Mandelbrot(input,output); { I suggest the name MANDEL.PAS }

(* This program calculates the complex number set called the Mandelbrot set *)
       (* Sorry for the lack of comments, but I did this in a rush. *)

const
  Xmax   : integer =  100;
  Ymax   : integer =  100;
  Limit  : integer = 1000;
  DisplayColors    =    3;  { IBM PC 0 background,1,2,3 }
                            { Do not include background }
type
  PicFile        = file of integer;
  ParmFile       = text;
  AnswerString   = char;
  FileNameString = string[30];
  DirSpec        = array[1..12] of char;
  PictureY   = array[0..199] of integer;
  PictureX   = array[0..320] of ^PictureY;

var
  BackGround,
  PaletteNumber,
  PixelValue,
  Xpos,
  Ypos,
  Xincrement,
  Yincrement    : integer;
  Xcorner,
  Xgap,
  Xsize,
  Ycorner,
  Ygap,
  Ysize         : real;
  Error         : boolean;
  Answer        : AnswerString;
  SaveFile      : PicFile;
  PicData       : PictureX;
  ParmSaveFile  : ParmFile;
  ParmSaveFileName,
  SaveFileName  : FileNameString;

{.PA} {**********************************************************************}

procedure GetResponse(A,B,C,D:char;var Response:char);

begin
  repeat
    repeat until KeyPressed;
    read(Kbd,Response);
  until Response in [A,B,C,D];
end;

 {**********************************************************************}

procedure CalcPixel(Xpos,Ypos:real;var Count:integer);

(* Compute the Mandelbrot value for a given pixel location Xpos,Ypos *)
(*                                                                   *)
(*             Z = Z*Z + C                                           *)
(*             Increment Count                                       *)
(*             Check Size of Z                                       *)
(*             Exit loop if Size of Z > 2 or Count > Limit           *)

var
  Cx,Cy,
  Zx,Zy,
  ZxZx,ZyZy,
  ZxZy,ZyZx,
  CxZx,CyZy,
  SizeZ      : real;

begin
  Count:=0;
  Cx:=Xpos;
  Cy:=Ypos;
  Zx:=0;
  Zy:=0;
  repeat

    ZxZx:=Zx*Zx;      (* Calculate Z , Zx is the real part  *)
    ZyZy:=Zy*Zy;      (*      Zy is the imaginary part      *)
    ZxZy:=Zx*Zy;
    ZyZx:=Zy*Zx;

    Zx:=ZxZx-ZyZy;    (* Sum parts of Z , Zy is imaginary and has been *)
    Zy:=ZxZy+ZyZx;    (*      negated to show existance of i*i=-1      *)

    Zx:=Zx+Cx;        (* Add C to Z , Cx is real , Cy is imaginary *)
    Zy:=Zy+Cy;

    Count:=Count+1;
    SizeZ:=ZxZx+ZyZy;

  until (Count>Limit) or (SizeZ>4);
end;

{.PA} {**********************************************************************}

procedure GetOption(var Answer:AnswerString);

begin
  writeln('Mandelbrot display generator');
  writeln;
  writeln('Enter 1 to generate a new data file,');
  writeln('      2 to display an existing data file');
  writeln('      3 to display data file directory');
  writeln('      4 to end program');
  writeln;
  write('Choice ? ');
  GetResponse('1','2','3','4',Answer);
end;

 {**********************************************************************}

procedure ParseFileName(var FileName:FileNameString);

const
  Default  = 'MANCOMP.';

type
  CharSet  = set of char;

var
  i,j       : integer;
  EndOfName : boolean;
  ValidChar : CharSet;

begin
  ValidChar:=['$'..'''','.','0'..'9','A'..'Z','_'..'z'];
  i:=0; j:=0;
  EndOfName:=false;
  if length(FileName)<1 then
    FileName:=Default;
  repeat
    j:=j+1;
    if not (FileName[j] in ValidChar) then
      FileName[j]:='$';
  until (j>length(FileName)) or (j>12);
  repeat
    i:=i+1;
    if (FileName[i]=chr(046)) {or (FileName[i]=chr(032))} then
      begin
        FileName[0]:=chr(i-1);
        EndOfName:=true;
      end
    else
      FileName[i]:=UpCase(FileName[i]);
  until (i=8) or EndOfName;
end;

{.PA} {**********************************************************************}

procedure PrintParmFile(ParmFileName:FileNameString);

var
  Xcorn,
  Ycorn,
  Xside,
  Yside,
  Xlength,
  Ylength,
  RealLimit     : string[20];
  ParmInputFile : ParmFile;

begin
  TextMode(BW80);
  ParseFileName(ParmFileName);
  ParmFileName:=concat(ParmFileName,'.PAR');
  assign(ParmInputFile,ParmFileName);
  {$I-}reset(ParmInputFile){$I+};
  Error:=(IOResult<>0);

  if not Error then
    begin
      readln(ParmInputFile,Xlength);
      readln(ParmInputFile,Ylength);
      readln(ParmInputFile,Xcorn);
      readln(ParmInputFile,Ycorn);
      readln(ParmInputFile,Xside);
      readln(ParmInputFile,Yside);
      readln(ParmInputFile,RealLimit);

      ParseFileName(ParmFileName);
      ParmFileName:=concat(ParmFileName,'.DAT/PAR');

      writeln('The previous screen parameters are as follows :');
      writeln;
      writeln('Filename  = ',ParmFileName:16);
      writeln('X pixels  = ',Xlength);
      writeln('Y pixels  = ',Ylength);
      writeln('X origin  = ',Xcorn);
      writeln('Y origin  = ',Ycorn);
      writeln('X side    = ',Xside);
      writeln('Y side    = ',Yside);
      writeln('Iteration = ',RealLimit);

      write(^J,'Print parameters to the printer (Y/N) ? ');
      GetResponse('Y','y','N','n',Answer);
      if (Answer='Y') or (Answer='y') then
        begin
          writeln(Lst,^J^J^J);
          writeln(Lst,'This printout''s parameters are as follows : ');
          writeln(Lst);
          writeln(Lst,'Filename  = ',ParmFileName:16);
          writeln(Lst,'X pixels  = ',Xlength);
          writeln(Lst,'Y pixels  = ',Ylength);
          writeln(Lst,'X origin  = ',Xcorn);
          writeln(Lst,'Y origin  = ',Ycorn);
          writeln(Lst,'X side    = ',Xside);
          writeln(Lst,'Y side    = ',Yside);
          writeln(Lst,'Iteration = ',RealLimit);
          write(Lst,^L);
        end;
    end
  else
    write('Error reading data parameter file ',ParmFileName,^G);
end;

 {**********************************************************************}

procedure SwapPalettes;

var
  i,j,k : integer;

begin
  for i:=0 to 3 do
    begin
      palette(i);
      for j:=1 to 32000 do
        for k:=1 to 2 do;
    end;
end;

 {**********************************************************************}

procedure MakeDataArray;


begin
  for Xpos:=0 to 199 do
    begin
      new(PicData[Xpos]);
      for Ypos:= 0 to 199 do
        PicData[Xpos]^[Ypos]:=0;
    end;

end; {procedure MakeDataArray}

 {**********************************************************************}

procedure ClearDataArray;

begin
  for Xpos:=0 to 199 do
    begin
      for Ypos:= 0 to 199 do
        PicData[Xpos]^[Ypos]:=0;
    end;

end; {procedure ClearDataArray}

{.PA} {**********************************************************************}

procedure PlotData;


var
  LoValue,
  PixelData,
  Xsize,
  Ysize,
  Value          : integer;
  Done,
  FirstTime,
  Error,
  Printer        : boolean;
  InputFile      : PicFile;
  ParmInputFile  : ParmFile;
  FileName       : FileNameString;
  Table          : array[0..4096] of integer;


 {**********************************************************************}

procedure SetPixel(Xpos,Ypos,PixelData:integer);

begin
  PixelData:=Table[PixelData];
  Plot(Xpos,Ypos,PixelData);

end; {procedure SetPixel}

 {**********************************************************************}

procedure SetTable;

const
  Nchanges =    4;{8;}
  Nmax     = 4096;

var
  i,j,
  Color,
  HiValue,
  Xpos,
  Ypos     : integer;
  Middle,
  PointSum,
  PerColor,
  HistSum  : real;
  History  : array[1..Nmax] of integer;

begin

  {Initialize the arrays}

  for i:=1 to Nmax do
    begin
      History[i]:=0;
      Table[i]:=0;
    end;

  {Make a histogram of the data}

  for Xpos:=0 to Xsize do
    for Ypos:=0 to Ysize do
      begin
        i:=PicData[Xpos]^[Ypos];
        History[i]:=History[i]+1;
      end;

  {Find the highest valid data point value}

  i:=Nmax;
  HiValue:=0;
  repeat
    if History[i]>0 then HiValue:=i;
    i:=i-1;
  until (i=1) or (HiValue>0);

  {Count the number of points between Lo and Hi}

  Middle:=0;
  for i:=LoValue+1 to HiValue-1 do
    Middle:=Middle+History[i];

  {Calculate the average number of points per change}
          {and assign Table values accordingly}

  PerColor:=trunc(Middle/Nchanges);

  j:=LoValue;
  HistSum:=0;
  PointSum:=0;

  for i:=1 to Nchanges do
    begin
      Color:=1+(i mod DisplayColors);    {set Color within range of display}
      PointSum:=PointSum+PerColor;       {set next loop exit point}
      repeat
        HistSum:=HistSum+History[j];     {sum histogram data points}
        Table[j]:=Color;                 {assign color to look up table}
        j:=j+1;                          {increment table pointer value}
      until (HistSum>=PointSum);
    end;

  {Assign colors to table values not covered above}

  for i:=1 to LoValue do
    Table[i]:=1+(i mod DisplayColors);

  i:=HiValue;
  repeat
    Table[i]:=0;
    i:=i+1;
  until i>Nmax;

end; {procedure SetTable}

{.PA}         {********************* BEGIN PLOTDATA *************************}

begin
  ClrScr;
  if length(SaveFileName)<1 then
    begin
      write('Enter picture data source file name . . . : ');
      readln(FileName);
      FirstTime:=true;
    end
  else
    FileName:=SaveFileName;

  ParseFileName(FileName);
  FileName:=concat(FileName,'.DAT');
  assign(InputFile,FileName);
  {$I-}reset(InputFile){$I+};
  Error:=(IOResult<>0);

  if Error then
    writeln('File does not exist!',^G)
  else
    repeat
      write('Enter palette number . . . . . .(0,1,2,3) : ');
      readln(PaletteNumber);
      write('Enter background number . . . . . (0..15) : ');
      readln(BackGround);
      write('Enter plot averaging lower limit (1..100) : ');
      readln(LoValue);

      GoToXY(1,6);
      if FirstTime then
        begin
          writeln('Reading disk file data....');
          ClearDataArray;
          FirstTime:=false;

          read(InputFile,Xsize,Ysize);
          for Xpos:=0 to Xsize do
            for Ypos:=Ysize downto 0 do
              read(InputFile,PicData[Xpos]^[Ypos]);
        end;

      GoToXY(1,6);
      writeln('Calculating plot data.....');

      SetTable;

      GraphColorMode;
      Palette(PaletteNumber);
      GraphBackground(BackGround);

      for Xpos:=0 to Xsize do
        for Ypos:=Ysize downto 0 do
          begin
            PixelData:=PicData[Xpos]^[Ypos];
            SetPixel(Xpos,Ypos,PixelData);
          end;

      {SwapPalettes;} Palette(PaletteNumber); write(^G);
      repeat until KeyPressed;
      PrintParmFile(FileName);
      GoToXY(1,24);
      writeln('Do you want to display this file again (Y/N) ? ');
      GetResponse('Y','y','N','n',Answer);
      if (Answer='Y') or (Answer='y') then
        begin
          Done:=false;
          ClrScr;
        end
      else
        Done:=true;
    until Done;
end;

{.PA} {**********************************************************************}

procedure SaveParameters;

var
  Xcorn,
  Ycorn,
  Xside,
  Yside,
  Xlength,
  Ylength,
  RealLimit   : string[20];

begin
  ParmSaveFileName:=SaveFileName;
  ParseFileName(ParmSaveFileName);
  ParmSaveFileName:=concat(ParmSaveFileName,'.PAR');

  str(Xmax:5,Xlength);
  Xlength:=concat(Xlength,'       8087');  { For 8087 version only }
  str(Ymax:5,Ylength);
  str(Xcorner:16:10,Xcorn);
  str(Ycorner:16:10,Ycorn);
  str(Xsize:16:10,Xside);
  str(Ysize:16:10,Yside);
  str(Limit:5,RealLimit);

  assign(ParmSaveFile,ParmSaveFileName);
  {$I-}reset(ParmSaveFile){$I+};
  Error:=(IOResult=0);

  if Error then
    begin
      write(^M^J,'Parameter file ',ParmSaveFileName,
            ' already exists, overwrite it ? (Y/N) : ');
      GetResponse('Y','y','N','n',Answer);
      if (Answer='Y') or (answer='y') then
        begin
          erase(ParmSaveFile);
          Error:=false;
        end;
    end;

  if not Error then
    begin
      rewrite(ParmSaveFile);
      writeln(ParmSaveFile,Xlength);
      writeln(ParmSaveFile,Ylength);
      writeln(ParmSaveFile,Xcorn);
      writeln(ParmSaveFile,Ycorn);
      writeln(ParmSaveFile,Xside);
      writeln(ParmSaveFile,Yside);
      writeln(ParmSaveFile,RealLimit);
      flush(ParmSaveFile);
      close(ParmSaveFile);
    end;
end;

{.PA} {**********************************************************************}

procedure GetParameters;

var
  i           : integer;
  EndOfName,
  Error2      : boolean;

begin
  writeln('Picture definition entries');
  writeln;
  write('Enter number of X pixels (0..319). . : ');
  readln(Xmax);
  if Xmax>319 then
    Xmax:=319;
  write('Enter number of Y pixels (0..199). . : ');
  readln(Ymax);
  if Ymax>199 then
    Ymax:=199;
  write('Enter X or Real starting point . . . : ');
  readln(Xcorner);
  write('Enter Y or Imaginary starting point  : ');
  readln(Ycorner);
  write('Enter X side length  . . . . . . . . : ');
  readln(Xsize);
  write('Enter Y side length  . . . . . . . . : ');
  readln(Ysize);
  write('Enter iteration limit  . . . . . . . : ');
  readln(Limit);
  write('Save data in what file . . . . . . . : ');
  readln(SaveFileName);

  ParseFileName(SaveFileName);
  SaveFileName:=concat(SaveFileName,'.DAT');

  assign(SaveFile,SaveFileName);
  {$I-}reset(SaveFile){$I+};
  Error:=(IOResult=0);

  if Error then
    begin
      write(^M^J,'Data file ',SaveFileName,
            ' already exists, overwrite it (Y/N) ? ');
      GetResponse('Y','y','N','n',Answer);
      if (Answer='Y') or (Answer='y') then
        begin
          erase(SaveFile);
          Error:=false;
        end;
    end;

end;

{.PA} {**********************************************************************}

procedure CalculatePixelData;

begin
  ClrScr;
  GetParameters;
  SaveParameters;
  if not Error then
    begin
      ClrScr;
      writeln('Now calculating the Mandelbrot set');
      writeln;
      writeln('Current picture pixel size ',Xmax:3,'X by ',Ymax:3,'Y');
      GoToXY(1,4);
      write(  'Currently working on pixel    X       Y');

      Xgap:=(Xsize/Xmax);
      Ygap:=(Ysize/Ymax);

      rewrite(SaveFile);
      write(SaveFile,Xmax,Ymax);

      for Xincrement:=0 to Xmax do
        begin
          GoToXY(28,4);
          write(Xincrement:3);
          for Yincrement:=0 to Ymax do
            begin
              CalcPixel( ((Xincrement*Xgap)+Xcorner),
                         ((Yincrement*Ygap)+Ycorner),
                           PixelValue);
              write(SaveFile,PixelValue);
              GoToXY(36,4);
              write(Yincrement:3);
            end;
          end;
      flush(SaveFile);
      close(SaveFile);
    end;

  writeln;
  write('Do you want to plot the data now (Y/N) ? ');
  GetResponse('Y','y','N','n',Answer);
  if (Answer='Y') or (Answer='y') then
    PlotData;
end;

{.PA} {**********************************************************************}

procedure DiskDirectory(PassedMask:DirSpec);
type
  String20             = string[ 20 ];
  RegRec = record
            AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer;
           end;
var
  Regs                 : RegRec;
  DTA                  : array [ 1..43 ] of Byte;
  Mask                 : DirSpec;  (*Char12arr;*)
  NamR                 : String20;
  Error, I             : Integer;
begin { main body of program DirList }
  FillChar(DTA,SizeOf(DTA),0);        { Initialize the DTA buffer }
  FillChar(Mask,SizeOf(Mask),0);      { Initialize the mask }
  FillChar(NamR,SizeOf(NamR),0);      { Initialize the file name }
  WriteLn; {'Put stand alone statements here.'}
  WriteLn;
  Regs.AX := $1A00;         { Function used to set the DTA }
  Regs.DS := Seg(DTA);      { store the parameter segment in DS }
  Regs.DX := Ofs(DTA);      {   "    "      "     offset in DX }
  MSDos(Regs);              { Set DTA location }
  Error := 0;
  Mask :=PassedMask;         {'????????.???';}
  Regs.AX := $4E00;          { Get first directory entry }
  Regs.DS := Seg(Mask);      { Point to the file Mask }
  Regs.DX := Ofs(Mask);
  Regs.CX := 22;             { Store the option }
  MSDos(Regs);               { Execute MSDos call }
  Error := Regs.AX and $FF;  { Get Error return }
  I := 1;                    { initialize 'I' to the first element }
  if (Error = 0) then
    repeat
      NamR[I] := Chr(Mem[Seg(DTA):Ofs(DTA)+29+I]);
      I := I + 1;
    until not (NamR[I-1] in [' '..'~']) or (I>20);
  NamR[0] := Chr(I-1);                { set string length because assigning }
  if (Error=0) then write(NamR:20);     { by element does not set length }
  while (Error = 0) do begin
    Error := 0;
    Regs.AX := $4F00;    { Function used to get the next directory entry }
    Regs.CX := 22;              { Set the file option }
    MSDos( Regs );              { Call MSDos }
    Error := Regs.AX and $FF;   { get the Error return }
    I := 1;
    repeat
      NamR[I] := Chr(Mem[Seg(DTA):Ofs(DTA)+29+I]);
      I := I + 1;
    until not (NamR[I-1] in [' '..'~'] ) or (I > 20);
    NamR[0] := Chr(I-1);
    if (Error = 0) then Write(NamR:20)
  end;
  if (Error = 0) then write(^G,'Error reading directory!');
end; { of procedure DirList  }

{.PA} {**********************************************************************}

procedure GetDirectory;

begin
  ClrScr;
  write('Directory of .DAT and .PAR disk files : ');
  GoToXY(1,3);
  DiskDirectory('????????.DAT');
  GoToXY(1,12);
  DiskDirectory('????????.PAR');
  GoToXY(1,24);
  write('Press SPACEBAR to continue...');
  GetResponse(' ',' ',' ',' ',Answer);
end;

 {*********************** MAIN STARTS HERE *****************************}

begin
  MakeDataArray;
  repeat
    ClrScr;

    FillChar(SaveFileName,30,0);
    FillChar(ParmSaveFileName,30,0);

    GetOption(Answer);
    case Answer of
      '1'  :  CalculatePixelData;
      '2'  :  PlotData;
      '3'  :  GetDirectory;
      '4'  :  begin
                TextMode(BW80);
                ClrScr;
                write('Returning to operating system...');
              end;
    end;
  until Answer='4';

end.
-- 
Tim Margeson (206)253-5240
tektronix!tekigm!timothym                   @@   'Who said that?'  
PO Box 3500  d/s C1-465
Vancouver, WA. 98665


Brought to you by Super Global Mega Corp .com