Informatika gyűjtemény

Egy szinttel feljebb pr_haromszog.pas

2004050607080910

<<  27. óra  >>

<<  Sokszög háromszögelése  >>

NézetNyomtat

pr_haromszog.pas (Vissza)
Az alábbi letöltési lehetőségek közül választhatsz: (segítség)
Karakterkódolás:
Sortörés:
Típus: text/plain
Tartalmaz szöveget
Karakterkódolás: us-ascii
Méret: 3 KB
program haromsz;

uses crt,graph;

const q1=4; q2=400; //q1 : szorzo (meret) , q2:eltolaaas

type sox= record //soxog
t:array[0..1001] of integer; //csucdok
dob:integer; //darabszam
end;

var t1,t2:text; //be,kimenet
x,y:array[0..1001] of longint; db:longint; //pontok x,y
k,v:array[0..1001] of longint; adb:longint; //atlok kezdo, veg, db
i,j:longint; //cikludvaltozo
soo:sox; //eredeti soxog
gd,gm:integer; //grafikahoz

function fi(pp,qq,rr:integer):integer; // 1: p balra van qr-tol
var s:longint;
begin
s:=(x[rr]-x[qq])*(y[pp]-y[qq])-(x[pp]-x[qq])*(y[rr]-y[qq]);
if s<0 then fi:=-1 else begin if s>0 then fi:=1 else fi:=0; end;
end; //fi vege

function tav(po,aa,bb:integer):longint; //po-nak aa bb tol vett tavolsaga
begin
tav:=abs((y[bb]-y[aa])*x[po]+(x[aa]-x[bb])*y[po]+x[bb]*y[aa]-x[aa]*y[bb]);
end; //tav vege

function ben(po,aa,bb,cc:integer):boolean; //benne van e
begin
ben:=(((fi(po,aa,bb)>=0) and (fi(po,bb,cc)>=0)) and (fi(po,cc,aa)>=0)) or
(((fi(po,aa,bb)<=0) and (fi(po,bb,cc)<=0)) and (fi(po,cc,aa)<=0))
end; //ben vege

function bal(aa:sox):integer; //ki a balalso
var c,ii:integer;
begin
c:=1;
for ii:=2 to aa.dob do begin
if x[aa.t[ii]] < x[aa.t[c]] then c:=ii else begin
if (x[aa.t[ii]] = x[aa.t[c]]) and (y[aa.t[ii]] < y[aa.t[c]]) then c:=ii;
end;
bal:=c;
end;
end; //bal vege

procedure dar(aa:sox); //ez szedi szet rekurzivan, es huz atlok
var bb,cc:sox;
ba,m1,p1,mac,ii,jj:integer; // balalso, +1 index,-1 index, legkozeleb
begin if aa.dob > 3 then begin


ba:=bal(aa); {writeln(aa.t[ba]);}
{for ii:=1 to aa.dob do write(aa.t[ii],' '); writeln;}
if bal(aa) < aa.dob then p1:=ba+1 else p1:=1;
if bal(aa) > 1 then m1:=ba-1 else m1:=aa.dob;
mac:=m1;

for ii:=1 to aa.dob do begin
if ((ii<>m1) and (ii<>p1)) and ((ii<>ba)
and ben(aa.t[ii],aa.t[ba],aa.t[p1],aa.t[m1])) then begin
if tav(aa.t[ii],aa.t[p1],aa.t[m1]) > tav(aa.t[mac],aa.t[p1],aa.t[m1])
then mac:=ii;
end; end;

if mac=m1 then begin //ha nincs belso

inc(adb); k[adb]:=aa.t[p1]; v[adb]:=aa.t[m1];

bb.dob:=0;
ii:=p1;
while ii<>m1 do begin
inc(bb.dob); bb.t[bb.dob]:=aa.t[ii];
if ii<aa.dob then inc(ii) else ii:=1;
end;
inc(bb.dob); bb.t[bb.dob]:=aa.t[m1];

cc.dob:=0;
ii:=m1;
while ii<>p1 do begin
inc(cc.dob); cc.t[cc.dob]:=aa.t[ii];
if ii<aa.dob then inc(ii) else ii:=1;
end;
inc(cc.dob); cc.t[cc.dob]:=aa.t[p1];
{writeln('loo ',aa.t[p1],' ',aa.t[m1]);}
end else begin //ha van belso

inc(adb); k[adb]:=aa.t[ba]; v[adb]:=aa.t[mac];

bb.dob:=0;
ii:=ba;
while ii<>mac do begin
inc(bb.dob); bb.t[bb.dob]:=aa.t[ii];
if ii<aa.dob then inc(ii) else ii:=1;
end;
inc(bb.dob); bb.t[bb.dob]:=aa.t[mac];

cc.dob:=0;
ii:=mac;
while ii<>ba do begin
inc(cc.dob); cc.t[cc.dob]:=aa.t[ii];
if ii<aa.dob then inc(ii) else ii:=1;
end;
inc(cc.dob); cc.t[cc.dob]:=aa.t[ba];

{writeln('lo2 ',aa.t[ba],' ',aa.t[mac]);   }
end;


{if bb.dob>3 then begin for jj:=1 to bb.dob do write(bb.t[jj],' '); writeln; end;} dar(bb);
{if cc.dob>3 then begin for jj:=1 to bb.dob do write(cc.t[jj],' '); writeln; end;} dar(cc);
end; end; //dar vege


begin
assign(t1,'harom.be'); reset(t1); readln(t1,db);   //beolv
for i:=1 to db do readln(t1,x[i],y[i]); close(t1);

adb:=0;

for i:=1 to db do soo.t[i]:=i; soo.dob:=db;

dar(soo);

assign(t2,'harom.ki'); rewrite(t2);              //kiir
writeln(t2,adb);
for i:=1 to adb do writeln(t2,k[i],' ',v[i]);
close(t2);


detectgraph(gd,gm); //grafika kezd
initgraph(gd,gm,'');

setcolor(magenta);

for i:=1 to db-1 do begin line(x[i]*q1+400,y[i]*q1+400,x[i+1]*q1+400,
y[i+1]*q1+400); end;

line(x[db]*q1+q2,y[db]*q1+q2,x[1]*q1+q2,y[1]*q1+q2);

setcolor(yellow);

for i:=1 to adb do begin
line(x[k[i]]*q1+q2,y[k[i]]*q1+q2,x[v[i]]*q1+q2,y[v[i]]*q1+q2);
end;


delay(5000); //varjon a becsukassal
closegraph; //grafika veg


end.
(Vissza)