Beziérové krivky

Kategorija: KMP (Programy mladňakoch

Zrobil: Ľuboš Saloky
Program: Vision16.pas
Subor exe: Vision16.exe
Mušiš mac: Egavga.bgi

{ vision16.pas                                                      }
{ Bezierove krivky.                                                 }
{                                                                   }
{ Author: Ľuboš Saloky                                              }
{ Datum: 01.01.1996                           http://www.trsek.com  }
 
program Bezierove_krivky;
uses Graph,Crt;
type s=array[0..79,0..479]of byte;
const gd:integer=9;
      gm:integer=2;
      pocet=4;
      a:array[1..pocet,1..2]of integer=((300,100),(200,420),(20,220),(620,435));
      mazanie=10;      {rychlost mazania v Snieziku}
      dlzka=20;        {dlzka ciar v Snieziku}
      Cierne=40;       {Velkost ciernych ploch v Hmle a v Snieziku}
      Hustotaciar=2;   {Hustota ciar v SmejĂşcich sa farbĂĄch}
      pocethviezd=280; {pocet hviezd}
var x,y,z,barx,bary,col,count:integer;
    t:real;
    pom,pom2:array[1..200,1..2]of integer;
    smery:array[1..pocet,1..2]of integer;
    l:s;
    f:file of s;
    pokus:array[1..400,1..4]of integer;
    hviezda:array[0..pocethviezd,1..2] of integer;
 
procedure vypocet;
begin
  for z:=1 to 20 do begin
    pom[z,1]:=round((1-t)*(1-t)*(1-t)*a[1,1]+3*(1-t)*(1-t)*t*a[2,1]+3*(1-t)*t*t*a[3,1]+t*t*t*a[4,1]);
    pom[z,2]:=round((1-t)*(1-t)*(1-t)*a[1,2]+3*(1-t)*(1-t)*t*a[2,2]+3*(1-t)*t*t*a[3,2]+t*t*t*a[4,2]);
    t:=t+0.05;
  end;
end;
 
procedure Nakresli(pom1,pom2:word);
begin
  if l[x div 8,y]>=pom1 then begin
    PutPixel(x+pom2,y,4);
    l[x div 8,y]:=l[x div 8,y]-pom1;
  end;
end;
 
BEGIN
  initgraph(gd,gm,'');
  assign(f,'vision16.dat');
  reset(f);
  read(f,l);
  randomize;
  for y:=0 to 479 do begin
    for x:=0 to 639 do begin
      Nakresli(128,7);
      Nakresli(64,6);
      Nakresli(32,5);
      Nakresli(16,4);
      Nakresli(8,3);
      Nakresli(4,2);
      Nakresli(2,1);
      Nakresli(1,0);
    end;
  end;
  Delay(500);
  col:=1300;
  for x:=1 to pocet do begin
    smery[x,1]:=random(6)+5;
    smery[x,2]:=random(6)+5;
    if random(2)=1 then smery[x,1]:=-smery[x,1];
    if random(2)=1 then smery[x,2]:=-smery[x,2];
  end;
  vypocet;
  repeat
    t:=0;
    move(pom,pom2,sizeof(pom));
    vypocet;
    for x:=1 to pocet do begin
      a[x,1]:=a[x,1]+smery[x,1]+random(5)-2;
      a[x,2]:=a[x,2]+smery[x,2]+random(5)-2;
      smery[x,1]:=smery[x,1]+random(3)-1;
      smery[x,2]:=smery[x,2]+random(3)-1;
      if smery[x,1]>9 then smery[x,1]:=7;
      if smery[x,1]<-9 then smery[x,1]:=-7;
      if smery[x,2]>9 then smery[x,2]:=7;
      if smery[x,2]<-9 then smery[x,2]:=-7;
      if (a[x,1]<0) or (a[x,1]>639) then smery[x,1]:=-smery[x,1];
      if (a[x,2]<0) or (a[x,2]>479) then smery[x,2]:=-smery[x,2];
    end;
    SetColor(col div 100);
    for x:=1 to 19 do begin
      Line(pom[x,1],pom[x,2],pom[x+1,1],pom[x+1,2]);
    end;
    Inc(col);
  until col>3200;
  for z:=1 to 400 do begin
    x:=random(639);y:=random(479);
    pokus[z,1]:=x;
    pokus[z,2]:=y;
    pokus[z,3]:=x+random(dlzka)-dlzka div 2;
    pokus[z,4]:=y+random(dlzka)-dlzka div 2;
    Setcolor(random(15)+1);
    line(pokus[z,1],pokus[z,2],pokus[z,3],pokus[z,4]);
  end;
  count:=0;
  repeat
    SetColor(0);
    Line(pokus[1,1],pokus[1,2],pokus[1,3],pokus[1,4]);
    move(pokus[2,1],pokus[1,1],sizeof(pokus));
    x:=random(639);y:=random(479);
    pokus[400,1]:=x;
    pokus[400,2]:=y;
    pokus[400,3]:=x+random(dlzka)-dlzka div 2;
    pokus[400,4]:=y+random(dlzka)-dlzka div 2;
    SetColor(random(15)+1);
    line(pokus[400,1],pokus[400,2],pokus[400,3],pokus[400,4]);
    Inc(count);
  until count>30000;
  for x:=1 to pocethviezd do begin
    hviezda[x,1]:=random(580)+10;
    hviezda[x,2]:=random(420)+10;
  end;
  SetColor(0);
  for x:=0 to 320 do begin
    Line(x,x mod 240,640-x,x mod 240);
    Line(640-x,x mod 240,640-x,480-x mod 240);
    Line(640-x,480-x mod 240,x,480-x mod 240);
    Line(x,480-x mod 240,x,x mod 240);
  end;
  count:=0;
  repeat
    MoveTo(0,0);
    x:=0;
    while x<640 do begin
      for y:=1 to 2 do begin
        MoveTo(x,0);
        LineTo(639,(x*3)div 4);
        LineTo(639-x,479);
        LineTo(0,479-(x*3)div 4);
        LineTo(x,0);
        Inc(x,hustotaciar);
      end;
      MoveTo(320,(x*3) div 8);
      LineTo(320+x div 2,240);
      LineTo(320,479-(x*3) div 8);
      LineTo(320-x div 2,240);
      LineTo(320,(x*3) div 8);
    end;
    SetColor(GetColor+1);
    Inc(count);
  until count=10;
  count:=0;
  ClearDevice;
  repeat
    for z:=1 to 8 do
    begin
      for y:=0 to pocethviezd-1 do begin
        SetColor(y mod 15+1);
        if y=0 then SetColor(0);
        x:=(y+z) mod 8;
        MoveTo(hviezda[y,1]+15-2*x,15+hviezda[y,2]);
        Lineto(hviezda[y,1]+15,15-2*x+hviezda[y,2]);
        LineTo(hviezda[y,1]+15+2*x,15+hviezda[y,2]);
        LineTo(hviezda[y,1]+15,15+2*x+hviezda[y,2]);
        LineTo(hviezda[y,1]+15-2*x,15+hviezda[y,2]);
        SetColor(0);
        MoveTo(hviezda[y+1,1]+15-2*x,15+hviezda[y+1,2]);
        Lineto(hviezda[y+1,1]+15,15-2*x+hviezda[y+1,2]);
        LineTo(hviezda[y+1,1]+15+2*x,15+hviezda[y+1,2]);
        LineTo(hviezda[y+1,1]+15,15+2*x+hviezda[y+1,2]);
        LineTo(hviezda[y+1,1]+15-2*x,15+hviezda[y+1,2]);
      end;
    end;
    Inc(count);
  until count=10;
  CloseGraph;
  WriteLn('MukoSoft demo'#13#10'Lubos Saloky, 1996');
end.