Category : Pascal Source Code
Archive   : MANDEL.ZIP
Filename : MANDEL4.PAS

 
Output of file : MANDEL4.PAS contained in archive : MANDEL.ZIP

PROGRAM Mandel4;

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

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

CONST
Scan_Width = 359; { 719 (max Hercules) DIV 2 }
Max_Scan_Lines = 349; { PC3270 maximum }
Aspect = 0.75; { Typical screen aspect ratio }
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,
{ Color arrangement for } 0, 0, 0, 0, 1, 1, 1, 1,
{ 2-color screens } 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,
{ Color arrangement for } 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3,
{ 4-color screens } 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,
{ Color arrangement for } 3, 11, 3, 11, 3, 11, 3, 11,
{ 16-color screens } 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, RESERVED: Graph_Mode := CGAC0
END {* CASE *};

InitGraph (Device, Graph_Mode, TP_Path);

CASE Device OF
CGA, MCGA, RESERVED,
ATT400: BEGIN
Color_Count := 54;
Use_Color := Colors_4;
Max_Colors := 3;
Max_X := GetMaxX
END {* CASE CGAC0, MCGAC0, ATT400C0 *};

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

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 points on the screen. For high-resolution-
width screens, two adjacent pixels are set. }

BEGIN
CASE Device OF
CGA, MCGA, RESERVED,
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 sector of a completed picture. }

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

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

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 ³
³ A ³ B ³ ÃÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄ´
2: ÃÄÄÄÄÄÅÄÄÄÄÄ´ 3: ³ D ³ E ³ F ³
³ C ³ D ³ ÃÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄ´
ÀÄÄÄÄÄÁÄÄÄÄÄÙ ³ G ³ H ³ I ³
ÀÄÄÄÄÄÁÄÄÄÄÄÁÄÄÄÄÄÙ
ÚÄÄÄÄÄÂÄÄÄÄÄÂÄÄÄÄÄÂÄÄÄÄÄÂÄÄÄÄÄ¿
ÚÄÄÄÄÄÂÄÄÄÄÄÂÄÄÄÄÄÂÄÄÄÄÄ¿ ³ A ³ B ³ C ³ D ³ E ³
³ A ³ B ³ C ³ D ³ ÃÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄ´
ÃÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄ´ ³ F ³ G ³ H ³ I ³ J ³
³ E ³ F ³ G ³ H ³ ÃÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄ´
4: ÃÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄ´ 5: ³ K ³ L ³ M ³ N ³ O ³
³ I ³ J ³ K ³ L ³ ÃÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄ´
ÃÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄ´ ³ P ³ Q ³ R ³ S ³ T ³
³ M ³ N ³ O ³ P ³ ÃÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄ´
ÀÄÄÄÄÄÁÄÄÄÄÄÁÄÄÄÄÄÁÄÄÄÄÄÙ ³ 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
{ Undo existing 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, 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 {* THEN *};

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 { Dump picture onto the screen }
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 { Get a subregion of the completed picture }
ELSE
Sub_Comp (High, Low, Delta) { Continue drawing the picture }
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. The section marked 1* is where code has been optimized by
putting the complex-number math instructions in this procedure rather
than calling the actual procedures. }

VAR
X, Y, Count: integer;
Z_Point, C_Point: Complex;
Temp: double;

BEGIN {* Generate *}
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
{ 1* Mult_Comp (Z_Point, Z_Point, Z_Point); }
{ 2* Add_Comp (Z_Point, C_Point, Z_Point); }

Temp := Sqr (Z_Point.R) - Sqr (Z_Point.I) + C_Point.R;
Z_Point.I := 2.0 * Z_Point.I * Z_Point.R + C_Point.I;
Z_Point.R := Temp;
Count := Succ (Count)
END {* WHILE *};

IF Count 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 {* main *}
Initialize;

REPEAT
Define_Screen;
Generate;
Wrap_Up
UNTIL Ch IN No
END.