Category : Printer + Display Graphics
Archive   : MANDLE5.ZIP
Filename : MANDLE5A.PAS

Program MANDLE5A;
{To calculate and display the Mandlebrot set.}

{ Copyright Jeff Thompson 1988, 89
This software and any parts thereof are hereby given into
the public domain. They may not be sold or incorporated for resale
except for a reasonable ( <= $15.00 ) copying fee }


{ VERSION of 2/8/88
REVS of 3/15 Added EGA 16color 640 X 350 Stuff
REVS of 3/19 Added file storage to get around array limits
REVS of 3/27 Began to clean up some of MAIN logic
REVS of 3/28 Eliminate RAM matrix size limits by using a file
for calculated counts.
REVS of 6/19 Speed up plots by better threading of procedurres
REVS of 9/04 EGA 640 x 480, 16 colors }


uses
dos, crt, gdriver, printer, gkernel, gwindow, gshell;


TYPE

{
Registers = record
case integer of

0: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : Word);
1: (AL, AH, BL, BH, CL, CH, DL, DH: Byte);
END;
}


filb = file of byte;
fili = file of integer;
ST8 = STRING[10];
ST12 = STRING[14];

CONST {Here's where you define the search region

{ regxl =-0.85; regxr = -0.75; regyb = 0.2; regyt = 0.3; }
{ regxl =-0.846; regxr = -0.825; regyb = 0.212; regyt = 0.241;}{m3600x25}
{ regxl =-0.837; regxr = -0.830; regyb = 0.210; regyt = 0.217;}{m3601x25}
{ regxl =-0.8342; regxr = -0.83264; regyb = 0.210; regyt = 0.21206;}{m3602x25}
{ regxl =-0.867; regxr = -0.800; regyb = 0.190; regyt = 0.260;}{m3603x25}
{ regxl =-0.75; regxr = -0.65; regyb = 0.20; regyt = 0.30;}{m4600x12}
{ regxl =-0.738; regxr = -0.713; regyb = 0.275; regyt = 0.300;} {m4600x12}
{ regxl =-0.729; regxr = -0.721; regyb = 0.275; regyt = 0.283;} {m4605x12}
regxl = -0.5; regxr = 1.5; regyb = 0.0; regyt = 1.0; {m4000x12}

radius1 = 4.0; { x**@ + y**2 = 4 rather than using another SQR ROOT}

EGA = $A000;

VAR

fvar : fili;
x,xx,x2,y,yy,y2,dx,dy, radius : real;
sel,ch1,ch2,tempc, filout : char;
infile,outfile : st8;
fname : st12;
str1,str2 : string[80];
i,JJ,j,ix,ix0,iy,iy0,ctx,cty : integer;
iters, itermax, area, count : integer;
xdither, ydither, temp1, temp2 : integer;
b1 : byte;
cnt, areax, areay, itera, iterb : integer;
dline :array[0..655] of integer;
Regs : Registers;
tx,tx2,txx,ty,ty2,tyy, size : real;



PROCEDURE GETFNAME(VAR FILNAME : ST8);
BEGIN
writeln;write('Enter 8 Char filename...');readln(filname);
END;

PROCEDURE SETVMODE(VAR loa:integer; VAR pregs:registers);
{ Setmode sets the EGA to 'loa' mode.. must have global registers
declared per below:}
{ Registers = record
AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : Integer;
END; }
VAR
intt : integer;
BEGIN
with pregs do begin
AX := loa;
intt := $10;
intr(16,PREGS);
END; {With PREGS Clause}
END; {Proc SetVMode}

PROCEDURE PIXADR(x,y:integer; VAR PADDR : integer; VAR MASK : Byte);
{For EGA in 16C X 640 X 350, accepts X & Y value of pel, calculates
offset into EGA RAM and bit mask for fine X-position}
VAR
temp : byte;
t1 : integer;
BEGIN
paddr := y * 80; { 80 Bytes/line in 650 mode}
paddr := paddr + x DIV 8; { bitwise pixel numbering }
temp := (7 - x MOD 8); { bit for pixel addr in EGA RAM }
t1 := temp;
CASE t1 of
0 : mask := 1; {Pel position is defined by bit in X-Byte}
1 : mask := 2;
2 : mask := 4;
3 : mask := 8;
4 : mask := 16;
5 : mask := 32;
6 : mask := 64;
7 : mask := 128;
else mask := 0;
END; {case}
END; { Proc Pixadr }

PROCEDURE SETMODE2;
BEGIN
{Select EGA Write Mode 2}
port[$3ce] := 5; {Mode Register (5)}
port[$3cf] := 2; {Write Mode 2}
END; {Setmode2}

PROCEDURE SETNORM;
BEGIN
{Restore normal EGA Status}
port[$3ce] := 5; {Mode Reg.}
port[$3cf] := 0; {Write Mode 0}
port[$3ce] := 8; {Grafix Controller Reg. 8}
port[$3cf] := 8; {11111111b Default bit mask}
END; {Setnorm}

PROCEDURE PLOTEGA(VAR x,y:integer; color:integer);
{For EGA in 16C X 640 X 350 mode, plots a pixel then restores Mode 3,
text = 80X25, color. MUST have PROCS SetVMode and PixAdr in MAIN}
VAR
offset, b1 : integer;
bit : byte;
BEGIN {PlotEGA}

{***************************************************}
{New idea to add pseudo-altitude to plots}
y := y - (color DIV 2);
{****************************************************}

pixAdr(x, y, offset, bit); {Calculate pel address offset}

{*****************************************************}
{Don't forget .. y is cumulative!!! }
y := y + (color DIV 2);
{*****************************************************}


{Set Bit Mask Register for bit-level X-Position}
port[$3ce] := 8;
port[$3cf] := bit;

{Latch all 4 bit planes}
b1 := mem[EGA:offset];

{Write the pel value}
mem[EGA:offset] := color;

END; {PlotEGA}

PROCEDURE DITHER(x,y,xdither,ydither,temp1 : integer);
VAR i,j,tx,ty : integer;
BEGIN
for i := 1 to xdither do
begin
for j := 1 to ydither do
begin
tx := (x*xdither +(i-1));
ty := (y*ydither +(j-1));

plotega( tx, ty, temp1 );
end;
end;
END; {dither}


PROCEDURE CALCDITHER(areax,areay: integer; VAR xdither,ydither :integer);
BEGIN
if areax < 16 then areax := 16; if areax >650 then areax := 650;
xdither := 650 DIV areax; {prepare dither}
if xdither >16 then xdither := 16;
if areay < 16 then areay := 16; if areay >350 then areay := 350;
ydither := 350 DIV areay; {prepare dither}
if ydither >16 then ydither :=16;
END; {calcdither}

PROCEDURE MSTUFF; {Yes, it uses globals....}
BEGIN {mstuff}
filout := 'Y';
write('Enter "X"- Size of Calculation (32..650) for array...');
readln(areax);
write('Enter "Y"- Size of Calculation (32..340) for array...');
readln(areay);
calcdither(areax,areay, xdither,ydither );

write('Enter MAX iterations per point to quit...');
readln(itermax);
writeln;write(' File for data storage (1..8 chars, no ext..');
getfname(outfile);
fname := outfile + '.MAN';
assign(fvar,fname);
rewrite(fvar);
write(fvar,areax,areay,itermax); {set file header}
END; { mstuff}


PROCEDURE DSTUFF; {Yet again!!}
BEGIN {dstuff}
begin
if tempc in['d','D','H','h'] then {Dont have a file name yet}
begin
getfname(infile);
fname := infile +'.MAN';
end;
assign(fvar,fname);
reset(fvar);
read(fvar,areax,areay,itermax);
temp2 := itermax DIV 16;
calcdither(areax,areay, xdither,ydither);
WRITELN;WRITE('AREAX=',AREAX:4,' AREAY=',AREAY:4,'XD=',XDITHER:3,'YD=',YDITHER:3);
REPEAT UNTIL KEYPRESSED;
end;
END; {dstuff}

PROCEDURE CALCS;
VAR i,j : integer; RX,RY,x,iy : REAL;
BEGIN
radius := radius1;
dx := (regxr - regxl) / areax;
dy := (regyt - regyb) / areay;
writeln;writeln('scan X from ',regxl:5:3,' to ',regxr:5:3,', dx =',dx:7:6);
writeln;writeln('Scan Y from ',regyb:5:3,' to ',regyt:5:3,', dy =',dy:7:6);

for i := 1 to areaY do
BEGIN {i loop}
gotoXY(5,14);write(i:5);
for j := 1 to areaX do
BEGIN {j loop}
gotoxy(10,14);write(j:5,',');
iy := regyt - dy * (i-1);
x := regxl + dx * (j-1);
count := 1; iters :=1; size :=0;
tx2 := x*x - iy*iy + x;
ty2 := 2* x*iy + iy;
txx := tx2*tx2;
tyy := ty2*ty2;
size := txx + tyy; {Who needs to take SQRT every pass??!!}
{ size := tx2*tx2 + ty2*ty2; }

while ((count < itermax) and (size < radius)) do
BEGIN
{ tx := tx2*tx2 - ty2 * ty2 + x; }
tx := txx - tyy + x;
ty := 2.0*tx2*ty2 + iy;
txx := tx*tx;
tyy := ty*ty;
size := txx + tyy;
{ size := tx*tx + ty*ty; }
tx2:=tx; ty2:=ty; {Reload vars to cut side effects}

count := count + 1;
END; {while}

write('=',count:5);
write(fvar,count);
END; {j loop}
END; {i loop}
close(fvar);
END; {calcs}

PROCEDURE DRAW;
VAR i1,i2,i3 : integer;
BEGIN
{Now plot as color array with 16 colors}
{First, normalize by brute force...}
ASSIGN (FVAR,FNAME);
(* RESET(FVAR);
read(fvar,i1,i2,i3); {Advance to first count record}
temp1 := 0;
for i := 1 to areaY do begin
for j := 1 to areaX do begin
READ(FVAR,COUNT);
if count > temp1 then temp1 := count
end; {j loop}
end; { i loop}
close(fvar);
temp2 := temp1 DIV 16 + 1;*) {the +1 is a cheat}
TEMP2 := 16;
clrscr;Writeln('Max Count=',temp1:5,' Normalizer=',Temp2:5);
write('Press any key when ready');
repeat until keypressed;

with regs do
Begin
temp1 := ($10); { Set up hires .. }
SetVMode(temp1,regs); { Graphics mode...}
End; {with regs clause}
SetMode2; {Set Up EGA Mode 2}
reset(fvar); {Back to the beginning}
read(fvar,i1,i2,i3); {Advance to first count }
for i := 1 to areaY do begin
for j := 1 to areaX do begin
read(fvar,temp1);
(* TEMP1 := temp1 DIV temp2; *)
TEMP1 := Temp1 MOD Temp2;
IF (XDither < 2) THEN PlotEGA(j,i,temp1)
ELSE dither(j,i,xdither,ydither,temp1);
end; {j loop}
end; { i loop}
SetNorm; {Reset EGA Normal Mode}
close(fvar);

END; {DRAW}




PROCEDURE HISTO;
VAR i,j,k,hmax,hatchden : integer;
hist : PlotArray;
hatch : boolean;

PROCEDURE COMBFILE;
VAR i,j,m,n : integer;
BEGIN
for i := 1 to 255 do hist[i,2] := 0;
hmax := 0;
dstuff;
for i := 1 to areay do
begin
gotoxy(5,20); write(i:3);
for j := 1 to areax do
begin
read(fvar,m);
hist[m,2] := hist[m,2] + 1;
if (hist[m,2] > hmax) then
BEGIN
hmax := TRUNC(hist[m,2]);
gotoxy(10,20);write(hmax:9);
END;
end;
end;

writeln;write('Max Count =',hmax:7);read(i);
END;

BEGIN
CombFile;
initGraphic;
SetBackgroundColor(14); {yellow}
SetForegroundColor(1); {blue}
SetColorWhite;
SetBackground(0);
SetHeaderOn;
DefineWindow(1,0,0,XMaxGlb,YMaxGlb);
DefineHeader(1,'DENSITY OF MANDLE NUMBERS');
DefineWorld(1,0,0,512,1000*((HMAX/1000) + 1));
SelectWorld(1);
SelectWindow(1);
drawborder;
DrawAxis(6,6,0,0,0,0,0,0,true);
hatch := true;
hatchDen := 1;
DrawHistogram(hist,255,hatch,hatchDen);
repeat until keypressed;
leaveGraphic;
END;


BEGIN {Main}
ClrScr;

gotoxy (1,1);
tempc :='a'; filout := 'n';
repeat {main loop}
repeat
write(' (M)andle, (D)isplay, (H)istogram or (Q)uit....?');readln(tempc);
until tempc in ['M','m','D','d','Q','q','H','h'];
if tempc in['M','m'] then
BEGIN
mstuff;
calcs;
histo;
dstuff;
draw;
END; {If 'M' }

if tempc in ['D','d'] then
BEGIN
dstuff;
draw;
END; { If 'D'}

if tempc in ['H','h'] then histo;

READ(I);
REPEAT UNTIL KEYPRESSED;

with regs do
begin
temp1 := 3;
SetVMode(temp1,regs); { Return to.. }
End; {With Regs Clause} { Text Mode. }
UNTIL tempc in ['Q','q']; {End of main loop}
END. {Main}