DUzun's Web
Programare, proiecte personale, divertisment

uses crt, graph;

const zero:array[1..3]of longint=(0,0,0);

      V0:array[1..3]of real=(0,0,0);

type Vector=array[1..3]of real;

     Point=array[1..3] of longint;

     vec=record xy:point; v:vector; l:real;  nb:byte; end;

​

     TModel=object

      p:array[byte]of ^vec;

      r:array[byte]of ^point;

      ip:set of byte;

      np,i:byte;

      Procedure Generate(lung,u,nRam,steps:byte;k:real);

      Procedure Drow(poz:point;u:vector);

     end;

​

     TFractal=object

       Coef : real;

       Mdl: TModel;

       v: vector;

       i: byte;

       Procedure Drow(p1,p2:point;s:byte;k:real);

     end;

​

var Frac : TFractal;

    Model: TModel;

    i,j,k: Integer;

    TV   : Vector;

    gm,gd: integer;

    Page : boolean;

    del, cic: integer;{Delay}

    TP:Point;

​

function rad(g: real): real;begin rad:=g*pi/180;end;

​

procedure ChgPg;

begin

  if Page then begin

    SetActivePage(0);SetVisualPage(1,true);

    Page:=false;

  end else begin

    SetActivePage(1);SetVisualPage(0,true);

    Page:=true;

  end;

  ClearPage;

end;

​

 Procedure RotVec(var v:vector;u:vector);

  var r:real;

 begin

  r:=v[1];

  v[1]:=v[1]*u[1]-v[2]*u[2];

  v[2]:=   r*u[2]+v[2]*u[1];

 end;

​

Procedure TModel.Drow;

begin

 for i:=0 to np do with p[i]^ do begin

  r[i]^[1]:=poz[1]+round(xy[1]*u[1]-xy[2]*u[2]);

  r[i]^[2]:=poz[2]+round(xy[1]*u[2]+xy[2]*u[1]);

 end;

 line(poz[1],poz[2],r[0]^[1],r[0]^[2]);

 for i:=1 to np do with p[i]^ do

  line(r[i]^[1],r[i]^[2],r[nb]^[1],r[nb]^[2]);

end;

​

Procedure TModel.Generate(lung,u,nRam,steps:byte;k:real);

 var ung:real;

 procedure Gen(s:byte;b:byte);

  var ram:byte;

 begin

  if(s>0)then begin

   ung := rad(random(u div 2+1))-rad(u);

   inc(np);

   new(p[np]);

   with p[np]^ do begin

    l:=p[b]^.l*k;

    v:=v0; xy:=zero;

    v[1]:=-sin(ung);

    v[2]:= cos(ung);

    RotVec(v,p[b]^.v);

    xy[1]:=p[b]^.xy[1]+round(l*v[1]);

    xy[2]:=p[b]^.xy[2]+round(l*v[2]);

    nb:=b;

   end;

   ram:=3{random(nRam+1)};

   if ram>1 then

   repeat

    Gen(s-1,np);

    dec(ram);

   until ram=0 else ip:=ip+[np];

  end else ip:=ip+[np];

 end;

​

begin

 np:=0; ip:=[];

 new(p[0]);

 with p[0]^ do begin

  l:=lung;

  v:=v0;   xy:=zero;

  v[2]:=1; xy[2]:=lung;

 end;

  i:=nRam{random(nRam+1)};

   if i=0 then i:=1;

   repeat

    Gen(steps-1,0);

    dec(i);

   until i=0;

  for i:=0 to np do if r[i]=nil then new(r[i]);

end;

​

procedure TFractal.Drow;

 begin

{  if s>0 then with mdl do begin

    mdl:=model;

    pDif(p2,p1,tp);

    GetVec(tp,v);

    i:=1;

    while(p[i]<>nil)do begin pProdScal(p[i]^,k,p[i]^);inc(i);end;

    Mdl.drow(p2[1],p2[2],v);

    i:=1;

    while(ip[i]<>nil)do begin

     TFractal.drow(p[l[ip[i]^]^[1]]^,p[l[ip[i]^]^[2]]^, s-1,coef*k);

     inc(i);

    end;

  end;          }

 end;

​

begin

 Randomize;

​

 gd:=detect;

 InitGraph(gm,gd,'');

 del := 100;

 cic := del;

​

repeat

 delay(1);

 if cic = 0 then  {Ultimul ciclu - de desenare}

 With Model do begin

  cic := del;

  ChgPg;

  Generate(random(20)+40,90,5,5,0.75);

  tv:=v0; tp:=zero;

  tp[1]:=100+random(10);  tp[2]:=200;

  tv[2]:=-2;

  tv[1]:=-random;

  Drow(tp,tv);

 end;

 dec(cic);

 if keypressed then begin

   cic := 0;

   case readkey of

     #27: break;

     #72: inc(del, 10);

     #80: dec(del, 10);

   end;

 end;

until false;

​

 closegraph;

 Halt(0);

end.

​