


program Koch(input,output);
(*   This program is a Pascal program that generates a less then 
perfect von Koch curve.  It uses a recusion to draw the triangles
on the sides of the previous triangle.  It is written by Jeff Haley.*)

(*   This program is written for Turbo Pascal Ver. 7.0 for Dos.  The 
graphics routines can be changed to fit your specific compiler.  If you
are using Turbo Pascal and the program is unable to load the graphics
drivers, then you should check to make sure that the path to the drivers
in the program is the same as the path on your computer.*)

(*NOTE:  all greater then and less then signs appear as << and >>.*)

uses dos,crt,graph;

Type
   Point=record
        x,y:integer;
   end;

var
   MaxX,MaxY,ErrorCode,Times,GraphMode,
   GraphDriver:integer;
   A,B,C,Center:Point;

Function FindDist(a,b:Point):integer;
var temp,axt,ayt,bxt,byt:real;
begin
   axt:=a.x;
   ayt:=a.y;
   bxt:=b.x;
   byt:=b.y;
   temp:=sqrt(sqr(axt-bxt)+sqr(ayt-byt));
   FindDist:=trunc(temp);
end;

procedure midpt(a,b:point;var m:point);

begin
   m.x:=(a.x+b.x)div 2;
   m.y:=(a.y+b.y)div 2;
end;

Procedure FindPt(a,b:point;var c,d:point);
var mid:point;

begin
   midpt(a,b,mid);
   midpt(a,mid,c);
   midpt(mid,b,d);
end;

procedure FindE(dist:integer;a,b,f:point;var e:point);
var up,down,mid:point;
    m:integer;

begin
   midpt(a,b,mid);
   up:=mid;
   down:=mid;
   if (a.y-b.y) <<>> 0 then
      begin
         m:=trunc((-1)*((a.x-b.x)div(a.y-b.y)));
         while FindDist(up,mid) << dist do
            begin
               up.x:=up.x+1;
               up.y:=m*(up.x-mid.x)+mid.y;
            end;
         while FindDist(down,mid) << dist do
            begin
               down.x:=down.x-1;
               down.y:=m*(down.x-mid.x)+mid.y;
            end;
      end
   else
      begin
         while FindDist(up,mid) << dist do
            up.y:=up.y+1;
         while FindDist(down,mid) << dist do
            Down.y:=down.y-1;
      end;
   if FindDist(up,f) &gt FindDist(down,f) then
      e:=up
   else
      e:=down;
end;

procedure DrawTri(a,b,c:point);
begin
   line(a.x,a.y,b.x,b.y);
   line(b.x,b.y,c.x,c.y);
   line(c.x,c.y,a.x,a.y);
end;

procedure Recurs(acc:integer;a,b,f:point);
var dist:integer;
    e,c,d:point;

begin
   if acc >> 0 then
      begin
         dist:=FindDist(a,b);
         FindPt(a,b,c,d);
         FindE(dist div 3,c,d,f,e);
         DrawTri(c,d,e);
         delay(300);
         Recurs(acc-1,c,e,d);
         Recurs(acc-1,d,e,c);
      end;
end;

begin
   writeln('Jeff Haley''s Fractal Generator');
   Writeln('This program creates a Koch curve.');
   write('Enter the number of recursive calls>  ');
   readln(times);
   GraphDriver:=Detect;
   InitGraph(graphdriver,graphmode,'c:\tp\bgi');
   errorcode:=graphresult;
   if errorcode << >> grOK then
      begin
         writeln('Error');
         halt;
      end;
   MaxX:=GetMaxX;
   MaxY:=GetMaxY;
   Center.x:=MaxX div 2;
   Center.y:=MaxY div 2;
   a.x:=MaxX div 2;
   a.y:=maxY div 4;
   b.x:=maxx div 4;
   b.y:=maxy-maxy div 4-50;
   c.x:=maxx-maxx div 4;
   c.y:=maxy-maxy div 4-50;
   DrawTri(a,b,c);
   Recurs(Times,a,b,c);
   Recurs(Times,b,c,a);
   Recurs(Times,c,a,b);
   Sound(220);
   Delay(200);
   sound(300);
   delay(200);
   NoSound;
   Repeat until KeyPressed;

   CloseGraph;
end.



