%% syntaxe : solid coeff solidchanfreine --> solid
/solidchanfreine {
10 dict begin
/coeff exch def
/solid exch def
/result newsolid def
solid issolid not {
(Erreur : mauvais type d argument dans solidchanfreine) ==
quit
} if
/n solid solidnombresommets def
/nf solid solidnombrefaces def
%% ajout des faces reduites
0 1 nf 1 sub {
/i exch def
/Fsommets solid i solidgetsommetsface def
/Findex solid i solidgetface def
/ns Fsommets length 3 idiv def
/couleurfaceorigine solid i solidgetfcolor def
Fsommets isobarycentre3d /G defpoint3d
%% on ajoute les nouveaux sommets
/Sindex [] def
0 1 ns 1 sub {
/j exch def
/Sindex [ Sindex aload pop
Fsommets j getp3d /M defpoint3d
result M G coeff hompoint3d solidaddsommet
] store
} for
%% Sindex contient les indices des nouveaux sommets
result Sindex couleurfaceorigine solidaddface
} for
%% ajout des faces rectangulaires entre faces d'origines adjacentes
%% pour chaque face de depart
0 1 nf 2 sub {
/i exch def
/F solid i solidgetface def
/couleurfaceorigine solid i solidgetfcolor def
/Fres result i solidgetface def
%% pour chaque arete de la face
0 1 F length 1 sub {
/j exch def
/trouve false def
/indice1 F j get def
/indice2 F j 1 add F length mod get def
/a1 j def
/a2 j 1 add F length mod def
%% on regarde toutes les autres faces
i 1 add 1 nf 1 sub {
/k exch def
/Ftest solid k solidgetface def
indice1 Ftest in {pop true} {false} ifelse
indice2 Ftest in {pop true} {false} ifelse
and {
/indiceFadj k def
indice1 Ftest in pop /k1 exch def
indice2 Ftest in pop /k2 exch def
/trouve true def
exit
} if
} for
trouve {
/Fadj solid indiceFadj solidgetface def
result [
Fres a1 get
result indiceFadj solidgetface k1 get
result indiceFadj solidgetface k2 get
Fres a2 get
] couleurfaceorigine solidaddface
} if
} for
} for
%% pour chaque face
0 1 nf 2 sub {
/i exch def
/F solid i solidgetface def
/couleurfaceorigine solid i solidgetfcolor def
%% et pour chaque sommet de cette face
0 1 F length 1 sub {
/j exch def
/k F j get def
solid k solidfacesadjsommet /adj exch def
%% adj est le tableau des indices des faces adjacentes
%% au sommet d'indice k
%% rque : toutes les faces d'indice strict inferieur a i
%% sont deja traitees
%% Pour chaque face adjacente, on repere l'indice du sommet concerne dans
%% la face
adj min i lt not {
/indadj [] def
0 1 adj length 1 sub {
/m exch def
k solid adj m get solidgetface in {
/ok exch def
/indadj [indadj aload pop ok] store
} if
} for
/aajouter [
0 1 adj length 1 sub {
/m exch def
result adj m get solidgetface indadj m get get
} for
] def
%% la table des sommets
[0 1 aajouter length 1 sub {
/m exch def
result aajouter m get solidgetsommet
} for]
solid k solidgetsommet %% le point indiquant la direction de la normale
ordonnepoints3d
/indicestries exch def
result [
0 1 indicestries length 1 sub {
/m exch def
aajouter indicestries m get get
} for
] couleurfaceorigine solidaddface
} if
} for
} for
result
end
} def
|