Category : Printer + Display Graphics
Archive   : MANDEL1.ZIP
Filename : MANDEL4.PAS

Program Mandel4;

{ This program generates a section of the Mandelbrot set, can save
it on disk and use existing Mandelbrot prictures to zoom further into
the set. }

{$E+}
{$N+}

USES
Crt, Graph, Cmplx; { CMPLX.TPU is created from CMPLX.PAS }

CONST
Scan_Width = 359;
Max_Scan_Lines = 349;
Aspect = 0.75;
Real_length = 30;
Yes_N_No: SET OF char = ['Y', 'N', 'y', 'n'];
Yes: SET OF char = ['Y', 'y'];
No: SET OF char = ['N', 'n'];
TP_Path = 'T';

TYPE
Scan_Line = ARRAY [0..Scan_Width] OF byte;
Scan_Line_Ptr = ^Scan_Line;
Real_String = STRING[Real_Length];
Color_Array = ARRAY [0..55] OF integer;

CONST
Colors_2: Color_Array = (0, 0, 0, 0, 1, 1, 1, 1,
0, 0, 0, 0, 1, 1, 1, 1,
0, 0, 0, 0, 1, 1, 1, 1,
0, 0, 0, 0, 1, 1, 1, 1,
0, 0, 0, 0, 1, 1, 1, 1,
0, 0, 0, 0, 1, 1, 1, 1,
0, 0, 0, 0, 1, 1, 1, 1);

Colors_4: Color_Array = (1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2,
3, 3, 3, 3, 3, 3, 1, 1, 1, 1, 1, 1,
2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3,
1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2,
3, 3, 3, 3, 3, 3, 0, 0);

Colors_16: Color_Array = (1, 9, 1, 9, 1, 9, 1, 9,
2, 10, 2, 10, 2, 10, 2, 10,
3, 11, 3, 11, 3, 11, 3, 11,
4, 12, 4, 12, 4, 12, 4, 12,
5, 13, 5, 13, 5, 13, 5, 13,
6, 14, 6, 14, 6, 14, 6, 14,
7, 15, 7, 15, 7, 15, 7, 15);

VAR
Ch: Char;
Low, High, Delta: Complex;
Dots_Horizontal, Dots_Vertical, Start_Y, Max_Count, Color_Count,
Device, Graph_Mode, Max_Colors, Max_X: integer;
Use_Color: Color_Array;
Picture_Loaded: boolean;
File_Name: STRING[80];

Data_Line: Scan_Line;
Screen_File: FILE OF Scan_Line;
Screen: ARRAY [0..Max_Scan_Lines] OF Scan_Line_Ptr;
Screen_Data: RECORD
Dots_H, Dots_V, Count, Start: integer;
Low_Real, Low_Imag,
High_Real, High_Imag: Real_String;
Note: String[200];
END ABSOLUTE Data_Line;

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

Procedure Initialize;

{ This procedure checks for the graphics screen and selects a mode
based on a compromise between resolution and the number of colors. }

VAR
X: integer;

BEGIN
TextMode(LastMode);
TextColor(LightBlue);
TextBackground(Black);
DirectVideo := False;
File_Name:= '';
Picture_Loaded := False;
DetectGraph (Device, Graph_Mode);
X := GraphResult;

IF X<>grOK THEN
BEGIN
Writeln ('Sorry, I can''t cope with this: ', GraphErrorMsg (X));
Halt
END {* THEN *};

CASE Device of
EGA: Graph_Mode := EGAHi;
VGA: Graph_Mode := VGAMed;
MCGA: Graph_Mode := MCGAC0;
EGA64: Graph_Mode := EGA64Lo;
ATT400: Graph_Mode := ATT400C0;
PC3270: Graph_Mode := PC3270Hi;
HercMono: Graph_Mode := HercMonoHi;
CGA: Graph_Mode := CGAC0
END {* Case *};

InitGraph (Device, Graph_Mode, TP_Path);

CASE Device OF
CGA, MCGA,
ATT400: BEGIN
Color_Count := 54;
Use_Color := Colors_4;
Max_Colors := 3;
Max_X := GetMaxX
END {* CASE CGACO, MCGACO, ATT400CO *};

EGA, VGA,
EGA64: BEGIN
Color_Count := 56;
Use_Color := Colors_16;
Max_Colors := 15;
Max_X := GetMaxX DIV 2
END; {* CASE EGAHi, VGAHi, EGALo *}

ELSE BEGIN
Color_Count := 56;
Use_Color := Colors_2;
Max_Colors := 1;
Max_X := GetMaxX DIV 2
END {* CASE ELSE *}
END {* CASE *};

FOR X := 0 TO Max_Scan_Lines DO
New (Screen[X]);
RestoreCrtMode
END; {* Initialize *}

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

PROCEDURE Plot (X, Y: integer;
Color: word);

{ This procedure plots point on the screen. For high-resolution-
width screens, two adjacent pixels are set. }

BEGIN
CASE Device OF
CGA, MCGA,
ATT400: PutPixel (X, Y, Color);

ELSE BEGIN
PutPixel (X*2, Y, Color);
PutPixel (X*2+1, Y, Color)
END {* CASE ELSE *}
END {* CASE *}
END {* Plot *};

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

PROCEDURE Define_Screen;

{ This procedure defines the area of the Mandelbrot Set to be viewed.
It can either be typed in at the keyboard, loaded as a partially
completed screen, or as a smaller section of a completed picture. }

VAR
X, Y: integer;
Temp, Ratio: real;

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

PROCEDURE No_Blank (VAR RS: Real_String);

{ This procedure removes leading blanks from the string RS. }

BEGIN
WHILE RS[1] = ' ' DO
RS := Copy (RS, 2, Length (RS) -1)
END {* No_Blank *};

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

PROCEDURE Sub_Picture;

{ This procedure allows the user to select a sub-section of a completed
screen to be blown-up, effectively zooming in on a smaller area.

Pressing keys 2 thru 5 changes the grid on the screen. A sub-section
may be chosen by pressing a letter, starting with A in the upper left corner
and moving across:
A B C D
A B A B C E F G H
2: C D 3: D E F 4: I J K L
G H I M N O P

A B C D E
F G H I J
5: K L M N O
P Q R S T
U V W X Y

Once a section has been chosen, the program proceeds to calculate and
display the smaller section, as large as the screen may allow.}

CONST
Max_Letter: ARRAY [2..5] OF char = ('D', 'I', 'P', 'Y');

VAR
Ch: char;
New_Size, Size, X, Y, Z, Sector, Sector_X, Sector_Y: integer;

BEGIN
Size := 1;
File_Name := '';
Ch := '2';

REPEAT
IF Ch IN ['2'..'5'] THEN
BEGIN {* Change grid *}
New_Size := Ord (Ch) - Ord ('0');

IF Size <>New_Size THEN
BEGIN

FOR X:= 0 to Dots_Horizontal DO
FOR Z:= 1 TO Size-1 DO
BEGIN
Y:= Z * Dots_Vertical DIV Size;
Plot (X, Y, Screen[Y]^[X])
END {* FOR, FOR *};

FOR Y:= 0 to Dots_Vertical DO
FOR Z:= 1 TO Size-1 DO
BEGIN
X:= Z * Dots_Horizontal DIV Size;
Plot (X, Y, Screen[Y]^[X])
END {* FOR, FOR *};

Size := New_Size;

{Make New Grid}
FOR X:= 0 TO Dots_Horizontal DO
FOR Z := 1 to Size-1 DO
BEGIN
Y:= Z * Dots_Vertical DIV Size;
Plot (X, Y, Max_Colors-Screen[Y]^[X])
END; {* FOR, FOR *}

FOR Y:= 0 TO Dots_Vertical DO
FOR Z := 1 to Size-1 DO
BEGIN
X:= Z * Dots_Horizontal DIV Size;
Plot (X, Y, Max_Colors-Screen[Y]^[X])
END {* FOR, FOR *}
END {* THEN *}
END {* THEN *};

Ch := UpCase (ReadKey)
UNTIL (Size IN [2..5]) AND (Ch IN ['A' .. Max_Letter[Size]]);

{ Calculate new limits }
Sector := Ord (Ch) - Ord('A');
Sector_X := Sector MOD Size;
Sector_Y := Size - 1 - Sector DIV Size;
Sub_Comp (High, Low, Delta);
Div_C_By_R (Delta, Size, Delta);
Low.R := Low.R + Delta.R * Sector_X;
High.R := Low.R + Delta.R;
Low.I := Low.I + Delta.I * Sector_Y;
High.I := Low.I + Delta.I;

WITH Screen_Data DO
BEGIN
Start_Y := 0;
Dots_H := Dots_Horizontal;
Dots_V := Dots_Vertical;
Count := Max_Count;
Str (Low.R, Low_Real);
Str (Low.I, Low_Imag);
Str (High.R, High_Real);
Str (High.I, High_Imag);
No_Blank (Low_Imag);
No_Blank (Low_Real);
No_Blank (High_Imag);
No_Blank (High_Real)
End; {* WITH *}
RestoreCrtMode;
Write
('Maximum iteration count = ', Max_Count, '. Change it? (Y/N) ');

REPEAT
Ch := ReadKey
UNTIL Ch IN Yes_N_No;

Writeln (Ch);

IF Ch IN Yes THEN
BEGIN
REPEAT
Write ('Enter maximum iteration count: ');
{$I-} ReadLn (Max_Count) {$I+}
UNTIL IOResult = 0;

IF Max_Count < 10 THEN
Max_Count := 10;

Screen_Data.Count := Max_Count
END; {* THEN *}

Write ('Enter Note: ');
Readln (Screen_Data.Note);
SetGraphMode (Graph_Mode)
END ;{* Sub_Picture *}

{*************************************************************}
BEGIN {* Define Screen *}
Ch := 'N';

IF Picture_Loaded THEN
BEGIN
Write ('Use Picture in memory? (Y/N) ');

REPEAT
Ch := Readkey
UNTIL Ch IN Yes_N_No;

Writeln (Ch)
End {* THEN *};

IF Ch IN No THEN
BEGIN
Write ('Load a picture file? (Y/N) ');

REPEAT
Ch := Readkey
UNTIL Ch IN Yes_N_No;

Writeln (Ch);

If Ch IN Yes THEN
BEGIN { Load picture file }
REPEAT
Write ('Enter name of file: ');
Readln (File_Name);
Assign (Screen_File, File_Name);
{$I-} Reset (Screen_File) {$I+};
UNTIL IOResult=0;

Read (Screen_File, Data_Line);

FOR X := 0 TO Screen_Data.Start-1 DO
Read (Screen_File, Screen [X]^);

Close (Screen_File);
Picture_Loaded := True
END {* THEN *}

ELSE
BEGIN { Get info from keyboard }
REPEAT
Write ('Enter range for the real (horiz.) axis: ');
{$I-} Readln (Low.R, High.R) {$I+}
UNTIL (IOResult=0) AND (Low.R<>High.R);

IF Low.R > High.R THEN
BEGIN
Temp := Low.R;
Low.R := High.R;
High.R := Temp
END {* TEMP *};

REPEAT
Write ('Enter range for the imaginary (vert.) axis: ');
{$I-} Readln (Low.I, High.I) {$I+}
UNTIL (IOResult=0) AND (Low.I<>High.I);

IF Low.I > High.I THEN
BEGIN
Temp := Low.I;
Low.I := High.I;
High.I := Temp
END {* THEN *};

REPEAT
Write ('Enter maximum iteration count: ');
{$I-} Readln (Max_Count) {$I+}
UNTIL IOResult=0;

IF Max_Count < 10 THEN
Max_Count := 10;

Write ('Enter note: ');
Readln (Screen_Data.Note);
Start_Y := 0;
Sub_Comp (High, Low, Delta);
Ratio := Delta.I / Delta.R;
SetGraphMode (Graph_Mode);

IF Ratio >= Aspect THEN
BEGIN
Dots_Horizontal := Round ((Max_X + 1) * Aspect / Ratio) - 1;
Dots_Vertical := GetMaxY;
END {* THEN *}

ELSE
BEGIN
Dots_Vertical := Round ((GetMaxY + 1) * Ratio / Aspect) - 1;
Dots_Horizontal := Max_X
END {* ELSE *};
WITH Screen_Data DO
BEGIN
Dots_H := Dots_Horizontal;
Dots_V := Dots_Vertical;
Count := Max_Count;
Str (Low.I, Low_Imag);
Str (Low.R, Low_Real);
Str (High.I, High_Imag);
Str (High.R, High_Real);
No_Blank (Low_Imag);
No_Blank (Low_Real);
No_Blank (High_Imag);
No_Blank (High_Real);
END; {* WITH *}
Picture_Loaded := False;
File_Name := ''
END {* ELSE *}
END {* THEN *};

IF Picture_Loaded THEN
BEGIN
SetGraphMode (Graph_Mode);

WITH Screen_Data DO
BEGIN
Start_Y := Start;
Max_Count := Count;
Dots_Horizontal := Dots_H;
Dots_Vertical := Dots_V;
Val (Low_Real, Low.R, X);
Val (Low_Imag, Low.I, X);
Val (High_Real, High.R, X);
Val (High_Imag, High.I, X);
END {* With *};

FOR Y := 0 To Start_Y - 1 DO
FOR X := 0 To Dots_Horizontal DO
Plot (X, Y, Screen[Y]^[X]);

IF Start_Y > GetMaxY THEN
Sub_Picture
ELSE
Sub_Comp (High, Low, Delta)
END {* THEN *};

Delta.R := Delta.R / (Dots_Horizontal + 1);
Delta.I := Delta.I / (Dots_Vertical + 1);
END {* Define_Screen *};

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

PROCEDURE Generate;

{ This is where most of the program's time is spent, generating the
screen. }

VAR
X, Y, Count: Integer;
Z_Point, C_Point: Complex;
Temp: real;

BEGIN
Plot (Dots_Horizontal, Dots_Vertical, Max_Colors);
C_Point.I := High.I - Start_Y * Delta.I;
Y := Start_Y;

WHILE (Y<=Dots_Vertical) AND NOT KeyPressed DO
BEGIN
FillChar (Screen[Y]^, Scan_Width+1, 0);
C_Point.R := Low.R - Delta.R;

FOR X := 0 TO Dots_Horizontal DO
BEGIN
Plot (X, Y, Max_Colors);
C_Point.R := C_Point.R + Delta.R;
Z_Point := C_Point;
Count := 0;
WHILE (Count<=Max_Count) AND (Square_Size_Of_C (Z_Point) < 4.0) DO
BEGIN
Mult_Comp (Z_Point, Z_Point, Z_Point);
Mult_Comp (Z_Point, Z_Point, Z_Point);
Sub_Comp (Z_Point, C_Point, Z_Point);
Count := Succ (Count)
END; {* WHILE *}

IF Count < Max_Count THEN
Screen[Y]^[X] := Use_Color[Count MOD Color_Count];

Plot (X, Y, Screen[Y]^[X])
END {* FOR *};

C_Point.I := C_Point.I - Delta.I;
Y := Y + 1;
END; {* WHILE *}

Screen_Data.Start := Y
END; {* Generate *}

{*************************************************************}
PROCEDURE Wrap_Up;

{ This procedure deals with the shutting down of a picture. }

VAR
X: integer;

BEGIN
Picture_Loaded := True;

IF KeyPressed THEN
Sound (440)

ELSE
BEGIN
Sound (660);
Delay (20);
Sound (1000)
END {* ELSE *};

Delay (50);
NoSound;

Ch := ReadKey;

RestoreCrtMode;
Write ('Save picture? (Y/N) ');

REPEAT
Ch := Readkey
UNTIL Ch IN Yes_N_No;

Writeln (Ch);

If Ch IN Yes THEN
BEGIN
IF File_Name <> '' THEN
BEGIN
Write ('Save as ', File_Name, '? (Y/N) ');

REPEAT
Ch := ReadKey
UNTIL Ch IN Yes_N_No;

Writeln (Ch)
END {* THEN *}

ELSE
Ch := 'N';

IF Ch IN No THEN
BEGIN
Write ('Enter filename to save it in: ');
Readln (File_Name)
END {* THEN *};

Assign (Screen_File, File_Name);
Rewrite (Screen_File);
Write (Screen_File, Data_Line);

FOR X := 0 TO Screen_Data.Start-1 DO
Write (Screen_File, Screen[X]^);

Close (Screen_File)
END {* THEN *};

Write ('Do another? (Y/N) ');

REPEAT
Ch := ReadKey
UNTIL Ch IN Yes_N_No;

Writeln (Ch)
END; {* Wrap_Up *}

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

BEGIN

Initialize;

REPEAT
Define_Screen;
Generate;
Wrap_Up
UNTIL Ch IN No;

END.