timothym@tekigm.UUCP (Timothy D Margeson) (10/05/85)
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