ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/MAGAZINE/MISC/AUG86.ZIP/MANDEL.PAS

Pascal/Delphi Source File | 1986-05-06 | 5.4 KB | 139 lines

Program Mandelbrot;

type
   reg       = array[0..11] of byte;
const
   xmin      = -2.0;
   xrange    =  2.6;
   ymin      = -1.3;
   yrange    =  2.6;
   crt_index_reg   =$03D4; { Port # of Index register of 6845       }
   crt_data_reg    =$03D5; { Port # of Input register of 6845       }
   mode_select_reg =$03D8; { Port # of video mode select register   }
   color_select_reg=$03D9; { Port # of video color select register  }
var
   c,j,k,n      : integer;
   x,y,dx,dy    : real;
   crt_mode_set
         : byte absolute $0000:$0465; { Used by BIOS to maintain    }
   crt_palette
         : byte absolute $0000:$0466; { values of mode & color regs }
   screen       : array[1..16384] of byte absolute $B800:$0000;
label
   quit;

{-------- CLEARS SCREEN --------------------------------------------}

Procedure ClearScreen;
begin
   port[mode_select_reg] := 0; { Disables video to prevent snow     }
   FillChar(screen,16384,0);   { Fills screen with chr 0 attribute 0}
   port[mode_select_reg] := 9; { Enables video to see screen        }
end;

{-------- SET 6845 CRT CONTROLLER TO LO-RES MODE -------------------}

Procedure LoRes;
const
   regdata  :  reg = (113,80,90,10,127,6,100,112,2,1,32,0);
var
   i        :  byte;
begin
   crt_mode_set := 0;
   crt_palette  := 0;
   port[color_select_reg] := 0;
   for i := 0 to 11 do
   begin
      port[crt_index_reg] := i;
      port[crt_data_reg]  := regdata[i];
   end;
   ClearScreen;
   crt_mode_set := 9;
end;

{-------- SET 6845 CRT CONTROLLER TO 80x25 TEXT SCREEN -------------}

Procedure TextScreen;
const
    regdata  :  reg = (113,80,90,10,31,6,25,28,2,7,6,7);
var
   i         :  byte;
begin
   for i := 0 to 11 do
   begin
      port[crt_index_reg] := i;
      port[crt_data_reg]  := regdata[i];
   end;
   crt_mode_set := 41;
   ClrScr;
end;

{-------- PLOTS POINT AT (x,y) in COLOR c --------------------------}

Procedure Point(x,y,c:integer);
begin
   inline($B8/$00/$02/      { MOV AX,0200H   0200 -> AX      }
          $30/$FF/          { XOR BH,BH      0 -> BH         }
          $8A/$56/$08/      { MOV DL,[BP+8]  x -> DL         }
          $D0/$EA/          { SHR DL,1       x/2->DL,rem->CF }
          $8A/$76/$06/      { MOV DH,[BP+6]  y -> DH         }
          $CD/$10/          { INT 10H        locates cursor  }
          $B8/$00/$08/      { MOV AX,0800H   0800 -> AX      }
          $CD/$10/          { INT 10H        read attribute  }
          $8A/$5E/$04/      { MOV BL,[BP+4]  c -> BL         }
          $73/$05/          { JNC +5         x even => CF=0  }
          $25/$00/$F0/      { AND AH,F0H     discard old fg  }
          $EB/$0B/          { JMP +11        Jmp to col asmb }
          $D0/$E3/          { SHL BL,1       x even so       }
          $D0/$E3/          { SHL BL,1        c is bg        }
          $D0/$E3/          { SHL BL,1         shift bg      }
          $D0/$E3/          { SHL BL,1          left 4 bits  }
          $25/$00/$0F/      { AND AH,0FH     discard old bg  }
          $00/$E3/          { ADD BL,AH      assemble color  }
          $B8/$DE/$09/      { MOV AX,09DE    chr ▐ to AH     }
          $B9/$01/$00/      { MOV CX,01      one to write    }
          $CD/$10);         { INT 10H        write chr, attr }
end;

{-------- DETERMINE NUMBER OF ITERATIONS AT (x,y) ------------------}

Function Iterate(x,y:real):integer;
var
   n          : integer;
   i,r,zi,zr  : real;
begin
   zr := x; zi := y;                      { Initialize z            }
   n := 64;                               { Iteration counter       }
   repeat
      n := n-1;                           { Decrement counter       }
      r := zr*zr - zi*zi + x;             { Real part of next z     }
      i := 2*zr*zi + y;                   { Imaginary part of next z}
      zr := r; zi := i;                   { Update z                }
   until (zr*zr + zi*zi > 4) or (n = 0);
                                   { Modulus² > 4 or 64 iterations  }
   Iterate := n;                   { Return 64 - # of iterations    }
end;

{-------- MAIN PROGRAM BEGINS --------------------------------------}

begin
   LoRes;                             { Switch to LoRes mode         }
   dx := xrange/159; dy := yrange/99; { Scale world to screen        }
   y := ymin + yrange;                { Maximum y to top of screen   }
   for j := 0 to 99 do                { 100 rows on LoRes screen     }
   begin
    x := xmin;                      { Minimum x to left of screen    }
    for k := 0 to 159 do            { 160 columns on LoRes screen    }
     begin
      n := Iterate(x,y);            { Determine number of iterations }
      c := n div 8;                 { Determine color number 0..7    }
      if n mod 8 > 3 then c := c+8; { If remainder = 4..7 then bright}
      Point(k,j,c);                 { Plot point on screen           }
      if keypressed then goto quit; { Press any key to interrupt/quit}
      x := x + dx;                  { Update x coordinate of point   }
     end;                           { Loop until finished with row   }
     y := y - dy;                   { Update y coordinate of point   }
   end;                             { Loop until finished with screen}
quit:   repeat until keypressed;    { Hold picture until key pressed }
   TextScreen;                      { Restore normal text screen     }
end.