Program na vyskreslovanie a porovnanie bezierovych a b-spline kriviek na zaklade uzivatelskeho vstupu

{ BEZIER-BSPLINE.PAS                                                }
{ Program na vyskreslovanie a porovnanie bezierovych a b-spline     }
{ kriviek na zaklade uzivatelskeho vstupu.                          }
{                                                                   }
{ Author: Unknown                                                   }
{ Datum: 23.02.2009                            http://www.trsek.com }
 
program bezier-bspline;
uses vga,graph;
 
type
  TBod=record
    x,y:integer;
  end;
  TButton=record
    x1,y1,x2,y2:integer;
    n:integer;
  end;
 
var
  press:integer;
  press_k:integer;
  bod:array[0..32] of TBod;
  button:array[0..32] of TButton;
  num_buttons:integer;
  pocet:integer;
  tabKombCisel:array[0..16,0..16] of integer;
 
procedure generate_tabKombCisel;
var
  i,j:integer;
begin
  for i:=0 to 16 do begin
    tabKombCisel[0,i]:=1;
    tabKombCisel[i,0]:=1;
    tabKombCisel[i,i]:=1;
  end;
 
  for i:=2 to 16 do begin
    for j:=1 to 15 do begin
      tabKombCisel[i,j]:=tabKombCisel[i-1,j-1]+tabKombCisel[i-1,j];
    end;
  end;
 
end;
 
function KombCislo(n,i:integer):real;
begin
  KombCislo:=tabKombCisel[n,i];
end;
 
function Bernstein(t:real;i,k:integer):real;
var
  b,r:real;
  a:integer;
begin
  b:=KombCislo(k,i);
  r:=1;
  if i<k then
    for a:=k downto i+1 do r:=r*t;
  b:=b*r;
 
  r:=1;
  if k>0 then
    for a:=1 to i do r:=r*(1-t);
  b:=b*r;
 
  Bernstein:=b;
end;
 
procedure Bezier;
var
  i:integer;
  b,t,xx,yy:real;
  x,y:integer;
begin
 
  t:=0;
  while(t<=1) do begin
    xx:=0;yy:=0;
    for i:=0 to pocet-1 do begin
      b:=Bernstein(t,i,pocet-1);
      xx:=xx+b*bod[i].x;
      yy:=yy+b*bod[i].y;
    end;
    x:=trunc(xx);
    y:=trunc(yy);
    PutPixel(x,y,14);
    t:=t+0.001;
  end;
 
end;
 
 
function Blend_function(t:real;i,k:integer):real;
var
  b,r1,r2:real;
  a:integer;
begin
  if(k<=1) then begin
   if(t>=i)and(t<i+1) then Blend_function:=1
   else Blend_function:=0;
  end
  else begin
    r1:=(i+k-1)-i;
    r2:=(i+k)-(i+1);
    b:=0;
    if(r1<>0)and(r2<>0) then b:=b+((t-i)/r1)*Blend_function(t,i,k-1);
    if(r1<>0)and(r2<>0) then b:=b+((i+k)-t)/r2*Blend_function(t,i+1,k-1);
    Blend_function:=b;
  end;
end;
 
procedure Uniform_BSpline;
var
  i:integer;
  b,t,xx,yy:real;
  x,y:integer;
begin
 
  t:=(press_k-50)-1;
  while(t<pocet) do begin
    xx:=0;yy:=0;
    for i:=0 to pocet-1 do begin
      b:=Blend_function(t,i,press_k-50);
      xx:=xx+b*bod[i].x;
      yy:=yy+b*bod[i].y;
    end;
    x:=trunc(xx);
    y:=trunc(yy);
    PutPixel(x,y,15);
    t:=t+0.001;
  end;
 
end;
 
procedure tlacidlo(x,y,w,h:integer;s:String;c,p:integer);
begin
  if(c=p) then begin
    SetFillStyle(1,7);
    bar(x,y,x+w,y+h);
    SetColor(10);
  end
  else begin
    SetFillStyle(1,8);
    bar(x,y,x+w,y+h);
    SetColor(7);
    rectangle(x,y,x+w,y+h);
    SetColor(15);
  end;
 
  SetTextStyle(DefaultFont, HorizDir, 1);
  SetTextJustify(CenterText, CenterText);
  OutTextXY(x+w div 2,y + h div 2+1, s);
 
  button[num_buttons].x1:=x;
  button[num_buttons].y1:=y;
  button[num_buttons].x2:=x+w;
  button[num_buttons].y2:=y+h;
  button[num_buttons].n:=c;
  inc(num_buttons);
end;
 
procedure draw_menu;
var
  i:integer;
begin
  SetFillStyle(1,0);
  bar(0,100,640,480);
 
  SetTextStyle(DefaultFont, HorizDir, 1);
  SetTextJustify(LeftText, CenterText);
  OutTextXY(10,21,'Pocet bodov');
 
  SetTextStyle(DefaultFont, HorizDir, 1);
  SetTextJustify(LeftText, CenterText);
  OutTextXY(10,61,'Rad B-spline');
 
  SetFillStyle(1,14);
  bar(10,80,20,90);
  SetTextJustify(LeftText, CenterText);
  SetColor(14);
  OutTextXY(25,86,'Bezierova krivka');
 
  SetFillStyle(1,15);
  bar(180,80,190,90);
  SetTextJustify(LeftText, CenterText);
  SetColor(15);
  OutTextXY(195,86,'B-spline krivka');
 
  num_buttons:=0;
  for i:=1 to 7 do begin
    tlacidlo(100+i*30,10,20,20,chr(i+50),i,press);
  end;
 
  for i:=1 to 4 do begin
    tlacidlo(100+i*30,50,20,20,chr(i+50),52+i,press_k);
  end;
 
  tlacidlo(460,10,80,20,'Cisti',-2,0);
  tlacidlo(550,10,80,20,'Koniec',-1,0);
end;
 
function which_button_pressed(x,y:integer):integer;
var
  i:integer;
begin
  which_button_pressed:=0;
  for i:=0 to num_buttons-1 do begin
    if(x>=button[i].x1)and(y>=button[i].y1)and(x<=button[i].x2)and(y<=button[i].y2) then begin
      which_button_pressed:=button[i].n;
      break;
    end;
  end;
end;
 
var
  Driver, Mode: Integer;
  i,max,c,b:integer;
begin
  Driver := Detect;
  InitGraph(Driver, Mode, '');
  if GraphResult < 0 then
    Halt(1);
 
  generate_tabKombCisel;
 
  SetFillStyle(1,8);
  bar(0,0,640,100);
 
  gShowMouse;
  c:=1;
  press:=1;
  press_k:=53;
  max:=3;
 
  while true do begin
    if(c=2) then begin
      if(pocet<max) then begin
        gHideMouse;
 
        SetColor(10);
        circle(gMouseX*2,gMouseY,3);
 
        SetTextStyle(DefaultFont, HorizDir, 1);
        SetTextJustify(CenterText, TopText);
        OutTextXY(gMouseX*2,gMouseY+5, Chr(pocet+49));
 
        bod[pocet].x:=gMouseX*2;
        bod[pocet].y:=gMouseY;
 
        inc(pocet);
 
        if(pocet=max) then begin
          SetColor(8);
          for i:=0 to pocet-2 do begin
            line(bod[i].x,bod[i].y,bod[i+1].x,bod[i+1].y);
          end;
          Bezier;
          Uniform_BSpline;
        end;
 
        gShowMouse;
      end;
      c:=3;
    end;
    if(c=1) then begin
      gHideMouse;
      draw_menu;
      c:=0;
      pocet:=0;
      gShowMouse;
    end;
 
 
    if(c=0)and(gMouseButtons>0) then begin
      b:=which_button_pressed(gMouseX*2,gMouseY);
      if(b=-1) then break;
      if(b=-2) then c:=1;
      if(b>0) then begin
        if(b<50) then begin
          press:=b;
          max:=b+2;
        end;
        if(b>50)and(b-52<=press) then begin
          press_k:=b;
        end;
        c:=1;
      end;
      if(b=0)and(gMouseY>100) then c:=2;
    end;
    if(c>0)and(gMouseButtons=0) then c:=0;
  end;
 
  gHideMouse;
 
  CloseGraph;
end.