пятница, 11 февраля 2011 г.

Папоротник на PascalABC



Когда написал программу рисующую папоротник. Результат вроде ничего... Но код просто ужасен.  Но как написал, так написал, оставлю всё как есть. Как поётся в песне "позволю этому быть".




uses graphabc;
var j,x,y,m,g,d,l,n,o,p,u, abc, ord, winh,winw,length,length2,length3,length4,length5,repeats,repeatsrel,repeatsrel2,lengthrel,lengthrel2,color,greeninc,greeninc2,greeninc3,colorinc,count:integer;
xr,i,yr,k,krel,krel2,z,z1,z2,z3,w,w1,w2,z4,z5:real;
mx: array[0..2,0..2] of real;
function Grad(gradus : real) : real;
begin
     Grad := gradus*Pi/180;
end;
procedure mx1(angle:real);
begin
    mx[0,0]:=cos(Grad(angle));
    mx[0,1]:=sin(Grad(angle));
    mx[0,2]:=0;
    mx[1,0]:=-sin(Grad(angle));
    mx[1,1]:=cos(Grad(angle));
    mx[1,2]:=0;
    mx[2,0]:=0;
    mx[2,1]:=0;
    mx[2,2]:=1;
end;
function getx(x,y:real):integer;
begin
     getx:=round((mx[0,0]*x+mx[1,0]*y+mx[2,0])/(mx[0,2]*x+mx[1,2]*y+mx[2,2]));
end;
function gety(x,y:real):integer;
begin
     gety:=round((mx[0,1]*x+mx[1,1]*y+mx[2,1])/(mx[0,2]*x+mx[1,2]*y+mx[2,2]));
end;
function kr(x:real): integer;
begin
     kr:=round(x*x*0.001);
end;
procedure DrawPixel(x,y,ugol:real;xc,yc:integer);
begin
     mx1(ugol);
     color:=RGB(0,greeninc,0);
     putpixel(getx(x,kr(y))+xc,gety(x,kr(y))+yc,color);
end;
function GetPixelX(x,y,ugol:real;xc,yc:integer):integer;
begin
     mx1(ugol);
     GetPixelX:=getx(x,kr(y))+xc;
end;
function GetPixelY(x,y,ugol:real;xc,yc:integer):integer;
begin
     mx1(ugol);
     GetPixelY:=gety(x,kr(y))+yc;
end;
procedure dline(x,y,l,angle:integer);
begin
     i:=0;
     while i<l do
     begin
     i:=i+0.1;
     drawpixel(i,i,angle,x,y);
     end;
end;
function GetRightDotX(x,y,l,angle:integer;k:real):integer;
var xx:integer;
begin
     i:=0;
     while i<l*k do
     begin
     i:=i+1;
     xx:=GetPixelX(i,i,angle,x,y);
     end;
     GetRightDotX:=xx;
end;
function GetRightDotY(x,y,l,angle:integer;k:real):integer;
var yy:integer;
begin
     i:=0;
     while i<l*k do
     begin
     i:=i+1;
     yy:=GetPixelY(i,i,angle,x,y);
     end;
      GetRightDotY:=yy;
end;
procedure drawsection5(x,y,l,angle:integer;k:real;repeats:integer);
begin
     z5:=0.1;
     length5:=round(l/2);
     for j:=1 to repeats do
     begin
          dline(GetRightDotX(x,y,l,angle,z5),GetRightDotY(x,y,l,angle,z5),length5,angle+40);
          dline(GetRightDotX(x,y,l,angle,z5),GetRightDotY(x,y,l,angle,z5),length5,angle-40);
          z5:=z5+0.2;
          length5:=round(length5*0.89);
     end;
end;
procedure drawsection4(x,y,l,angle:integer;k:real;repeats:integer);
begin
     z4:=0.1;
     length4:=round(l/2);
     for n:=1 to repeats do
     begin
          dline(GetRightDotX(x,y,l,angle,z4),GetRightDotY(x,y,l,angle,z4),length4,angle+40);
          drawsection5(GetRightDotX(GetRightDotX(x,y,l,angle,z4),GetRightDotY(x,y,l,angle,z4),length4,angle+40,z4),GetRightDotY(GetRightDotX(x,y,l,angle,z4),GetRightDotY(x,y,l,angle,z4),length4,angle+40,z4),length4,angle+40,k,repeats-1);
          dline(GetRightDotX(x,y,l,angle,z4),GetRightDotY(x,y,l,angle,z4),length4,angle-40);
          drawsection5(GetRightDotX(GetRightDotX(x,y,l,angle,z4),GetRightDotY(x,y,l,angle,z4),length4,angle-40,z4),GetRightDotY(GetRightDotX(x,y,l,angle,z4),GetRightDotY(x,y,l,angle,z4),length4,angle-40,z4),length4,angle-40,k,repeats-1);
          greeninc:=greeninc+1;
          z4:=z4+0.2;
          length4:=round(length4*0.89);
     end;
end;
procedure drawsection3(x,y,l,angle:integer;k:real;repeats:integer);
begin
     z3:=0.1;
     length3:=round(l/2);
     greeninc3:=greeninc;
     for u:=1 to repeats do
     begin
          dline(GetRightDotX(x,y,l,angle,z3),GetRightDotY(x,y,l,angle,z3),length3,angle+40);
          drawsection4(GetRightDotX(GetRightDotX(x,y,l,angle,z3),GetRightDotY(x,y,l,angle,z3),length3,angle+40,z3),GetRightDotY(GetRightDotX(x,y,l,angle,z3),GetRightDotY(x,y,l,angle,z3),length3,angle+40,z3),length3,angle+40,k,repeats-1);
          greeninc:=greeninc+2;
          dline(GetRightDotX(x,y,l,angle,z3),GetRightDotY(x,y,l,angle,z3),length3,angle-40);
          drawsection4(GetRightDotX(GetRightDotX(x,y,l,angle,z3),GetRightDotY(x,y,l,angle,z3),length3,angle-40,z3),GetRightDotY(GetRightDotX(x,y,l,angle,z3),GetRightDotY(x,y,l,angle,z3),length3,angle-40,z3),length3,angle-40,k,repeats-1);
          z3:=z3+0.2;
          length3:=round(length3*0.89);
     end;
     greeninc:=greeninc3;
end;
procedure drawsection2(x,y,l,angle:integer;k:real;repeats:integer);
begin
     w:=0.1;
     length2:=round(l/2);
     greeninc2:=greeninc;
     for g:=1 to repeats do
     begin
          dline(GetRightDotX(x,y,l,angle,w),GetRightDotY(x,y,l,angle,w),length2,angle+40);
          drawsection3(GetRightDotX(GetRightDotX(x,y,l,angle,w),GetRightDotY(x,y,l,angle,w),length2,angle+40,w),GetRightDotY(GetRightDotX(x,y,l,angle,w),GetRightDotY(x,y,l,angle,w),length2,angle+40,w),length2,angle+40,k,repeats);
          dline(GetRightDotX(x,y,l,angle,w),GetRightDotY(x,y,l,angle,w),length2,angle-40);
          drawsection3(GetRightDotX(GetRightDotX(x,y,l,angle,w),GetRightDotY(x,y,l,angle,w),length2,angle-40,w),GetRightDotY(GetRightDotX(x,y,l,angle,w),GetRightDotY(x,y,l,angle,w),length2,angle-40,w),length2,angle-40,k,repeats);
          greeninc:=greeninc+3;
          w:=w+0.2;
          length2:=round(length2*0.89);
     end;
     greeninc:=greeninc2;
end;
procedure drawsection(x,y,l,angle:integer;k:real;repeats:integer);
begin
  z:=k;
  z1:=k;
     length:=round(l/2);
     for m:=1 to repeats do
     begin
          dline(GetRightDotX(x,y,l,angle,z),GetRightDotY(x,y,l,angle,z),length,angle+40);
          drawsection2(GetRightDotX(GetRightDotX(x,y,l,angle,z),GetRightDotY(x,y,l,angle,z),length,angle+40,z1),GetRightDotY(GetRightDotX(x,y,l,angle,z),GetRightDotY(x,y,l,angle,z),length,angle+40,z1),length,angle+40,k,repeats-1);
          dline(GetRightDotX(x,y,l,angle,z),GetRightDotY(x,y,l,angle,z),length,angle-40);
          drawsection2(GetRightDotX(GetRightDotX(x,y,l,angle,z),GetRightDotY(x,y,l,angle,z),length,angle-40,z1),GetRightDotY(GetRightDotX(x,y,l,angle,z),GetRightDotY(x,y,l,angle,z),length,angle-40,z1),length,angle-40,k,repeats-1);
          z:=z+0.3;
          greeninc:=greeninc+5;
          length:=round(length*0.89);
     end;
end;
procedure draw(x,y,l,angle:integer;k:real;repeats:integer);
begin
     dline(x,y,l+50,d);
     krel:=k;
     krel2:=k;
     repeatsrel:=repeats;
     drawsection(x,y,l,angle,k,repeats);
     lengthrel:=l;
end;
begin
greeninc:=100;
cls;
winw:=600;
winh:=600;
SetWindowHeight(winh);
SetWindowWidth(winw);
x:=50;
y:=50;
l:=300;
d:=50;
k:=0.1;
repeats:=5;
floodfill(1,1,clBlack);
draw(x,y,l,d,k,repeats);
end.

3 комментария:

  1. Ну папоротник так себе, слишком пиксельный. А программа годная.

    ОтветитьУдалить
  2. drawsection2(GetRightDotX(GetRightDotX(x,y,l,angle,z),GetRightDotY(x,y,l,angle,z),length,angle-40,z1),GetRightDotY(GetRightDotX(x,y,l,angle,z),GetRightDotY(x,y,l,angle,z),length,angle-40,z1),length,angle-40,k,repeats-1);

    Ага, тройные вложенные функции, индуская программа :)

    ОтветитьУдалить
  3. Прикольно получилось, помню тоже на информатике учились рисовать в PascalABC

    ОтветитьУдалить