|
unit calcul;
Interface
const nb_max_segments=150;
nb_max_faces=40;
x_max = 40;
y_max = 30;
mode_graphique=3;
type matrice_44 = array[1..4,1..4] of real;
matrice_41 = array[1..4] of real;
matrice_21 = array[1..2] of real;
transfo_type = (rotationX,rotationY,rotationZ,homothetie,translation,perspect);
vecteur = array[1..3] of real;
point = object
obj : matrice_41;
oeil : matrice_41;
ecran : matrice_21;
invision : boolean;
where_pt : byte;
procedure Calc_repere_oeil;
procedure perspective;
procedure init_where_pt;
end;
segments = object
A, B : point;
elimine, in_face : boolean;
face, couleur : word;
procedure decoupe;
procedure calculs;
procedure trace(color : word);
end;
face = object
cote : array[1..4] of integer;
visible : boolean;
vectoriel : vecteur;
profondeur : real;
style, type_face : integer;
procedure produit_vectoriel;
procedure on_la_voit;
procedure calcul_profondeur;
procedure fill_it;
end;
tableau_faces = array[1..nb_max_faces] of face;
tableau_simple = array[1..nb_max_faces] of integer;
tableau_segments = array[1..nb_max_segments] of segments;
tableau_trigo = array[1..360] of real;
var theta, phy, nb_face, nb_segments, mode : integer;
r, tx, ty, tz, k, d, av, ar : real;
transformation : matrice_44;
tab_segments : tableau_segments;
tab_faces : tableau_faces;
regard : vecteur;
cosinus, sinus : tableau_trigo;
trigo_ready : boolean;
procedure center(y : integer; chaine : string);
procedure multiplier(Trans : matrice_44; point : matrice_41; var result : matrice_41);
procedure make_matrice(nom : transfo_type);
procedure segment(x1,y1,z1,x2,y2,z2 : real; color : word);
procedure quadrilatere(x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4 : real; color : word);
procedure parrallelepipede(x1,y1,z1,x2,y2,z2,x3,y3,z3 : real; color : word);
procedure surface(x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4 : real; style, color : word);
procedure triangle(x1,y1,z1,x2,y2,z2,x3,y3,z3 : real; style, color : word);
procedure move;
Implementation
uses graph, crt, svga, files;
procedure prepare_trigo_tools;
const t = Pi/180;
var w : integer;
begin
for w:=1 to 360 do
begin
cosinus[w]:=trunc(cos(w*t)*100000)/100000;
sinus[w]:=trunc(sin(w*t)*100000)/100000;
end;
trigo_ready:=true;
end;
procedure center(y : integer; chaine : string);
var ini : byte;
begin
ini:=(80-length(chaine)) div 2;
if ini >=0 then
begin
gotoxy(ini,y);
write(chaine);
end;
end;
function ChangeX(x : real) : integer;
begin
ChangeX:=trunc(10*(x+x_max));
end;
function ChangeY(y : real) : integer;
begin
ChangeY:=trunc(10*(y+y_max));
end;
procedure multiplier(Trans : matrice_44; point : matrice_41; var result : matrice_41);
var w,e : byte;
begin
for w:=1 to 4 do result[w]:=0;
for w:=1 to 4 do for e:=1 to 4 do result[w]:=result[w]+point[e]*trans[e,w];
end;
procedure make_matrice(nom : transfo_type);
begin
case nom of
rotationX : begin
transformation[1,1]:=1;
transformation[1,2]:=0;
transformation[1,3]:=0;
transformation[1,4]:=0;
transformation[2,1]:=0;
transformation[2,2]:=cosinus[theta];
transformation[2,3]:=sinus[theta];
transformation[2,4]:=0;
transformation[3,1]:=0;
transformation[3,2]:=-sinus[theta];
transformation[3,3]:=cosinus[theta];
transformation[3,4]:=0;
transformation[4,1]:=0;
transformation[4,2]:=0;
transformation[4,3]:=0;
transformation[4,4]:=1;
end;
rotationY : begin
transformation[1,1]:=cosinus[theta];
transformation[1,2]:=0;
transformation[1,3]:=sinus[theta];
transformation[1,4]:=0;
transformation[2,1]:=0;
transformation[2,2]:=1;
transformation[2,3]:=0;
transformation[2,4]:=0;
transformation[3,1]:=-sinus[theta];
transformation[3,2]:=0;
transformation[3,3]:=cosinus[theta];
transformation[3,4]:=0;
transformation[4,1]:=0;
transformation[4,2]:=0;
transformation[4,3]:=0;
transformation[4,4]:=1;
end;
rotationZ : begin
transformation[1,1]:=cosinus[theta];
transformation[1,2]:=-sinus[theta];
transformation[1,3]:=0;
transformation[1,4]:=0;
transformation[2,1]:=sinus[theta];
transformation[2,2]:=cosinus[theta];
transformation[2,3]:=0;
transformation[2,4]:=0;
transformation[3,1]:=0;
transformation[3,2]:=0;
transformation[3,3]:=1;
transformation[3,4]:=0;
transformation[4,1]:=0;
transformation[4,2]:=0;
transformation[4,3]:=0;
transformation[4,4]:=1;
end;
translation : begin
transformation[1,1]:=1;
transformation[1,2]:=0;
transformation[1,3]:=0;
transformation[1,4]:=0;
transformation[2,1]:=0;
transformation[2,2]:=1;
transformation[2,3]:=0;
transformation[2,4]:=0;
transformation[3,1]:=0;
transformation[3,2]:=0;
transformation[3,3]:=1;
transformation[3,4]:=0;
transformation[4,1]:=tx;
transformation[4,2]:=ty;
transformation[4,3]:=tz;
transformation[4,4]:=1;
end;
homothetie : begin
transformation[1,1]:=k;
transformation[1,2]:=0;
transformation[1,3]:=0;
transformation[1,4]:=0;
transformation[2,1]:=0;
transformation[2,2]:=k;
transformation[2,3]:=0;
transformation[2,4]:=0;
transformation[3,1]:=0;
transformation[3,2]:=0;
transformation[3,3]:=k;
transformation[3,4]:=0;
transformation[4,1]:=0;
transformation[4,2]:=0;
transformation[4,3]:=0;
transformation[4,4]:=1;
end;
perspect : begin
transformation[1,1]:=-sinus[theta];
transformation[1,2]:=-cosinus[theta]*sinus[phy];
transformation[1,3]:=-cosinus[theta]*cosinus[phy];
transformation[1,4]:=0;
transformation[2,1]:=cosinus[theta];
transformation[2,2]:=-sinus[theta]*sinus[phy];
transformation[2,3]:=-sinus[theta]*cosinus[phy];
transformation[2,4]:=0;
transformation[3,1]:=0;
transformation[3,2]:=cosinus[phy];
transformation[3,3]:=sinus[phy];
transformation[3,4]:=0;
transformation[4,1]:=0;
transformation[4,2]:=0;
transformation[4,3]:=r;
transformation[4,4]:=1;
end;
end;
end;
{************ FIN Procedures concernant les points **********}
procedure point.perspective;
var w : byte;
begin
if oeil[3]<>0 then for w:=1 to 2 do ecran[w]:=d*oeil[w]/oeil[3]
else
begin
ecran[1]:=oeil[1];
ecran[2]:=oeil[2];
end;
end;
procedure point.Calc_repere_oeil;
begin
multiplier(transformation,obj,oeil);
end;
procedure point.init_where_pt;
var x,y,z : real;
begin
where_pt:=0;
x:=oeil[1];
y:=oeil[2];
z:=oeil[3];
if x<-x_max*z/d then where_pt:=where_pt or 1;
if x>x_max*z/d then where_pt:=where_pt or 2;
if y<-y_max*z/d then where_pt:=where_pt or 4;
if y>y_max*z/d then where_pt:=where_pt or 8;
if zar then where_pt:=where_pt or 32;
if where_pt<>0 then invision:=false else invision:=true;
end;
{************ FIN Procedures concernant les points **********}
{************ Procedures concernant les segments **********}
procedure save(var a,b : point; t : real);
var x, y, z : real;
begin
x:=t*(b.oeil[1]-a.oeil[1])+a.oeil[1];
y:=t*(b.oeil[2]-a.oeil[2])+a.oeil[2];
z:=t*(b.oeil[3]-a.oeil[3])+a.oeil[3];
a.oeil[1]:=x;
a.oeil[2]:=y;
a.oeil[3]:=z;
end;
procedure intersection(var a,b : point);
var t : real;
begin
t:=0;
if (a.where_pt and 1)=1 then
begin
t:=(-x_max/d*a.oeil[3]-a.oeil[1])/(b.oeil[1]-a.oeil[1]+x_max/d*(b.oeil[3]-a.oeil[3]));
save(a,b,t);
a.init_where_pt;
end;
if (a.where_pt and 2)=2 then
begin
t:=(x_max/d*a.oeil[3]-a.oeil[1])/(b.oeil[1]-a.oeil[1]-x_max/d*(b.oeil[3]-a.oeil[3]));
save(a,b,t);
a.init_where_pt;
end;
if (a.where_pt and 4)=4 then
begin
t:=(-y_max/d*a.oeil[3]-a.oeil[2])/(b.oeil[2]-a.oeil[2]+y_max/d*(b.oeil[3]-a.oeil[3]));
save(a,b,t);
a.init_where_pt;
end;
if (a.where_pt and 8)=8 then
begin
t:=(y_max/d*a.oeil[3]-a.oeil[2])/(b.oeil[2]-a.oeil[2]-y_max/d*(b.oeil[3]-a.oeil[3]));
save(a,b,t);
a.init_where_pt;
end;
if (a.where_pt and 16)=16 then
begin
t:=(av-a.oeil[3])/(b.oeil[3]-a.oeil[3]);
save(a,b,t);
a.oeil[3]:=av;
a.init_where_pt;
end;
if (a.where_pt and 32)=32 then
begin
t:=(ar-a.oeil[3])/(b.oeil[3]-a.oeil[3]);
save(a,b,t);
a.oeil[3]:=ar;
a.init_where_pt;
end;
end;
procedure segments.decoupe;
begin
a.init_where_pt;
b.init_where_pt;
if (a.where_pt and b.where_pt)<>0
then elimine:=true
else
begin
elimine:=false;
if ((a.invision) and (b.invision)) then exit;
if a.invision and not b.invision
then intersection(b,a)
else if b.invision and not a.invision
then intersection(a,b)
else
begin
intersection(a,b);
intersection(b,a);
end;
end;
end;
procedure segments.calculs;
begin
segments.decoupe;
if not elimine then
begin
a.perspective;
b.perspective;
end;
end;
procedure segments.trace(color : word);
begin
setcolor(color);
if not elimine then line(changeX(a.ecran[1]),changeY(a.ecran[2]),changeX(b.ecran[1]),changeY(b.ecran[2]));
end;
{************ FIN Procedures concernant les segments **********}
{************ Procedures concernant les Faces **********}
procedure face.on_la_voit;
var produit_scalaire : real;
w : integer;
begin
regard[1]:=tab_segments[cote[1]].a.oeil[1];
regard[2]:=tab_segments[cote[1]].a.oeil[2];
regard[3]:=tab_segments[cote[1]].a.oeil[3];
produit_scalaire:=regard[1]*vectoriel[1]+regard[2]*vectoriel[2]+regard[3]*vectoriel[3];
if produit_scalaire<0 then visible:=false else visible:=true;
end;
procedure face.calcul_profondeur;
var w : integer;
begin
profondeur:=0;
for w:=1 to type_face do profondeur:=profondeur+sqrt(sqr(tab_segments[cote[w]].a.oeil[1])+
sqr(tab_segments[cote[w]].a.oeil[2])+sqr(tab_segments[cote[w]].a.oeil[3]));
profondeur:=profondeur/type_face;
end;
procedure tri_face(var tableau_trie : tableau_simple);
var w : integer;
procedure quick_sort(var tableau_trie : tableau_simple; deb, fin : integer);
var i, j, temp : integer;
milieu : real;
begin
i:=deb;
j:=fin;
milieu:=tab_faces[tableau_trie[(deb+fin) div 2]].profondeur;
while i<=j do
begin
while tab_faces[tableau_trie[i]].profondeur > milieu do inc(i);
while tab_faces[tableau_trie[j]].profondeur < milieu do dec(j);
if i<=j then
begin
temp:=tableau_trie[i];
tableau_trie[i]:=tableau_trie[j];
tableau_trie[j]:=temp;
inc(i);
dec(j);
end;
end;
if i3 then tab_segments[w].trace(0);
tab_segments[w].calculs;
end;
for w:=1 to nb_face do
begin
tab_faces[w].produit_vectoriel;
tab_faces[w].on_la_voit;
if mode=3 then tab_faces[w].calcul_profondeur;
end;
if mode=3 then
begin
tri_face(tab_trie_face);
cleardevice;
end
else bar(2,540,110,600);
info;
if mode=3 then
begin
for w:=1 to nb_face do
begin
if tab_faces[tab_trie_face[w]].visible then
begin
couleur:=tab_segments[tab_faces[tab_trie_face[w]].cote[1]].couleur;
setcolor(couleur);
setfillstyle(tab_faces[w].style,couleur);
tab_faces[tab_trie_face[w]].fill_it;
end;
end;
for w:=1 to nb_segments do
if ((not tab_segments[w].in_face) and (tab_faces[tab_segments[w].face].visible))
then tab_segments[w].trace(tab_segments[w].couleur);
end
else
for w:=1 to nb_segments do
if tab_segments[w].face=0 then tab_segments[w].trace(tab_segments[w].couleur) else
if tab_faces[tab_segments[w].face].visible then tab_segments[w].trace(tab_segments[w].couleur);
end;
procedure anim(is_theta : boolean;delai, increment : integer);
var w : integer;
begin
repeat
if is_theta then inc(theta,increment) else inc(phy,increment);
attention;
mouvement;
delay(delai);
until keypressed;
end;
procedure move;
var touche : char;
w, temp : integer;
begin
if not fileexist('svga256.bgi') then extract('svga256.bgi',0,0);
if not trigo_ready then prepare_trigo_tools;
initsvga(mode_graphique);
SettextStyle(DefaultFont,HorizDir,1);
touche:=chr(13);
repeat
if ord(touche) in [13,51,57,49,55,42,47,45,43,80,72,77,75,ord('t')] then mouvement;
touche:=readkey;
case ord(touche) of
75 : if mode=3 then inc(theta,2) else anim(true,14,2);
77 : if mode=3 then dec(theta,2) else anim(true,14,-2);
72 : if mode=3 then inc(phy,2) else anim(false,14,2);
80 : if mode=3 then dec(phy,2) else anim(false,14,-2);
43 : d:=d+0.5;
45 : if d>0.5 then d:=d-0.5;
47 : r:=r+0.5;
42 : if r>0.5 then r:=r-0.5;
ord('7') : if av>=0.5 then av:=av+0.5 else av:=av+0.1;
ord('1') : if av>0.5 then av:=av-0.5 else av:=av-0.1;
ord('9') : if ar>=0.5 then ar:=ar+0.5 else ar:=ar-0.1;
ord('3') : if ar>0.5 then ar:=ar-0.5 else ar:=ar-0.1;
13 : begin
d:=24;
r:=54.5;
theta:=227;
phy:=187;
av:=0;
ar:=100;
end;
end;
attention;
until ord(touche)=27;
closegraph;
nb_segments:=0;
nb_face:=0;
end;
begin
nb_segments:=0;
nb_face:=0;
trigo_ready:=false;
end.
|
