Free Pascal Płatek Kocha

Dla specjalistów Programowanie
#1

Witam!!

Chciałbym wykonać tzw. Płatek Kocha w Free Pascal.

Znalazłem takie funkcje:

  1. Ten rysuje tylko prostą kreskę

    Uses Crt,Graph;

    procedure Koch(Stopien : Integer;A,B,C,D : Real);

    var x,y : Real;

    begin

     x:=C-A;

 y:=D-B;

 if Stopien>0 then

   begin

     Dec(Stopien);

     Koch(Stopien, A, B, A+x/3, B+y/3);

     Koch(Stopien, A+x/3, B+y/3, (A+C)/2+Sqrt(3)/6*y,(B+D)/2-Sqrt(3)/6*x);

     Koch(Stopien, (A+C)/2+Sqrt(3)/6*y,(B+D)/2-Sqrt(3)/6*x,A+x*2/3, B+y*2/3);

     Koch(Stopien, A+x*2/3, B+y*2/3, C, D)

   end else Line(Round(A),Round(B),Round(C),Round(D))

    end;

    Var Sterownik,Tryb,Stopien : Integer;

    Begin

    InitGraph(Sterownik,Tryb,‘c:\bp\bgi’);

    for Stopien:=0 to 5 do

     begin

   ClearDevice;

   Koch(Stopien,0,240,639,240);

   ReadKey

 end;

    CloseGraph

    End.

  2. Ten w ogóle nie startuje

    PROGRAM Koch;

    {Program rysowania platka Kocha}

    uses Crt, Graph;

    var

    sterownik,tryb,r:Integer;

    katAktualny,b:Real;

    z:Char;

    procedure KL;

    begin

    while KeyPressed do z:=ReadKey;

    repeat until keypressed

    end;

    procedure PW (katWStopniach:real);

    begin

    katAktualny:=katAktualny+katWStopniach

    end;

    procedure LW (katWStopniach:real);

    begin

    PW (-katWStopniach)

    end;

    procedure NP (trasa:real);

    var

    xKonca,yKonca:integer;

    begin

    xKonca:=round(trasacos(katAktualnypi/180));

    yKonca:=round(trasasin(katAktualnypi/180));

    LineRel (xKonca,yKonca)

    end;

    procedure ELEMENT (rzad:integer; bok:real);

    begin

    if rzad=0 then NP(bok)

    else

    begin

    ELEMENT (rzad-1,bok/3);

    LW(60);

    ELEMENT (rzad-1,bok/3);

    PW(120);

    ELEMENT (rzad-1,bok/3);

    LW(60);

    ELEMENT (rzad-1,bok/3)

    end

    end;

    procedure PLATEK_KOCHA (rzad:integer; bok:real);

    var

    i:integer;

    begin

    SetGraphMode(tryb);

    SetBkColor(White);

    SetColor(Blue);

    SetLineStyle(0,0,NormWidth);

    MoveTo(100,300);

    katAktualny:=270;

    PW(30);

    for i:=1 to 3 do

    begin

    ELEMENT (rzad,bok);

    PW(120)

    end;

    KL;

    CloseGraph

    end;

    begin

    clrscr;

    writeln (‘Platek Kocha’);

    writeln (’------------’);

    writeln;

    write ('rzad fraktala r = ');

    readln®;

    write ('bok fraktala b = ');

    readln(b);

    sterownik:=Detect;

    InitGraph (sterownik,tryb, ‘c:\bp\bgi’);

    PLATEK_KOCHA(r,b)

    end.

Proszę o pomoc w naprawieniu błędów

Z góry dziękuje

#2

W pierwszym programie, po narysowaniu linii przełącz się na konsole myszą i wciśnij enter.

Drugi tak bałaganiarsko napisany że nie chcę mi się analizować.

#3

Bez komentarza :slight_smile:

program Platek;


uses Crt, Graph;


type WspolrzedneTrojkata = array[0..2, 0..1] of Real;


var Trojkat: WspolrzedneTrojkata;

    i, ile, pocz, kon: Integer;

    Rzad, Kat, Ster, Tryb: Integer;


procedure WspTrojkata(r, alfa: Integer; var Wsp: WspolrzedneTrojkata);

var i: Integer;

begin

  for i:= 0 to 2 do begin

    Wsp[i, 0]:= (GetMaxX div 2) + r*cos((alfa+i*120)*Pi/180);

    Wsp[i, 1]:= (GetMaxY div 2) + r*sin((alfa+i*120)*Pi/180);

  end;

end;


procedure Koch(Stopien: Integer; A,B,C,D: Real);

var x,y: Real;

begin

  x:= C-A;

  y:= D-B;

  if Stopien > 0 then begin

    Dec(Stopien);

    Koch(Stopien, A, B, A+x/3, B+y/3);

    Koch(Stopien, A+x/3, B+y/3, (A+C)/2+Sqrt(3)/6*y, (B+D)/2-Sqrt(3)/6*x);

    Koch(Stopien, (A+C)/2+Sqrt(3)/6*y, (B+D)/2-Sqrt(3)/6*x,A+x*2/3, B+y*2/3);

    Koch(Stopien, A+x*2/3, B+y*2/3, C, D);

  end

  else Line(Round(A), Round(B), Round(C), Round(D));

end;


begin

  repeat

    Write('Podaj rzad fraktala (max 5): ');

    Readln(Rzad);

  until (Rzad>=0) and (Rzad<=5);

  Write('Podaj kat obrotu w stopniach: ');

  Readln(Kat);

  WspTrojkata(GetMaxY div 2, Kat, Trojkat);

  DetectGraph(Ster, tryb);

  InitGraph(Ster, Tryb, '');

  for i:= 0 to 2 do begin

    pocz:= i;

    kon:= i+1;

    if kon>2 then kon:= 0;

    Koch(Rzad, Trojkat[pocz, 0], Trojkat[pocz, 1], Trojkat[kon, 0], Trojkat[kon, 1]);

  end;

  repeat until Keypressed;

  CloseGraph;

end.

No, może jednak taki mały: działa w Turbo Pascalu, bo do Free Pascala jakoś nie mogę się przekonać