Source PostScript (solidtronque.pps)

Retour Texte non formaté
%% syntaxe : solid indicesommet k solidtronque --> solid %% syntaxe : solid array k solidtronque --> solid %% syntaxe : solid k solidtronque --> solid %% k entier > 0, array = tableau des indices des sommets /solidtronque { 10 dict begin /coeff exch def dup issolid { dup solidnombresommets /N exch def /table [0 1 N 1 sub {} for] def } { dup isarray { /table exch def } { [ exch ] /table exch def } ifelse } ifelse /solid exch def solid dupsolid /result exch def pop /n solid solidnombrefaces def 0 1 table length 1 sub { table exch get /no exch def result no solidgetsommet /sommetvise defpoint3d %% on recup les sommets adjacents au sommet vise /sommetsadj solid no solidsommetsadjsommet def %% on calcule les nouveaux sommets /nouveauxsommets [ 0 1 sommetsadj length 1 sub { /i exch def solid sommetsadj i get solidgetsommet } for ] {sommetvise exchp3d coeff ABpoint3d} papply3d def %% on pose G = barycentre de ces points nouveauxsommets isobarycentre3d /G defpoint3d %% il faut ordonner ces sommets nouveauxsommets 0 getp3d /ptref defpoint3d G result no solidgetsommet vecteur3d /vecteurnormal defpoint3d %% on construit le tableau des angles ordonnes par rapport %% a la normale nouveauxsommets duparray exch pop {1 dict begin /M defpoint3d G ptref vecteur3d G M vecteur3d vecteurnormal angle3doriente end} papply3d doublebubblesort pop %% nos sommets sont tries /indicesommetstries exch def %% on rajoute les sommets au solide, et on note les nouveaux indices /nouveauxindices [ 0 1 nouveauxsommets length 3 idiv 1 sub { /k exch def result nouveauxsommets k getp3d solidaddsommet } for ] def %% on ajoute la face concernee result [ 0 1 indicesommetstries length 1 sub { /k exch def nouveauxindices indicesommetstries k get get } for ] solidaddface result no solidfacesadjsommet /lesfaces exch def %% on examine la face d indice i, et on elimine le %% sommet vise 0 1 lesfaces length 1 sub { /i exch def /j lesfaces i get def /F result j solidgetface def result [ 0 1 F length 1 sub { /k exch def F k get dup no eq {pop} if } for ] j exch solidputface } for } for table bubblesort reverse {result exch solidrmsommet} apply result end } def