Localize file www.TrSek.com/cover/neznamy/bezier-bspline.pas{ 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);
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;
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;