Program Mandelbrot_v100;

{ Purpose: Draw a mandelbrot picture
  Started: 22-Mar-94                                                       }

Uses Crt, DOS, Exec, Intuition, Graphics, Init;

{$I extras.inc}

Const
  VerNum = '1.00';
  VerDate = '21-Mar-94';

Type
  tFont= Record
    Font_Name: pCString; {font_name}
    Font_No:   Integer;  {TOPAZ_SIXTY}
    Font_Ddd1: ShortInt; {FS_NORMAL}
    Font_Ddd2: ShortInt; {FPF_ROMFONT}
  End;

Var
  IFS : Text;
  QTF : Boolean;
  NUM : String[2];
  ERR, IT, OFS, CTR, BPL : Integer;
  RCH : Array [1..$10] of Char;
  OPT : Char;
  MyNewWindow: tNewWindow;
  MyNewScreen: tNewScreen;
  FontName: CString;
  Title:    CString;
  WTitle:   CString;
  MyFont:   tFont;
  MyWindow: pWindow;
  MyScreen: pScreen;
  L: Longint;
  X, Y, N : Integer;
  XR, YR, ZR, ZI, ZR0 : Real;
  VP : LongInt;
  TXT : String[80];
  XS, YS, XE, YE, PC : Integer;

Procedure Print(TXT : String; XP, YP : Integer);
Begin
  With MyWindow^ Do
  Begin
    Move_(RPort, XP, YP);
    Text_(RPort, TXT, Length(TXT));
  End;
End;

Procedure CloseEnvironment;
Begin
  CloseWindow(MyWindow);
  CloseScreen(MyScreen);
  CloseLibrary(Pointer(IntuitionBase));
  CloseLibrary(Pointer(GfxBase));
End;

Procedure OpenTheScreen;
Begin
  GfxBase := pGfxBase(OpenLibrary('graphics.library',0));
  IntuitionBase := pIntuitionBase(OpenLibrary('intuition.library',0));
  With MyFont Do
  Begin
    PasToC('Topaz.font', FontName);
    Font_Name := @FontName;
    Font_No   := TOPAZ_SIXTY;
    Font_DDD1 := FS_NORMAL;
    Font_DDD2 := FPF_ROMFONT;
  End;
  With MyNewScreen Do
  Begin
    LeftEdge     := 0;
    TopEdge      := 0;
    Width        := 320;
    Height       := 256;
    Depth        := BPL;
    DetailPen    := 0;
    BlockPen     := 0;
    ViewModes    := 0;
    Type_        := CUSTOMSCREEN;
    Font         := @MyFont;
    PasToC('Mandelbrot Generator v' + VerNum + ' by Zebedee', Title);
    DefaultTitle := @Title;
    Gadgets      := NIL;
    CustomBitMap := NIL;
  End;
  MyScreen := OpenScreen(@MyNewScreen);
  If MyScreen = NIL Then
  Begin
    CloseLibrary(Pointer(IntuitionBase));
    CloseLibrary(Pointer(GfxBase));
    WriteLn('Error: Couldn''t open the screen');
    Halt(1);
  End;
End;

Procedure OpenTheWindow;
Begin
  GfxBase := pGfxBase(OpenLibrary('graphics.library', 0));
  IntuitionBase := pIntuitionBase(OpenLibrary('intuition.library', 0));
  With MyFont Do
  Begin
    PasToC('Topaz.font',FontName);
    Font_Name := @FontName;
    Font_No   := TOPAZ_SIXTY;
    Font_Ddd1 := FS_NORMAL;
    Font_Ddd2 := FPF_ROMFONT;
  End;
  With MyNewWindow Do
  Begin
    LeftEdge    := 0;
    TopEdge     := 0;
    Width       := 320;
    Height      := 256;
    DetailPen   := 0;
    BlockPen    := 1;
    PasToC('Mandelbrot Generator v' + VerNum, WTitle);
    Title       := @WTitle;
    Flags       := WINDOWCLOSE or SMART_REFRESH or 
                   ACTIVATE or WINDOWDRAG or WINDOWDEPTH;
    IDCMPFlags  := CLOSEWINDOW_;
    Type_       := CUSTOMSCREEN;
    FirstGadget := NIL;
    CheckMark   := NIL;
    Screen      := MyScreen;
    BitMap      := NIL;
    MinWidth    := 100;
    MinHeight   := 25;
    MaxWidth    := 640;
    MaxHeight   := 200;
  End;
  MyWindow := OpenWindow(@MyNewWindow);
  If MyWindow = NIL Then
  Begin
    CloseScreen(MyScreen);
    CloseLibrary(Pointer(IntuitionBase));
    CloseLibrary(Pointer(GfxBase));
    WriteLn('Error: Couldn''t open the window');
    Halt(2);
  End;
End;

Procedure SetPalette;
Begin
{  SetRGB4(MyWindow, 0,0,0,0);
  SetRGB4(VP, 0,1,1,0);}
End;

Procedure Usage(TXT : String);
Begin
  WriteLn(TXT);
  Halt(10);
End;

Procedure Details;
Begin
  Style(0,1);
  Style(1,1);
  Style(3,1);
  Write('Mandelbrot Generator v', VerNum, ' by Zebedee (', VerDate, ') ');
  WriteLn(Chr($a9), '1994 CyberTek');
  Style(0,1);
  WriteLn;
  WriteLn('Iterations may be either 2, 4, 8, 16, 32, 64, 128 or 256.');
  Style(2,1);
  WriteLn('Greets fly out to...');
  Style(2,0);
  WriteLn('Sirius, Sprinter, Fireball, Dillinger, Capone, DJ Nosferatu, Devoe, Holsten,');
  WriteLn('LSD, and not many others!');
  Write('ITERATIONS/K: ');
  ReadLn(IT);
End;

Procedure GetIterations;
Begin
  If ParamCount <> 1 Then Usage('Usage: Mandelbrot <iterations>');
  If ParamStr(1) = '?' Then Details
  Else
    Val(Copy(ParamStr(1), 1, Length(ParamStr(1))), IT, ERR);
  If (IT <> 2) and (IT <> 4) and (IT <> 8) and (IT <> 16) and (IT <> 32) and (IT <> 64) and (IT <> 128) and (IT <> 256) Then
    Usage('Error: Invalid iterations value');
  Case IT Of
      2 : BPL := 1;
      4 : BPL := 2;
      8 : BPL := 3;
     16 : BPL := 4;
     32 : BPL := 5;
     64 : BPL := 6;
    128 : BPL := 7;
    256 : BPL := 8;
  End;
  WriteLn('Screen 320x256x', BPL, ' (', IT, ')');
End;

Procedure WaitClose(Var W : pWindow);
Var
  DMY : Integer;
Begin
  EnableClose(W);
  DMY := Wait(BitMask(W^.UserPort^.MP_SIGBIT));
  DisableClose(W)
End;

Procedure DrawPic;
Var
  L : Integer;
Begin
  Assign(IFS, 'S:Mandel.pic');
  ReWrite(IFS);
  WriteLn(IFS, 'Mandelbrot picture - XS, XW, YS, YW, C');
  WriteLn(IFS, 11);
  WriteLn(IFS, 253);
  WriteLn(IFS, 4);
  WriteLn(IFS, 315);
  For Y := 11 To 253 Do
    For X := 4 To 315 Do
    Begin
      XR := -2.0 + X / 81.92;
      YR := 1.6 - Y / 81.92;
      N := 0;
      ZR := 0;
      ZI := 0;
      Repeat
        ZR0 := ZR * ZR - ZI * ZI + XR;
        ZI := 2 * ZR * ZI + YR;
        ZR := ZR0;
        Inc(N);
      Until (ZR * ZR + ZI * ZI > 4) or (N = IT);
      SetAPen(MyWindow^.RPort, N);
      L := WritePixel(MyWindow^.RPort, X, Y);
      WriteLn(IFS, N);
    End;
    Close(IFS);
    WaitClose(MyWindow);
End;

Procedure ShowText;
Begin
  Print('Active Keys once completed...', 4, 100);
  Print('R -> Redraw', 20, 108);
  Print('Q -> Quit', 20, 116);
End;

Procedure GetKeys;
Begin
  QTF := False;
  Repeat
    Repeat
      OPT := UpCase(ReadKey);
    Until OPT In ['R', 'Q'];
    Case OPT Of
      'R' : DrawPic;
      'Q' : QTF := True;
    End;
  Until QTF;
End;

Procedure ReadPic;
Begin
  Assign(IFS, 'S:Mandel.pic');
  Reset(IFS);
  ReadLn(IFS, TXT);
  ReadLn(IFS, XS);
  ReadLn(IFS, XE);
  ReadLn(IFS, YS);
  ReadLn(IFS, YE);
  For Y := YS To YE Do
    For X := YS To YE Do
    Begin
      ReadLn(IFS, PC);
      SetAPen(MyWindow^.RPort, PC);
      L := WritePixel(MyWindow^.RPort, X, Y);
    End;
  Close(IFS);
  WaitClose(MyWindow);
End;

Begin
  GetIterations;
  OpenTheScreen;
  OpenTheWindow;
  ShowText;
  {DrawPic;}
  ReadPic;
  GetKeys;
  CloseEnvironment;
End.