_______________________________________________________________________________________________________________________________________ /*************************************************************************************************************************************/ /* */ /* F O N C T I O N S D E B A S E A D E U X I M A G E S : */ /* */ /* */ /* Definition : */ /* */ /* Ce fichier contient toutes les fonctions */ /* de base de gestion et de manipulation de deux */ /* images raster, quelle que soit la definition. */ /* Ainsi, on pourra avec elles additionner deux */ /* images,... */ /* */ /* */ /* Author of '$xiii/di_image$FON' : */ /* */ /* Jean-Francois COLONNA (LACTAMME, 19870000000000). */ /* */ /*************************************************************************************************************************************/ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E P L A C E M E N T D ' U N E I M A G E " S T A N D A R D " : */ /* */ /*************************************************************************************************************************************/ BFonctionP /* ATTENTION : la mise de la fonction 'Imove(...)' dans le bloc '$a' des deux fonctions */ /* 'Itransformation_image(...)' et 'Itransformation_inverse_image(...)' (ces deux dernieres */ /* utilisant la premiere) provoquerait une augmentation importante de la taille des fichiers */ /* de type '$X' lorsque ceux-ci utilisent la fonction 'Imove(...)', ce qui est en fait tres */ /* frequent (voir '$xci/acces$X')... */ DEFV(Common,DEFV(FonctionP,POINTERp(Imove(imageR,imageA)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y]. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ CALS(iMOVE(imageR,imageA)); RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E P L A C E M E N T D ' U N E I M A G E " S T A N D A R D " */ /* A V E C M A R Q U A G E D ' U N P O I N T V A L I D E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(Logical,SINT(Imove_avec_store_point_valide_____avertir_hors_image,FAUX))); /* Introduit le 20170918115250 pour 'v $xiirk/.SYRA.F1.1.$U avertir_hors_image'... */ DEFV(Common,DEFV(FonctionP,POINTERp(Imove_avec_store_point_valide(imageR ,imageA ,niveau_du_point ,abscisse_du_point ,ordonnee_du_point ) ) ) ) /* Cette fonction a ete introduite le 20030119094147 pour etre utilisee dans la */ /* commande 'v $xci/S_point$K Imove_avec_store_point_valide'. */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y]. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(genere_p,niveau_du_point)); /* Niveau du point a marquer. */ DEFV(Argument,DEFV(Int,abscisse_du_point)); DEFV(Argument,DEFV(Int,ordonnee_du_point)); /* Coordonnees du point a marquer. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ iMOVE(imageR,imageA); /* Deplacement de l'image, */ Test(IL_FAUT(Imove_avec_store_point_valide_____avertir_hors_image)) Bblock Test(TEST_HORS_IMAGE(abscisse_du_point,ordonnee_du_point)) Bblock PRINT_ERREUR("le point est hors image"); CAL1(Prer2("(ses coordonnees sont {x,y} = {%d,%d})\n",abscisse_du_point,ordonnee_du_point)); /* Edition introduite le 20170918115250... */ Eblock ATes Bblock Eblock ETes Eblock ATes Bblock Eblock ETes store_point_valide(niveau_du_point ,imageR ,abscisse_du_point ,ordonnee_du_point ,FVARIABLE ); /* Et on marque le point... */ RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E P L A C E M E N T D ' U N E I M A G E " S T A N D A R D " */ /* A V E C M A R Q U A G E D ' U N E C H A I N E D E P O I N T S V A L I D E S : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Imove_avec_store_chaine(imageR ,imageA ,chaine_de_points ,abscisse_du_point_de_depart ,ordonnee_du_point_de_depart ,increment_de_l_abscisse ,increment_de_l_ordonnee ) ) ) ) /* Cette fonction a ete introduite le 20030119094147 pour simplifier la programmation */ /* de la commande 'v $xci/AutoC_2DB.01$Z S_pointx.X'. */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y]. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(CHAR,DTb0(chaine_de_points))); /* Chaine de points a marquer representes par leurs niveaux. */ DEFV(Argument,DEFV(Int,abscisse_du_point_de_depart)); DEFV(Argument,DEFV(Int,ordonnee_du_point_de_depart)); /* Coordonnees du point de depart de la chaine de points a marquer, */ DEFV(Argument,DEFV(Int,increment_de_l_abscisse)); DEFV(Argument,DEFV(Int,increment_de_l_ordonnee)); /* Et increment des coordonnees pour passer d'un point a l'autre... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Logical,INIT(marquer_les_points,VRAI)); /* Pour controler la boucle 'Tant(...)'. */ DEFV(Int,INIT(abscisse_du_point_courant,abscisse_du_point_de_depart)); DEFV(Int,INIT(ordonnee_du_point_courant,ordonnee_du_point_de_depart)); /* Coordonnees du point courant. */ DEFV(Int,INIT(index_des_points_a_marquer,PREMIER_CARACTERE)); /* Index de parcours de 'chaine_de_points'. */ /*..............................................................................................................................*/ iMOVE(imageR,imageA); /* Deplacement de l'image, */ Tant(IL_FAUT(marquer_les_points)) Bblock DEFV(CHAR,INIT(caractere_courant,ITb0(chaine_de_points,INDX(index_des_points_a_marquer,PREMIER_CARACTERE)))); /* Caractere courant. */ Test(IFNE(caractere_courant,END_OF_CHAIN)); Bblock store_point_valide(caractere_courant ,imageR ,abscisse_du_point_courant ,ordonnee_du_point_courant ,FVARIABLE ); /* Marquage du point courant. */ INCR(index_des_points_a_marquer,I); INCR(abscisse_du_point_courant,increment_de_l_abscisse); INCR(ordonnee_du_point_courant,increment_de_l_ordonnee); /* Passage au point suivant... */ Eblock ATes Bblock EGAL(marquer_les_points,FAUX); /* On arrete sur la fin de chaine... */ Eblock ETes Eblock ETan RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E P L A C E M E N T D ' U N E I M A G E " P O S I T I V E - I N T " : */ /* */ /*************************************************************************************************************************************/ BFonctionU DEFV(Common,DEFV(FonctionU,POINTERU(IUmove(imageR,imageA)))) DEFV(Argument,DEFV(imageU,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y]. */ DEFV(Argument,DEFV(imageU,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock storeU_point(loadU_point(imageA,X,Y),imageR,X,Y); Eblock end_image RETIU(imageR); Eblock EFonctionU _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E P L A C E M E N T D ' U N E I M A G E " C O M P L E X E " : */ /* */ /*************************************************************************************************************************************/ BFonctionJ DEFV(Common,DEFV(FonctionJ,POINTERJ(IJmove(imageR,imageA)))) DEFV(Argument,DEFV(imageJ,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y]. */ DEFV(Argument,DEFV(imageJ,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock storeJ_point(loadJ_point(imageA,X,Y),imageR,X,Y); Eblock end_image RETIJ(imageR); Eblock EFonctionJ _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E P L A C E M E N T D ' U N E I M A G E " H Y P E R - C O M P L E X E " : */ /* */ /*************************************************************************************************************************************/ BFonctionHJ DEFV(Common,DEFV(FonctionHJ,POINTERHJ(IHJmove(imageR,imageA)))) /* Fonction introduite le 20150227204609... */ DEFV(Argument,DEFV(imageHJ,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y]. */ DEFV(Argument,DEFV(imageHJ,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock storeHJ_point(loadHJ_point(imageA,X,Y),imageR,X,Y); Eblock end_image RETIHJ(imageR); Eblock EFonctionHJ _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E P L A C E M E N T D ' U N E I M A G E " H Y P E R - H Y P E R - C O M P L E X E " : */ /* */ /*************************************************************************************************************************************/ BFonctionHHJ DEFV(Common,DEFV(FonctionHHJ,POINTERHHJ(IHHJmove(imageR,imageA)))) /* Fonction introduite le 20150227204609... */ DEFV(Argument,DEFV(imageHHJ,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y]. */ DEFV(Argument,DEFV(imageHHJ,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock storeHHJ_point(loadHHJ_point(imageA,X,Y),imageR,X,Y); Eblock end_image RETIHHJ(imageR); Eblock EFonctionHHJ _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* C E N T R A G E D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ BFonctionP #define BALAYAGE_DE_CENTRAGE(begin1,begin2,coordonnee_au_bord,coordonnee,end2,end1) \ Bblock \ DEFV(Logical,INIT(balayer,VRAI)); \ \ begin1 \ Bblock \ begin2 \ Bblock \ Test(IL_FAUT(balayer)) \ Bblock \ Test(IFEQ(load_point(imageA,X,Y),Icentrage_____niveau_de_reference)) \ Bblock \ Eblock \ ATes \ Bblock \ EGAL(coordonnee_au_bord,coordonnee); \ EGAL(balayer,FAUX); \ Eblock \ ETes \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ end2 \ Eblock \ end1 \ Eblock DEFV(Common,DEFV(genere_p,SINT(Icentrage_____niveau_de_reference,NOIR))); DEFV(Common,DEFV(Logical,SINT(Icentrage_____editer_les_translations_normalisees,FAUX))); DEFV(Common,DEFV(FonctionP,POINTERp(Icentrage(imageR,imageA)))) /* Fonction introduite le 20150421132532... */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] centree... */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Int,INIT(X_gauche,Xmin)); DEFV(Int,INIT(X_droite,Xmax)); DEFV(Int,INIT(Y_bas___,Ymin)); DEFV(Int,INIT(Y_haut__,Ymax)); /* Afin de definir le centrage... */ DEFV(deltaI_2D,translation_de_centrage); /* Definition de la translation de centrage... */ /*..............................................................................................................................*/ BALAYAGE_DE_CENTRAGE(begin_ligne,begin_colonne,X_gauche,X,end_colonne,end_ligne); BALAYAGE_DE_CENTRAGE(begin_ligne_back,begin_colonne,X_droite,X,end_colonne,end_ligne_back); BALAYAGE_DE_CENTRAGE(begin_colonne,begin_ligne,Y_bas___,Y,end_ligne,end_colonne); BALAYAGE_DE_CENTRAGE(begin_colonne_back,begin_ligne,Y_haut__,Y,end_ligne,end_colonne_back); /* Recherche de la position de l'image Argument. */ Test(IFET(IFEQ(X_gauche,Xmin),IFEQ(X_droite,Xmax))) Bblock CLIR(ASD1(translation_de_centrage,dx)); /* En effet dans ce cas et si 'MOYE(...)' ne tombe pas juste, cela introduit un decalage */ /* non justifie... */ Eblock ATes Bblock EGAL(ASD1(translation_de_centrage,dx),SOUS(Xcentre,MOYE(COXR(X_gauche),COXR(X_droite)))); /* Definition de la translation horizontale de centrage... */ Eblock ETes Test(IFET(IFEQ(Y_bas___,Ymin),IFEQ(Y_haut__,Ymax))) Bblock CLIR(ASD1(translation_de_centrage,dy)); /* En effet dans ce cas et si 'MOYE(...)' ne tombe pas juste, cela introduit un decalage */ /* non justifie... */ Eblock ATes Bblock EGAL(ASD1(translation_de_centrage,dy),SOUS(Ycentre,MOYE(COYR(Y_bas___),COYR(Y_haut__)))); /* Definition de la translation verticale de centrage... */ Eblock ETes Test(IL_FAUT(Icentrage_____editer_les_translations_normalisees)) Bblock CAL3(Prme1("xR=%+.^^^\n",_____lNORMALISE_OX(ASD1(translation_de_centrage,dx)))); CAL3(Prme1("yR=%+.^^^\n",_____lNORMALISE_OY(ASD1(translation_de_centrage,dy)))); /* Edition introduite le 20150421142951... */ /* */ /* On notera que l'edition est compatible avec 'v $xci/move$K xR' et 'v $xci/move$K yR'. */ Eblock ATes Bblock Eblock ETes begin_image Bblock store_point_valide(load_point(imageA,X,Y) ,imageR ,ADD2(X,ASD1(translation_de_centrage,dx)),ADD2(Y,ASD1(translation_de_centrage,dy)) ,FVARIABLE ); /* Centrage de l'image Argument. */ Eblock end_image RETI(imageR); Eblock EFonctionP #undef BALAYAGE_DE_CENTRAGE _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* " B O R D U R A G E " D ' U N D O M A I N E R E C T A N G U L A I R E : */ /* */ /*************************************************************************************************************************************/ BFonctionP #define __________________________Xmin \ Xmin #define __________________________Xmax \ Xmax #define __________________________Ymin \ Ymin #define __________________________Ymax \ Ymax /* Pour ameliorer la mise en page ci-apres... */ #define REMPLISSAGE_D_UN_DOMAINE_RECTANGULAIRE(xbg,ybg,xhd,yhd,niveau_de_remplissage) \ /* Le domaine rectanulaire est defini par les coordonnees {x,y} des coins Bas-Gauche et */ \ /* Haut-Droite respectivement... */ \ Bblock \ begin_imageQ(DoIn,ybg,yhd,pasY,DoIn,xbg,xhd,pasX) \ Bblock \ store_point_valide(COND(IL_NE_FAUT_PAS(Ibordurage_d_un_domaine_rectangulaire_____forcer_un_niveau_unique) \ ,niveau_de_remplissage \ ,Ibordurage_d_un_domaine_rectangulaire_____niveau_unique_a_forcer \ ) \ ,imageR \ ,X,Y \ ,FVARIABLE \ ); \ /* Remplissage du domaine... */ \ Eblock \ end_imageQ(EDoI,EDoI) \ Eblock \ /* Remplissage de l'un des huit domaines rectangulaires encadrant le domaine rectangulaire */ \ /* Argument... */ DEFV(Common,DEFV(Logical,SINT(Ibordurage_d_un_domaine_rectangulaire_____forcer_un_niveau_unique,FAUX))); DEFV(Common,DEFV(genere_p,SINT(Ibordurage_d_un_domaine_rectangulaire_____niveau_unique_a_forcer,BLANC))); /* Introduit le 20070216181318 pour permettre de generer (par defaut : voir le 'BLANC' */ /* ci-dessus) un cadre pour la peripherie d'une image... */ DEFV(Common,DEFV(FonctionP,POINTERp(Ibordurage_d_un_domaine_rectangulaire(imageR ,imageA ,ARGUMENT_POINTERs(coin_bas__gauche) ,ARGUMENT_POINTERs(coin_haut_droite) ) ) ) ) /* Cette fonction a ete introduite le 20070214094233 pour etre utilisee dans */ /* 'v $xiirk/.DIFF.11.2.$U .xci.bordurage.11.X' ou son utilite est alors de conserver */ /* les proprietes topologiques d'un ensemble de points, en vue d'une extraction de contour, */ /* alors que son domaine a ete augmente tout autour... */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y]. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(pointI_2D,POINTERs(coin_bas__gauche))); DEFV(Argument,DEFV(pointI_2D,POINTERs(coin_haut_droite))); /* Definition du domaine a "bordurer" a l'aide de ses coins Bas-Gauche et Haut-Droite */ /* respectivement... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ REMPLISSAGE_D_UN_DOMAINE_RECTANGULAIRE(__________________________Xmin,__________________________Ymin ,PREX(ASI1(coin_bas__gauche,x)),PREY(ASI1(coin_bas__gauche,y)) ,load_point_valide(imageA,ASI1(coin_bas__gauche,x),ASI1(coin_bas__gauche,y)) ); /* Remplissage du domaine Bas-Gauche. */ REMPLISSAGE_D_UN_DOMAINE_RECTANGULAIRE(NEUT(ASI1(coin_bas__gauche,x)),__________________________Ymin ,NEUT(ASI1(coin_haut_droite,x)),PREY(ASI1(coin_bas__gauche,y)) ,load_point_valide(imageA,X,ASI1(coin_bas__gauche,y)) ); /* Remplissage du domaine Bas. */ REMPLISSAGE_D_UN_DOMAINE_RECTANGULAIRE(SUCX(ASI1(coin_haut_droite,x)),__________________________Ymin ,__________________________Xmax,PREY(ASI1(coin_bas__gauche,y)) ,load_point_valide(imageA,ASI1(coin_haut_droite,x),ASI1(coin_bas__gauche,y)) ); /* Remplissage du domaine Bas-Droite. */ REMPLISSAGE_D_UN_DOMAINE_RECTANGULAIRE(SUCX(ASI1(coin_haut_droite,x)),NEUT(ASI1(coin_bas__gauche,y)) ,__________________________Xmax,NEUT(ASI1(coin_haut_droite,y)) ,load_point_valide(imageA,ASI1(coin_haut_droite,x),Y) ); /* Remplissage du domaine Droite. */ REMPLISSAGE_D_UN_DOMAINE_RECTANGULAIRE(SUCX(ASI1(coin_haut_droite,x)),SUCY(ASI1(coin_haut_droite,y)) ,__________________________Xmax,__________________________Ymax ,load_point_valide(imageA,ASI1(coin_haut_droite,x),ASI1(coin_haut_droite,y)) ); /* Remplissage du domaine Haut-Droite. */ REMPLISSAGE_D_UN_DOMAINE_RECTANGULAIRE(NEUT(ASI1(coin_bas__gauche,x)),SUCY(ASI1(coin_haut_droite,y)) ,NEUT(ASI1(coin_haut_droite,x)),__________________________Ymax ,load_point_valide(imageA,X,ASI1(coin_haut_droite,y)) ); /* Remplissage du domaine Haut. */ REMPLISSAGE_D_UN_DOMAINE_RECTANGULAIRE(__________________________Xmin,SUCY(ASI1(coin_haut_droite,y)) ,PREX(ASI1(coin_bas__gauche,x)),__________________________Ymax ,load_point_valide(imageA,ASI1(coin_bas__gauche,x),ASI1(coin_haut_droite,y)) ); /* Remplissage du domaine Haut-Gauche. */ REMPLISSAGE_D_UN_DOMAINE_RECTANGULAIRE(__________________________Xmin,NEUT(ASI1(coin_bas__gauche,y)) ,PREX(ASI1(coin_bas__gauche,x)),NEUT(ASI1(coin_haut_droite,y)) ,load_point_valide(imageA,ASI1(coin_bas__gauche,x),Y) ); /* Remplissage du domaine Gauche. */ RETI(imageR); Eblock #undef REMPLISSAGE_D_UN_DOMAINE_RECTANGULAIRE #undef __________________________Ymax #undef __________________________Ymin #undef __________________________Xmax #undef __________________________Xmin EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* T R A N S F O R M A T I O N B I - D I M E N S I O N N E L L E */ /* Q U E L C O N Q U E D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ /* ATTENTION : la mise de la fonction 'Imove(...)' dans le bloc '$a' des deux fonctions */ /* 'Itransformation_image(...)' et 'Itransformation_inverse_image(...)' (ces deux dernieres */ /* utilisant la premiere) provoquerait une augmentation importante de la taille des fichiers */ /* de type '$X' lorsque ceux-ci utilisent la fonction 'Imove(...)', ce qui est en fait tres */ /* frequent (voir '$xci/acces$X')... */ #define COORDONNEE_u(x,y) \ ADD2(Umin,MUL2(SOUS(Umax,Umin),SOUS(_____cNORMALISE_OX(x),ASI1(translation,dx)))) \ /* Fonction de passage des coordonnees {X,Y} a la coordonnee 'u'. */ #define COORDONNEE_v(x,y) \ ADD2(Vmin,MUL2(SOUS(Vmax,Vmin),SOUS(_____cNORMALISE_OY(y),ASI1(translation,dy)))) \ /* Fonction de passage des coordonnees {X,Y} a la coordonnee 'v'. */ #define F_TRANSFORMATION_OX(u,v) \ FLOT(fPOINTEUR(Fx)(DPRE(u),DPRE(v))) \ /* Transformation suivant 'OX' des coordonnees de-normalisees, */ #define F_TRANSFORMATION_OY(u,v) \ FLOT(fPOINTEUR(Fy)(DPRE(u),DPRE(v))) \ /* Transformation suivant 'OY' des coordonnees de-normalisees. */ #define I_TRANSFORMATION_OX(x,y) \ F_TRANSFORMATION_OX(COORDONNEE_u(x,y),COORDONNEE_v(x,y)) \ /* Transformation suivant 'OX' des coordonnees normalisees, */ #define I_TRANSFORMATION_OY(x,y) \ F_TRANSFORMATION_OY(COORDONNEE_u(x,y),COORDONNEE_v(x,y)) \ /* Transformation suivant 'OY' des coordonnees normalisees. */ BFonctionP #define POINT_NON_ATTEINT \ ZERO \ /* Pour initialiser le nombre des collisions en chaque point image par la */ \ /* transformation (Fx,Fy) ; cette valeur est donc aussi utilisee pour savoir */ \ /* si un point a ete atteint ou pas... */ #define NOMBRE_DE_POINTS_MAXIMAL \ MOIT(QUAR(QUAR(MOIT(QUAR(QUAR(dimXY)))))) \ /* Nombre de points que l'on traitera au maximum sur une spirale. */ #define NIVEAU_NON_ATTEINT \ NIVEAU_UNDEF \ /* Niveau attribue aux points que l'on ne peut definir... */ #define INVERSION_DES_DISTANCES \ FU \ /* Afin de pouvoir calculer une fonction (I/(I-1+d)), ou 'I' est la constante */ \ /* ici definie, et ou la distance 'd' est superieure ou egale a 1... */ DEFV(Common,DEFV(FonctionP,POINTERp(Itransformation_image(imageR ,imageA ,ARGUMENT_POINTERs(translation) ,nettoyer ,boucher_les_trous ,pondererer_par_les_distances ,ARGUMENT_FONCTION(Fx),ARGUMENT_FONCTION(Fy) ,Umin,Umax ,Vmin,Vmax ) ) ) ) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, dans laquelle on genere la transformation de l'image Argument. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument a transformer. */ DEFV(Argument,DEFV(deltaF_2D,POINTERs(translation))); /* Translation horizontale ('dx') et verticale ('dy') de l'image argument ; on */ /* n'oubliera pas que cette translation est exprimee dans des unites telles */ /* l'unite soit respectivement [Xmin,Xmax] et [Ymin,Ymax]. */ DEFV(Argument,DEFV(Logical,nettoyer)); /* Indicateur demandant ('VRAI') ou pas ('FAUX') la mise a noir */ /* de l'image 'imageR'. */ DEFV(Argument,DEFV(Logical,boucher_les_trous)); /* Indicateur demandant ('VRAI') ou pas ('FAUX') le bouchage des */ /* trous crees par la transformation dans l'image 'imageR'. */ DEFV(Argument,DEFV(Logical,pondererer_par_les_distances)); /* Indicateur demandant ('VRAI') ou pas ('FAUX' qui sera l'option standard) */ /* la ponderation par les distances lors du bouchage des trous ; en effet, */ /* cette ponderation, dans des transformations tres regulieres (homotheties */ /* par exemple), introduit des artefacts desagreables... */ DEFV(Argument,DEFV(Float,afPOINTEUR(Fx))); /* Definition de la fonction 'Fx(u,v)', */ DEFV(Argument,DEFV(Float,afPOINTEUR(Fy))); /* Definition de la fonction 'Fy(u,v)'. */ DEFV(Argument,DEFV(Float,Umin)); /* Valeur inferieure de la coordonnee 'u', */ DEFV(Argument,DEFV(Float,Umax)); /* Valeur superieure de la coordonnee 'u'. */ DEFV(Argument,DEFV(Float,Vmin)); /* Valeur inferieure de la coordonnee 'v', */ DEFV(Argument,DEFV(Float,Vmax)); /* Valeur superieure de la coordonnee 'v'. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Float,INIT(coordonnee_u,FLOT__UNDEF)); /* Valeur de-normalisee de 'X', */ DEFV(Float,INIT(coordonnee_v,FLOT__UNDEF)); /* Valeur de-normalisee de 'Y'. */ DEFV(genere_p,INIT(niveau_bass_gauche,NIVEAU_UNDEF)); DEFV(pointI_2D,coinI_bass_gauche); /* Coin bas-gauche de la transforme de la maille de base, */ DEFV(genere_p,INIT(niveau_bass_droite,NIVEAU_UNDEF)); DEFV(pointI_2D,coinI_bass_droite); /* Coin bas-droite de la transforme de la maille de base, */ DEFV(genere_p,INIT(niveau_haut_gauche,NIVEAU_UNDEF)); DEFV(pointI_2D,coinI_haut_gauche); /* Coin haut-gauche de la transforme de la maille de base, */ DEFV(genere_p,INIT(niveau_haut_droite,NIVEAU_UNDEF)); DEFV(pointI_2D,coinI_haut_droite); /* Coin haut-droite de la transforme de la maille de base. */ DEFV(Int,INIT(X_transforme,UNDEF)); /* Coordonnee entiere horizontale apres transformation par 'Fx', */ DEFV(Int,INIT(Y_transforme,UNDEF)); /* Coordonnee entiere verticale apres transformation par 'Fy'. */ BDEFV(imageI,nombre_de_collisions); /* Afin de compter les "collisions" : en effet, plusieurs points de 'imageA' */ /* peuvent "tomber" sur le meme point de 'imageR' par la transformation */ /* argument (Fx,Fy). */ BDEFV(imageI,niveaux_cumules); /* Donne la somme des niveaux des points de 'imageA' tombant en le meme */ /* point de 'imageR'. */ BDEFV(image,imageR_trouee); /* Image intermediaire contenant une version eventuellement "mitee" de 'imageR'. */ DEFV(genere_p,INIT(nouveau_niveau,NIVEAU_UNDEF)); /* Niveau a donner au point courant de 'imageR' apres correction... */ DEFV(Int,INIT(coin_gauche,UNDEF)); /* Abscisse minimale d'encadrement de la transformee de 'imageA', */ DEFV(Int,INIT(coin_droite,UNDEF)); /* Abscisse maximale d'encadrement de la transformee de 'imageA'. */ DEFV(Int,INIT(coin_bass,UNDEF)); /* Ordonnee minimale d'encadrement de la transformee de 'imageA', */ DEFV(Int,INIT(coin_haut,UNDEF)); /* Ordonnee maximale d'encadrement de la transformee de 'imageA' ; */ /* ces quatre dernieres definitions sont destinees a rechercher un */ /* encadrement a la transformee de 'imageA'. */ DEFV(Logical,INIT(arret_obligatoire,LUNDEF)); /* Afin d'eviter des bouclages trop longs sur la spirale. */ DEFV(Int,INIT(nombre_de_points,UNDEF)); /* Donne le nombre courant de point d'une spirale qui sont dans l'image. */ SPIRALE_DEFINITION /* Donnees de generation d'une spirale de parcours d'une image. */ DEFV(Int,INIT(nombre_de_cumuls,UNDEF)); /* Donne le nombre de points cumules sur une spirale. */ DEFV(Float,INIT(distance_courante,FLOT__UNDEF)); /* Distance du point courant de la spirale au centre de celle-ci. */ DEFV(Float,INIT(cumul_des_distances,FLOT__UNDEF)); /* Afin de calculer la somme des distances du point courant aux points */ /* pris en compte sur la spirale. */ DEFV(Float,INIT(cumul_des_niveaux,FLOT__UNDEF)); /* Afin de calculer la somme des niveaux ponderes (par les distances au point */ /* courant) des points pris en compte sur la spirale. */ DEFV(pointI_2D,point_courant); /* Point courant sur la spirale. */ DEFV(Int,INIT(abscisse_minimale,UNDEF)); /* Abscisse minimale rencontree lors du parcours de la spirale, */ DEFV(Int,INIT(abscisse_maximale,UNDEF)); /* Abscisse maximale rencontree lors du parcours de la spirale. */ DEFV(Int,INIT(ordonnee_minimale,UNDEF)); /* Ordonnee minimale rencontree lors du parcours de la spirale, */ DEFV(Int,INIT(ordonnee_maximale,UNDEF)); /* Ordonnee maximale rencontree lors du parcours de la spirale ; */ /* ces quatre dernieres definitions sont destinees a rechercher un */ /* polygone entourant le point courant {X,Y}. */ /*..............................................................................................................................*/ Test(IFOU(IFLE(Umax,Umin) ,IFLE(Vmax,Vmin) ) ) Bblock /* La deuxieme partie du test est rendue necessaire par le texturage, */ /* en effet, [Umin,Umax]*[Vmin,Vmax] doit alors etre en bijection */ /* avec [Xmin,Xmax]*[Ymin,Ymax] du champ de texture. */ PRINT_ERREUR("l'ordre des bornes inferieures et/ou superieures des coordonnees (u,v) est mauvais"); CAL1(Prer2("(Umin,Umax) = (%g,%g)\n",Umin,Umax)); CAL1(Prer2("(Vmin,Vmax) = (%g,%g)\n",Vmin,Vmax)); Eblock ATes Bblock Test(IL_FAUT(nettoyer)) Bblock CALS(Inoir(imageR)); /* Nettoyage de l'image resultat. */ Eblock ATes Bblock Eblock ETes CALS(IIinitialisation(nombre_de_collisions,POINT_NON_ATTEINT)); CALS(IIinitialisation(niveaux_cumules,INTE(NOIR))); /* On initialise de facon a ce qu'il n'y ait a priori aucun point d'atteint. */ begin_imageQ(DoIn,Ymin,PREY(Ymax),pasY,DoIn,Xmin,PREX(Xmax),pasX) Bblock /* Application "bestiale" de la transformation (Fx,Fy) : */ /* */ /* |------------------| */ /* | imageA | */ /* | | */ /* | | */ /* | M1............................... */ /* | | . */ /* | | . */ /* | M2...........................> (M1,M2,M3) ont meme */ /* | | . image "entiere" par */ /* | | . la transformation (Fx,Fy), */ /* | M3........................... on compte les collisions. */ /* | | */ /* |------------------| */ /* */ /* de plus, deux points voisins 'M' et 'N' */ /* peuvent avoir deux images "tres" distantes, */ /* ce qui cree donc des trous... */ /* */ INITIALISATION_POINT_2D(coinI_bass_gauche ,_cDENORMALISE_OX(I_TRANSFORMATION_OX(NEUT(X),NEUT(Y))) ,_cDENORMALISE_OY(I_TRANSFORMATION_OY(NEUT(X),NEUT(Y))) ); /* Transforme du coin bas-gauche de la maille elementaire, */ INITIALISATION_POINT_2D(coinI_bass_droite ,_cDENORMALISE_OX(I_TRANSFORMATION_OX(SUCX(X),NEUT(Y))) ,_cDENORMALISE_OY(I_TRANSFORMATION_OY(SUCX(X),NEUT(Y))) ); /* Transforme du coin bas-droite de la maille elementaire, */ INITIALISATION_POINT_2D(coinI_haut_gauche ,_cDENORMALISE_OX(I_TRANSFORMATION_OX(NEUT(X),SUCY(Y))) ,_cDENORMALISE_OY(I_TRANSFORMATION_OY(NEUT(X),SUCY(Y))) ); /* Transforme du coin haut-gauche de la maille elementaire, */ INITIALISATION_POINT_2D(coinI_haut_droite ,_cDENORMALISE_OX(I_TRANSFORMATION_OX(SUCX(X),SUCY(Y))) ,_cDENORMALISE_OY(I_TRANSFORMATION_OY(SUCX(X),SUCY(Y))) ); /* Transforme du coin haut-droite de la maille elementaire. */ Test(IFET(IFET(TEST_DANS_L_IMAGE(ASD1(coinI_bass_gauche,x),ASD1(coinI_bass_gauche,y)) ,TEST_DANS_L_IMAGE(ASD1(coinI_bass_droite,x),ASD1(coinI_bass_droite,y)) ) ,IFET(TEST_DANS_L_IMAGE(ASD1(coinI_haut_gauche,x),ASD1(coinI_haut_gauche,y)) ,TEST_DANS_L_IMAGE(ASD1(coinI_haut_droite,x),ASD1(coinI_haut_droite,y)) ) ) ) Bblock EGAL(niveau_bass_gauche,load_point(imageA,NEUT(X),NEUT(Y))); EGAL(niveau_bass_droite,load_point(imageA,SUCX(X),NEUT(Y))); EGAL(niveau_haut_gauche,load_point(imageA,NEUT(X),SUCY(Y))); EGAL(niveau_haut_droite,load_point(imageA,SUCX(X),SUCY(Y))); /* Recherche des niveaux aux quatre sommets de la maille elementaire. */ DoIn(coordonnee_v ,COORDONNEE_v(NEUT(X),NEUT(Y)) ,COORDONNEE_v(NEUT(X),SUCY(Y)) ,FLOT(DIVI(SOUS(COORDONNEE_v(NEUT(X),SUCY(Y)) ,COORDONNEE_v(NEUT(X),NEUT(Y)) ) ,MAX2(SOUS(FLOT(pasY),gEPSILON) ,FLOT(MAX2(SOUA(ASD1(coinI_haut_gauche,y),ASD1(coinI_bass_gauche,y)) ,SOUA(ASD1(coinI_haut_droite,y),ASD1(coinI_bass_droite,y)) ) ) ) ) ) ) Bblock /* Sous-echantillonage vertical de la maille elementaire pour reduire le */ /* plus possible le nombre de defauts a corriger ulterieurement ; le */ /* 'gEPSILON' est la pour simplifier les cas ou la transformee de la */ /* maille elementaire est "inferieure" a cette derniere... */ DoIn(coordonnee_u ,COORDONNEE_u(NEUT(X),NEUT(Y)) ,COORDONNEE_u(SUCX(X),NEUT(Y)) ,FLOT(DIVI(SOUS(COORDONNEE_u(SUCX(X),NEUT(Y)) ,COORDONNEE_u(NEUT(X),NEUT(Y)) ) ,MAX2(SOUS(FLOT(pasX),gEPSILON) ,FLOT(MAX2(SOUA(ASD1(coinI_bass_droite,x),ASD1(coinI_bass_gauche,x)) ,SOUA(ASD1(coinI_haut_droite,x),ASD1(coinI_haut_gauche,x)) ) ) ) ) ) ) Bblock /* Sous-echantillonage horizontal de la maille elementaire pour reduire le */ /* plus possible le nombre de defauts a corriger ulterieurement ; le */ /* 'gEPSILON' est la pour simplifier les cas ou la transformee de la */ /* maille elementaire est "inferieure" a cette derniere... */ EGAL(X_transforme,_cDENORMALISE_OX(F_TRANSFORMATION_OX(coordonnee_u,coordonnee_v))); EGAL(Y_transforme,_cDENORMALISE_OY(F_TRANSFORMATION_OY(coordonnee_u,coordonnee_v))); /* Application de la transformation (Fx,Fy). */ Test(TEST_DANS_L_IMAGE(X_transforme,Y_transforme)) Bblock /* Schema de l'interpolation sur la maille */ /* elementaire (BG,BD,HD,HG) : */ /* */ /* */ /* HG (haut-gauche) HD (haut-droite) */ /* */ /* nHG <-----h3------> <---h4---> nHD */ /* *--------------------------* */ /* ^|\ . /|^ */ /* || \ . / || */ /* || \ . / || */ /* v1| 4 . 3 |v2 */ /* || \ . / || */ /* || \ . / || */ /* V| point\ ./ courant |V */ /* v ................#..........| */ /* ^| / .\ |^ */ /* || / . \ || */ /* v4| 1 . 2 |v3 */ /* || / . \ || */ /* V| / . \ |V */ /* *---------------.----------* */ /* nBG <-----h2------> <---h1---> nBD */ /* u */ /* BG (bas-gauche) BD (bas-droite) */ /* */ /* */ /* le niveau 'N' du point courant (u,v) est */ /* donne par la formule d'interpolation : */ /* */ /* N = (nBG.h1.v1) + (nBD.h2.v2) + (nHG.h3.v3) + (nHD.h4.v4) */ /* */ storeI_point(ADD2(loadI_point(nombre_de_collisions ,X_transforme,Y_transforme ) ,I ) ,nombre_de_collisions ,X_transforme,Y_transforme ); /* Comptage des collisions au point (X_transforme,Y_transforme). */ storeI_point(ADD2(loadI_point(niveaux_cumules ,X_transforme,Y_transforme ) ,INTE(DIVI(ADD2(ADD2(MUL2(niveau_bass_gauche ,MUL2(SOUS(COORDONNEE_u(SUCX(X),NEUT(Y)) ,coordonnee_u ) ,SOUS(COORDONNEE_v(NEUT(X),SUCY(Y)) ,coordonnee_v ) ) ) ,MUL2(niveau_bass_droite ,MUL2(SOUS(coordonnee_u ,COORDONNEE_u(NEUT(X),NEUT(Y)) ) ,SOUS(COORDONNEE_v(SUCX(X),SUCY(Y)) ,coordonnee_v ) ) ) ) ,ADD2(MUL2(niveau_haut_gauche ,MUL2(SOUS(COORDONNEE_u(SUCX(X),SUCY(Y)) ,coordonnee_u ) ,SOUS(coordonnee_v ,COORDONNEE_v(NEUT(X),NEUT(Y)) ) ) ) ,MUL2(niveau_haut_droite ,MUL2(SOUS(coordonnee_u ,COORDONNEE_u(NEUT(X),SUCY(Y)) ) ,SOUS(coordonnee_v ,COORDONNEE_v(SUCX(X),NEUT(Y)) ) ) ) ) ) ,ADD2(ADD2(MUL2(SOUS(COORDONNEE_u(SUCX(X),NEUT(Y)) ,coordonnee_u ) ,SOUS(COORDONNEE_v(NEUT(X),SUCY(Y)) ,coordonnee_v ) ) ,MUL2(SOUS(coordonnee_u ,COORDONNEE_u(NEUT(X),NEUT(Y)) ) ,SOUS(COORDONNEE_v(SUCX(X),SUCY(Y)) ,coordonnee_v ) ) ) ,ADD2(MUL2(SOUS(COORDONNEE_u(SUCX(X),SUCY(Y)) ,coordonnee_u ) ,SOUS(coordonnee_v ,COORDONNEE_v(NEUT(X),NEUT(Y)) ) ) ,MUL2(SOUS(coordonnee_u ,COORDONNEE_u(NEUT(X),SUCY(Y)) ) ,SOUS(coordonnee_v ,COORDONNEE_v(SUCX(X),NEUT(Y)) ) ) ) ) ) ) ) ,niveaux_cumules ,X_transforme,Y_transforme ); /* Et cumul des niveaux en collision au point (X_transforme,Y_transforme). */ Eblock ATes Bblock Eblock ETes Eblock EDoI Eblock EDoI Eblock ATes Bblock Eblock ETes Eblock end_imageQ(EDoI,EDoI) CALS(Inoir(imageR_trouee)); /* Nettoyage de l'image Resultat partiel (c'est-a-dire eventuellement "mitee"). */ EGAL(coin_gauche,Xmax); EGAL(coin_droite,Xmin); EGAL(coin_bass,Ymax); EGAL(coin_haut,Ymin); /* Initialisation de la recherche du cadre de la transformee de 'imageA'. */ begin_image Bblock Test(IFNE(loadI_point(nombre_de_collisions,X,Y),POINT_NON_ATTEINT)) Bblock store_point(DIVI(loadI_point(niveaux_cumules,X,Y) ,loadI_point(nombre_de_collisions,X,Y) ) ,imageR_trouee ,X,Y ,FVARIABLE ); /* Creation d'une image Resultat eventuellement "mitee" en prenant en compte */ /* une moyenne des points qui collisionnent. */ EGAL(coin_gauche,MIN2(coin_gauche,X)); EGAL(coin_droite,MAX2(coin_droite,X)); EGAL(coin_bass,MIN2(coin_bass,Y)); EGAL(coin_haut,MAX2(coin_haut,Y)); /* Recherche du cadre de la transformee de 'imageA'. */ Eblock ATes Bblock Eblock ETes Eblock end_image Test(IL_FAUT(boucher_les_trous)) Bblock begin_imageQ(DoIn,coin_bass,coin_haut,pasY,DoIn,coin_gauche,coin_droite,pasX) Bblock /* Tentative de recuperation des trous : */ /* */ /* */ /* ------------------C */ /* | | */ /* | B------------ | */ /* | | | | */ /* | | ------ | | */ /* | | | | | | */ /* | | | M-- | | */ /* | | | | | */ /* | | ---------A | */ /* | | | */ /* | --------------- */ /* | */ /* D--------------------- */ /* */ /* */ /* pour cela, on centre autour du point courant */ /* M(X,Y) une spirale carree, et l'on cherche dessus */ /* des points marques lors de la passe precedente, */ /* c'est-a-dire des points atteints, tels (A,B,C,D,...), */ /* qui forment un polygone entourant le point M(X,Y) ; */ /* on utilise alors les niveaux ponderes par les inverses */ /* 'd' des distances des points 'A', 'B',.. a 'M' pour */ /* calculer le niveau n(M) : */ /* */ /* d(A,M).n(A) + d(B,M).n(B) + ... */ /* n(M)=------------------------------- */ /* d(A,M) + d(B,M) + ... */ /* */ /* Enfin, pour des raisons de symetrie, on essaiera */ /* de prendre en compte un nombre pair de points sur */ /* chaque spirale. */ SPIRALE_VALIDATION; /* Validation des pas de parcours (pasX,pasY) des images. */ Test(IFEQ(loadI_point(nombre_de_collisions,X,Y),POINT_NON_ATTEINT)) Bblock /* Cas des points {X,Y} qui n'ont pas ete atteints (ou du moins presque pas) dans la passe */ /* precedente. ATTENTION, cette facon de faire est relativement mauvaise : prenons le cas */ /* de la rotation d'une image ; il y a naturellement des points non atteints (par exemple */ /* dans les coins de l'image Resultat), or ceux-ci vont etre ici testes. En particulier */ /* cela pourra ajouter un lisere au bord de l'image Argument tournee ; par exemple dans le */ /* cas de 'v $xiio/MIRE' qui contient une bande NOIR a gauche, cela donnera cette bande NOIR */ /* tournee, et malheureusement a la gauche de cette derniere, une ou plusieurs bandes non */ /* NOIR : */ /* */ /* '$xiio/MIRE' avant toute rotation : */ /* */ /* 0 1 2 3 4 5 6 7 */ /* 0 1 2 3 4 5 6 7 */ /* 0 1 2 3 4 5 6 7 */ /* 0 1 2 3 4 5 6 7 */ /* 0 1 2 3 4 5 6 7 */ /* 0 1 2 3 4 5 6 7 */ /* 0 1 2 3 4 5 6 7 */ /* 0 1 2 3 4 5 6 7 */ /* */ /* */ /* et apres rotation de pi/4 : */ /* */ /* 6 . . */ /* 3 4 5 6 7 6 . */ /* 2 3 4 5 6 7 6 */ /* 1 2 3 4 5 6 7 */ /* 0 1 2 3 4 5 6 7 */ /* 0 1 2 3 4 5 6 */ /* 1 0 1 2 3 4 5 */ /* . 1 0 1 2 3 4 */ /* . . 1 0 1 2 3 */ /* . . . 1 */ /* */ /* d'ou l'apparition de bandes en bas a gauche ("1") et en haut a droite ("6") ; et avec */ /* une palette telle '$xiP/cercle.32', la bande en bas a gauche est visuellement tres */ /* apparente... */ INITIALISATION_POINT_2D(point_courant,X,Y); /* Initialisation du point courant sur la spirale. */ EGAL(arret_obligatoire,FAUX); /* Pour eviter les grands bouclages sur la spirale, */ CLIR(nombre_de_points); /* Pour cela, on va compter les nombres de points de la spirale qui sont dans */ /* l'image... */ SPIRALE_REINITIALISATION_BRAS_ET_DELTAS; /* Reinitialisation de la spirale en son centre, sans reinitialiser la direction */ /* et le sens du bras courant. Puis, */ /* reinitialisation de (spirale_delta_horizontal,spirale_delta_vertical) qui */ /* donne la direction et le sens du bras courant de la spirale. */ EGAL(abscisse_minimale,Xmax); EGAL(abscisse_maximale,Xmin); EGAL(ordonnee_minimale,Ymax); EGAL(ordonnee_maximale,Ymin); /* Initialisation de la recherche du plus petit polygone fait de points */ /* marques (lors de la passe precedente) et entourant le point courant. */ CLIR(nombre_de_cumuls); CLIR(cumul_des_distances); CLIR(cumul_des_niveaux); /* Initialisation des cumuls des distances et des niveaux ponderes aux */ /* sommet du polygone recherche. */ Tant(IL_NE_FAUT_PAS(arret_obligatoire)) Bblock SPIRALE_DEPLACEMENT(ASD1(point_courant,x),ASD1(point_courant,y)); /* Deplacement du point courant de la spirale... */ Test(TEST_DANS_L_IMAGE(ASD1(point_courant,x),ASD1(point_courant,y))) Bblock Test(IFGT(loadI_point(nombre_de_collisions,ASD1(point_courant,x),ASD1(point_courant,y)) ,POINT_NON_ATTEINT ) ) Bblock INCR(nombre_de_cumuls,I); /* On calcule le nombre de points que l'on a cumule... */ EGAL(abscisse_minimale,MIN2(abscisse_minimale,ASD1(point_courant,x))); EGAL(abscisse_maximale,MAX2(abscisse_maximale,ASD1(point_courant,x))); EGAL(ordonnee_minimale,MIN2(ordonnee_minimale,ASD1(point_courant,y))); EGAL(ordonnee_maximale,MAX2(ordonnee_maximale,ASD1(point_courant,y))); /* La recherche du cadre ne se fait que sur les points qui ont ete atteints. */ EGAL(distance_courante ,COND(IL_NE_FAUT_PAS(pondererer_par_les_distances) ,FU ,DIVI(INVERSION_DES_DISTANCES ,ADD2(PRED(INVERSION_DES_DISTANCES) ,RACX(FLOT(disI2D(ASD1(point_courant,x),ASD1(point_courant,y) ,X,Y ) ) ) ) ) ) ); /* On calcule la distance du point courant de la spirale au centre */ /* de celle-ci {X,Y}. Puis on l'"inverse" en quelque sorte, afin */ /* de rendre preponderants les points les plus proches ; on notera */ /* qu'elle ne peut etre nulle puisque l'on ne part pas du centre de */ /* la spirale. Cette prise en compte de la distance n'est faite que */ /* si cela est demande... */ INCR(cumul_des_distances,distance_courante); /* Et on la cumule. */ INCR(cumul_des_niveaux ,MUL2(distance_courante ,FLOT(NIVR(load_point(imageR_trouee,ASD1(point_courant,x),ASD1(point_courant,y)))) ) ); /* Enfin on calcule le cumul des niveaux ponderes des points deja atteints */ /* par leur distance au centre de la spirale. */ Eblock ATes Bblock Eblock ETes Eblock ATes Bblock Eblock ETes INCR(nombre_de_points,I); /* Et on calcule le nombre de points que l'on a traite (quel que soit leur etat). */ Test(IFOU(IFGT(nombre_de_points,NOMBRE_DE_POINTS_MAXIMAL) ,IFET(IFET(IFLT(abscisse_minimale,X),IFGT(abscisse_maximale,X)) ,IFET(IFLT(ordonnee_minimale,Y),IFGT(ordonnee_maximale,Y)) ) ) ) Bblock Test(IFOU(IFGT(nombre_de_points,NOMBRE_DE_POINTS_MAXIMAL) ,IFET(IFGT(ASD1(point_courant,x),X),IFEQ(ASD1(point_courant,y),Y)) ) ) Bblock EGAL(arret_obligatoire,VRAI); /* Lorsqu'on a traite trop de points on force l'arret, meme si la condition */ /* sur l'encadrement des coordonnees courantes {X,Y} par un quadrilatere */ /* defini par : */ /* */ /* ((abscisse_minimale,abscisse_maximale),(ordonnee_minimale,ordonnee_maximale)) */ /* */ /* n'est pas satisfaite ; de plus cet arret n'est demande que lorsque l'on a */ /* fait un nombre entier de tours (si possible...), ce que l'on teste en regardant par */ /* exemple si l'on est a l'horizontale du point de depart : */ /* ----------- */ /* | */ /* | */ /* ------------------ */ /* | */ /* | */ /* \|/ */ /* . */ /* */ /* IFGT(ASD1(point_courant,x),X),IFEQ(ASD1(point_courant,y),Y) */ /* */ /* . */ /* /|\ */ /* | */ /* | */ /* ------ */ /* et strictement a droite de celui-ci... */ /* */ Eblock ATes Bblock Eblock ETes Eblock ATes Bblock Eblock ETes SPIRALE_INITIALISATION; /* Initialisation dynamique de 'spirale_nombre_de_points_a_traiter'. */ SPIRALE_PARCOURS; /* Parcours de la spirale avec rotation eventuelle de PI/2 du bras courant... */ Eblock ETan EGAL(nouveau_niveau ,COND(IZEQ(cumul_des_distances) ,NIVEAU_NON_ATTEINT ,GENP(NIVA(ARRI(DIVI(cumul_des_niveaux,cumul_des_distances)))) ) ); /* Pour les points qui n'ont pas ete atteints dans la passe directe, */ /* on calcule une valeur moyenne a partir d'une valeur ponderee */ /* sur un polygone entourant le point en cause {X,Y} ; la ponderation */ /* est en fait la distance du point {X,Y} aux sommets du polygone. */ Eblock ATes Bblock EGAL(nouveau_niveau ,load_point(imageR_trouee,X,Y) ); /* Pour les points qui ont ete atteints, on transfere simplement le */ /* niveau calcule. */ Eblock ETes store_point(nouveau_niveau,imageR,X,Y,FVARIABLE); Eblock end_imageQ(EDoI,EDoI) Eblock ATes Bblock iMOVE(imageR,imageR_trouee); /* On renvoie "betement" l'image mitee (voir les commentaires relatifs a la procedure */ /* 'iMOVE(...)' dans 'v $xiii/di_image$DEF')... */ Eblock ETes Eblock ETes EDEFV(image,imageR_trouee); /* Image intermediaire contenant une version eventuellement "mitee" de 'imageR'. */ EDEFV(imageI,niveaux_cumules); /* Donne la somme des niveaux des points de 'imageA' tombant en le meme */ /* point de 'imageR'. */ EDEFV(imageI,nombre_de_collisions); /* Afin de compter les "collisions" : en effet, plusieurs points de 'imageA' */ /* peuvent "tomber" sur le meme point de 'imageR' par la transformation */ /* argument (Fx,Fy). */ RETI(imageR); Eblock #undef INVERSION_DES_DISTANCES #undef NIVEAU_NON_ATTEINT #undef NOMBRE_DE_POINTS_MAXIMAL #undef POINT_NON_ATTEINT EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* T R A N S F O R M A T I O N B I - D I M E N S I O N N E L L E I N V E R S E : */ /* Q U E L C O N Q U E D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ BFonctionP /* ATTENTION : la mise de la fonction 'Imove(...)' dans le bloc '$a' des deux fonctions */ /* 'Itransformation_image(...)' et 'Itransformation_inverse_image(...)' (ces deux dernieres */ /* utilisant la premiere) provoquerait une augmentation importante de la taille des fichiers */ /* de type '$X' lorsque ceux-ci utilisent la fonction 'Imove(...)', ce qui est en fait tres */ /* frequent (voir '$xci/acces$X')... */ DEFV(Common,DEFV(FonctionP,POINTERp(Itransformation_inverse_image(imageR ,imageA ,ARGUMENT_POINTERs(translation) ,nettoyer ,ARGUMENT_FONCTION(Fx),ARGUMENT_FONCTION(Fy) ,Umin,Umax ,Vmin,Vmax ) ) ) ) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, dans laquelle on genere la transformation de l'image Argument. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument a transformer. */ DEFV(Argument,DEFV(deltaF_2D,POINTERs(translation))); /* Translation horizontale ('dx') et verticale ('dy') de l'image argument ; on */ /* n'oubliera pas que cette translation est exprimee dans des unites telles */ /* l'unite soit respectivement [Xmin,Xmax] et [Ymin,Ymax]. */ DEFV(Argument,DEFV(Logical,nettoyer)); /* Indicateur demandant ('VRAI') ou pas ('FAUX') la mise a noir */ /* de l'image 'imageR'. */ DEFV(Argument,DEFV(Float,afPOINTEUR(Fx))); /* Definition de la fonction 'Fx(u,v)', */ DEFV(Argument,DEFV(Float,afPOINTEUR(Fy))); /* Definition de la fonction 'Fy(u,v)'. */ DEFV(Argument,DEFV(Float,Umin)); /* Valeur inferieure de la coordonnee 'u', */ DEFV(Argument,DEFV(Float,Umax)); /* Valeur superieure de la coordonnee 'u'. */ DEFV(Argument,DEFV(Float,Vmin)); /* Valeur inferieure de la coordonnee 'v', */ DEFV(Argument,DEFV(Float,Vmax)); /* Valeur superieure de la coordonnee 'v'. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ Test(IFOU(IFLE(Umax,Umin) ,IFLE(Vmax,Vmin) ) ) Bblock /* La deuxieme partie du test est rendue necessaire par le texturage, */ /* en effet, [Umin,Umax]*[Vmin,Vmax] doit alors etre en bijection */ /* avec [Xmin,Xmax]*[Ymin,Ymax] du champ de texture. */ PRINT_ERREUR("l'ordre des bornes inferieures et/ou superieures des coordonnees (u,v) est mauvais"); CAL1(Prer2("(Umin,Umax) = (%g,%g)\n",Umin,Umax)); CAL1(Prer2("(Vmin,Vmax) = (%g,%g)\n",Vmin,Vmax)); Eblock ATes Bblock Test(IL_FAUT(nettoyer)) Bblock CALS(Inoir(imageR)); /* Nettoyage de l'image resultat. */ Eblock ATes Bblock Eblock ETes begin_image Bblock store_point(load_point_valide(imageA ,_cDENORMALISE_OX(I_TRANSFORMATION_OX(X,Y)) ,_cDENORMALISE_OY(I_TRANSFORMATION_OY(X,Y)) ) ,imageR ,X,Y ,FVARIABLE ); /* Transformation inverse de l'image ne creant donc pas de trous... */ Eblock end_image Eblock ETes RETI(imageR); Eblock EFonctionP #undef I_TRANSFORMATION_OY #undef I_TRANSFORMATION_OX #undef F_TRANSFORMATION_OY #undef F_TRANSFORMATION_OX #undef COORDONNEE_v #undef COORDONNEE_u _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* T R A N S F O R M A T I O N A F F I N E D E S C O O R D O N N E S D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(Logical,SINT(Itransformation_affine_des_coordonnees_____interpolation_cubique,VRAI))); /* Choix de la methode d'interpolation introduit le 20131230124640... */ DEFV(Common,DEFV(FonctionP,POINTERp(Itransformation_affine_des_coordonnees(imageR ,ARGUMENT_POINTERs(matrice_de_rotation_scaling_skew) ,ARGUMENT_POINTERs(vecteur_de_translation_de_imageR) ,imageA ,ARGUMENT_POINTERs(vecteur_de_translation_de_imageA) ,faire_la_transformation_inverse ,interpoler ) ) ) ) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[Tx(X,Y)][Ty(X,Y)]. */ DEFV(Argument,DEFV(matrixF_2D,POINTERs(matrice_de_rotation_scaling_skew))); /* Definition de la matrice precisant la rotation et les deformations des coordonnees. */ DEFV(Argument,DEFV(deltaF_2D,POINTERs(vecteur_de_translation_de_imageR))); /* Definition du vecteur de translation des coordonnees dans l'espace de 'imageR'. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(deltaF_2D,POINTERs(vecteur_de_translation_de_imageA))); /* Definition du vecteur de translation des coordonnees dans l'espace de 'imageA'. */ DEFV(Argument,DEFV(Logical,faire_la_transformation_inverse)); /* Indicateur precisant s'il faut faire la transformation "directe" ('FAUX') ou bien la */ /* transformation "inverse" ('VRAI'). */ DEFV(Argument,DEFV(Logical,interpoler)); /* Indicateur precisant s'il faut interpoler ('VRAI') ou pas ('FAUX'), mais uniquement */ /* lorsque la transformation inverse est demandee... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ Test(IL_NE_FAUT_PAS(faire_la_transformation_inverse)) Bblock /* Cas ou la transformation "directe" est demandee : */ begin_image Bblock store_point_valide(load_point(imageA,X,Y) ,imageR ,COXA(LIN2(ASI2(matrice_de_rotation_scaling_skew,cx,cx) ,COXR(SOUS(X,_lDENORMALISE_OX(ASI1(vecteur_de_translation_de_imageA,dx)))) ,ASI2(matrice_de_rotation_scaling_skew,cx,cy) ,COYR(SOUS(Y,_lDENORMALISE_OY(ASI1(vecteur_de_translation_de_imageA,dy)))) ,_lDENORMALISE_OX(ASI1(vecteur_de_translation_de_imageR,dx)) ) ) ,COYA(LIN2(ASI2(matrice_de_rotation_scaling_skew,cy,cx) ,COXR(SOUS(X,_lDENORMALISE_OX(ASI1(vecteur_de_translation_de_imageA,dx)))) ,ASI2(matrice_de_rotation_scaling_skew,cy,cy) ,COYR(SOUS(Y,_lDENORMALISE_OY(ASI1(vecteur_de_translation_de_imageA,dy)))) ,_lDENORMALISE_OY(ASI1(vecteur_de_translation_de_imageR,dy)) ) ) ,FVARIABLE ); Eblock end_image Eblock ATes Bblock /* Cas ou la transformation "inverse" est demandee : */ DEFV(Float,INIT(determinant_de_la_matrice ,DET2(ASI2(matrice_de_rotation_scaling_skew,cx,cx) ,ASI2(matrice_de_rotation_scaling_skew,cx,cy) ,ASI2(matrice_de_rotation_scaling_skew,cy,cx) ,ASI2(matrice_de_rotation_scaling_skew,cy,cy) ) ) ); /* Determinant de la matrice de la transformation affine. */ Test(IZNE(determinant_de_la_matrice)) Bblock BDEFV(imageF,imageA_flottante); /* Image flottante Argument que l'on cherche a faire tourner. */ DEFV(matrixF_2D,matrice_inverse_de_rotation_scaling_skew); INITIALISATION_MATRICE_2D(matrice_inverse_de_rotation_scaling_skew ,DIVI(NEUT(ASI2(matrice_de_rotation_scaling_skew,cy,cy)) ,determinant_de_la_matrice ) ,DIVI(NEGA(ASI2(matrice_de_rotation_scaling_skew,cx,cy)) ,determinant_de_la_matrice ) ,DIVI(NEGA(ASI2(matrice_de_rotation_scaling_skew,cy,cx)) ,determinant_de_la_matrice ) ,DIVI(NEUT(ASI2(matrice_de_rotation_scaling_skew,cx,cx)) ,determinant_de_la_matrice ) ); /* Calcul de la matrice inverse de la transformation affine. */ CALS(Istd_float(imageA_flottante,FLOT__NOIR,FLOT__BLANC,imageA)); /* Conversion de l'image Argument en flottant (afin de pouvoir utiliser la fabuleuse */ /* macro-procedure 'loadF_point_continu'). */ begin_image Bblock DEFV(Float,INIT(Xf ,COXA(LIN2(ASD2(matrice_inverse_de_rotation_scaling_skew,cx,cx) ,COXR(SOUS(X,_lDENORMALISE_OX(ASI1(vecteur_de_translation_de_imageR,dx)))) ,ASD2(matrice_inverse_de_rotation_scaling_skew,cx,cy) ,COYR(SOUS(Y,_lDENORMALISE_OY(ASI1(vecteur_de_translation_de_imageR,dy)))) ,_lDENORMALISE_OX(ASI1(vecteur_de_translation_de_imageA,dx)) ) ) ) ); DEFV(Float,INIT(Yf ,COYA(LIN2(ASD2(matrice_inverse_de_rotation_scaling_skew,cy,cx) ,COXR(SOUS(X,_lDENORMALISE_OX(ASI1(vecteur_de_translation_de_imageR,dx)))) ,ASD2(matrice_inverse_de_rotation_scaling_skew,cy,cy) ,COYR(SOUS(Y,_lDENORMALISE_OY(ASI1(vecteur_de_translation_de_imageR,dy)))) ,_lDENORMALISE_OY(ASI1(vecteur_de_translation_de_imageA,dy)) ) ) ) ); /* Coordonnees flottantes 'X' et 'Y' courantes... */ DEFV(genere_Float,INIT(niveau_courant,FLOT__NIVEAU_UNDEF)); /* Donne le niveau flottant courant apres l'eventuel interpolation... */ Test(IL_NE_FAUT_PAS(interpoler)) Bblock EGAL(niveau_courant,loadF_point_valide(imageA_flottante,INTX(Xf),INTY(Yf))); /* Il n'y a pas interpolation, le niveau est recupere "betement"... */ Eblock ATes Bblock loadF_point_continu(niveau_courant ,imageA_flottante ,Xf,Yf ,Itransformation_affine_des_coordonnees_____interpolation_cubique ); /* Il faut interpoler, et la c'est beaucoup moins simple... */ Eblock ETes store_point(GENP(TRNF(niveau_courant)),imageR,X,Y,FVARIABLE); /* Il est necessaire de ramener brutalement le niveau interpole dans [NOIR,BLANC], car en */ /* effet, vue la forme de la courbe d'interpolation (elle n'est pas monotone), il est */ /* possible d'obtenir des niveaux inferieurs au "vrai" 'NOIR' obtenu par interpolation */ /* a l'interieure d'une zone toute noire, et par exemple une zone hors-image ; donc sans */ /* ce 'TRNF', des points hors 'imageA' pourraient avoir dans 'imageR' un niveau superieur */ /* aux points dans 'imageA' (et plus particulierement ceux du bord)... */ Eblock end_image EDEFV(imageF,imageA_flottante); /* Image flottante Argument que l'on cherche a faire tourner. */ Eblock ATes Bblock PRINT_ERREUR("le determinant de la matrice de la transformation affine est nul"); /* On laisse 'imageR' inchangee... */ Eblock ETes Eblock ETes RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E P L A C E M E N T D ' U N E I M A G E A V E C " R O T A T I O N " D E S N I V E A U X : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Imove_avec_rotation_des_niveaux(imageR,imageA,increment_des_niveaux,translater_le_NOIR)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=ROTATION_NIVEAU(imageA[X][Y]). */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Int,increment_des_niveaux)); /* Increment du niveau courant dans [NOIR,BLANC] afin de pouvoir simuler un decalage de */ /* palette (voir 'IXpalette(...)' dans '$xiidX'). */ DEFV(Argument,DEFV(Logical,translater_le_NOIR)); /* Indique si le niveau 'NOIR' est translatable ('LE_NOIR_EST_TRANSLATABLE') ou pas */ /* ('LE_NOIR_N_EST_PAS_TRANSLATABLE')... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock store_point(ROTATION_NIVEAU(load_point(imageA,X,Y),increment_des_niveaux,translater_le_NOIR) ,imageR ,X,Y ,FVARIABLE ); Eblock end_image RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E P L A C E M E N T D ' U N E I M A G E A V E C M A S Q U A G E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(ImoveM(imageR,imageA)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] pour les points */ /* {X,Y} non masques. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ traite_image_BH_GD(BLOC(store_point(load_point(imageA,X,Y),imageR,X,Y,FVARIABLE);)); RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E P L A C E M E N T D ' U N E I M A G E P L A N E */ /* A V E C M A S Q U A G E E T G E S T I O N D U ' Z - B U F F E R ' : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(ImoveM_3D_plan(imageR,imageA,Zf)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] pour les points {X,Y} non masques */ /* qui ne sont pas caches par d'autres points plus pres de l'observateur (voir la gestion */ /* du 'Z-Buffer'). */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Float,Zf)); /* Troisieme coordonnee dans [0,1] a attribuer aux points non masques du plan forme par */ /* les points de 'imageA'. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ traite_image_BH_GD(BLOC(store_point_3D(load_point(imageA,X,Y),imageR,X,Y,Zf);)); RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E P L A C E M E N T D ' U N E I M A G E T R I D I M E N S I O N N E L L E */ /* A V E C M A S Q U A G E E T G E S T I O N D U ' Z - B U F F E R ' : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(ImoveM_3D_volume(imageR,imageA,Z_BufferA)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] pour les points {X,Y} non masques */ /* qui ne sont pas caches par d'autres points plus pres de l'observateur (voir la gestion */ /* du 'Z-Buffer'). */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument, */ DEFV(Argument,DEFV(imageF,Z_BufferA)); /* Et son 'Z-Buffer'. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ traite_image_BH_GD(BLOC(store_point_3D(load_point(imageA,X,Y),imageR,X,Y,loadF_point(Z_BufferA,X,Y));)); RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E P L A C E M E N T D ' U N B L O C D E P O I N T S : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Imove_points(imageR,ARGUMENT_POINTERs(pointR),toreR_horizontal,toreR_vertical ,imageA,ARGUMENT_POINTERs(pointA),toreA_horizontal,toreA_vertical ,ARGUMENT_POINTERs(dimensions) ) ) ) ) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] pour le bloc de point */ /* nomme 'pointA' et 'pointR' respectivement ; il est defini par le sommet */ /* en bas a gauche et par ses dimensions ; on notera, que l'image Resultat */ /* n'est pas nettoyee... */ DEFV(Argument,DEFV(pointF_2D,POINTERs(pointR))); /* Donne le coin "bas-gauche" dans l'image Resultat ; ces donnees sont normalisees */ /* telle que l'unite represente la taille de l'image. */ DEFV(Argument,DEFV(Logical,toreR_horizontal)); /* La direction horizontale ('X') est-elle repliee sur elle-meme ('VRAI') */ /* ou non ('FAUX') sur l'image Resultat. */ DEFV(Argument,DEFV(Logical,toreR_vertical)); /* La direction verticale ('X') est-elle repliee sur elle-meme ('VRAI') */ /* ou non ('FAUX') sur l'image Resultat. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(pointF_2D,POINTERs(pointA))); /* Donne le coin "bas-gauche" dans l'image Argument ; ces donnees sont normalisees */ /* telles que l'unite represente la taille de l'image. */ DEFV(Argument,DEFV(Logical,toreA_horizontal)); /* La direction horizontale ('X') est-elle repliee sur elle-meme ('VRAI') */ /* ou non ('FAUX') sur l'image Argument. */ DEFV(Argument,DEFV(Logical,toreA_vertical)); /* La direction verticale ('X') est-elle repliee sur elle-meme ('VRAI') */ /* ou non ('FAUX') sur l'image Argument. */ DEFV(Argument,DEFV(deltaF_2D,POINTERs(dimensions))); /* Dimensions horizontale et verticale du bloc de points ; ces donnees sont */ /* normalisee telles que l'unite represente la taille de l'image. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Int,INIT(XA,UNDEF)); /* Abscisse du bloc Argument, */ DEFV(Int,INIT(YA,UNDEF)); /* Ordonnee du bloc Argument. */ DEFV(Int,INIT(XR,UNDEF)); /* Abscisse du bloc Resultat, */ DEFV(Int,INIT(YR,UNDEF)); /* Ordonnee du bloc Resultat. */ DEFV(Int,INIT(new_XA,UNDEF)); /* Abscisse du bloc Argument apres application du toreA-horizontal, */ DEFV(Int,INIT(new_YA,UNDEF)); /* Ordonnee du bloc Argument apres application du toreA-vertical. */ DEFV(Int,INIT(new_XR,UNDEF)); /* Abscisse du bloc Resultat apres application du toreR-horizontal, */ DEFV(Int,INIT(new_YR,UNDEF)); /* Ordonnee du bloc Resultat apres application du toreR-vertical. */ /*..............................................................................................................................*/ EGAL(YR,_cDENORMALISE_OY(ASI1(pointR,y))); /* Initialisation de l'ordonnee Resultat. */ DoIn(YA,_cDENORMALISE_OY(ASI1(pointA,y)),LSTX(_cDENORMALISE_OY(ASI1(pointA,y)),_lDENORMALISE_OY(ASI1(dimensions,dy))),pasY) Bblock EGAL(XR,_cDENORMALISE_OX(ASI1(pointR,x))); /* Initialisation de l'abscisse Resultat. */ DoIn(XA,_cDENORMALISE_OX(ASI1(pointA,x)),LSTX(_cDENORMALISE_OX(ASI1(pointA,x)),_lDENORMALISE_OX(ASI1(dimensions,dx))),pasX) Bblock Test(IL_NE_FAUT_PAS(toreA_horizontal)) Bblock EGAL(new_XA,XA); /* Lorsqu'il n'y a pas de "tore", les coordonnees sont inchangees. */ Eblock ATes Bblock EGAL(new_XA,MODX(XA)); /* Lorsqu'il y a un "tore", les coordonnees sont repliees. */ Eblock ETes Test(IL_NE_FAUT_PAS(toreA_vertical)) Bblock EGAL(new_YA,YA); /* Lorsqu'il n'y a pas de "tore", les coordonnees sont inchangees. */ Eblock ATes Bblock EGAL(new_YA,MODY(YA)); /* Lorsqu'il y a un "tore", les coordonnees sont repliees. */ Eblock ETes Test(IL_NE_FAUT_PAS(toreR_horizontal)) Bblock EGAL(new_XR,XR); /* Lorsqu'il n'y a pas de "tore", les coordonnees sont inchangees. */ Eblock ATes Bblock EGAL(new_XR,MODX(XR)); /* Lorsqu'il y a un "tore", les coordonnees sont repliees. */ Eblock ETes Test(IL_NE_FAUT_PAS(toreR_vertical)) Bblock EGAL(new_YR,YR); /* Lorsqu'il n'y a pas de "tore", les coordonnees sont inchangees. */ Eblock ATes Bblock EGAL(new_YR,MODY(YR)); /* Lorsqu'il y a un "tore", les coordonnees sont repliees. */ Eblock ETes store_point_valide(load_point_valide(imageA,new_XA,new_YA),imageR,new_XR,new_YR,FVARIABLE); /* Deplacement du point (XA,YA) vers le point (XR,YR), suivant les eventuels */ /* tores actifs. */ INCR(XR,pasX); /* Changement d'abscisse Resultat. */ Eblock EDoI INCR(YR,pasY); /* Changement d'ordonnee Resultat. */ Eblock EDoI RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E P L A C E M E N T D ' U N B L O C D E P O I N T S A V E C R E P L I E M E N T : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(Logical,SINT(Imove_points_avec_repliement_____utiliser_le_maximum,VRAI))); /* Indique si le "repliement" doit avoir lieu en utilisant un 'MAX2(...)' ('VRAI') ou bien */ /* 'PRODUIT_MASQUE_ANTI_ALIASE(...)' ('FAUX'). Ceci fut introduit le 20090226171503... */ /* */ /* On notera le 20090226175753, grace a 'v $xiirv/STRU.bas.G1', que c'est l'utilisation */ /* de 'MAX2(...)' qui donne les meilleurs resultats. */ DEFV(Common,DEFV(FonctionP,POINTERp(Imove_points_avec_repliement(imageR,XminR,XmaxR,YminR,YmaxR,imageA,XminA,XmaxA,YminA,YmaxA)))) /* Fonction introduite le 20090226123401... */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] repliee dans un bloc rectangulaire. */ DEFV(Argument,DEFV(Int,XminR)); DEFV(Argument,DEFV(Int,XmaxR)); DEFV(Argument,DEFV(Int,YminR)); DEFV(Argument,DEFV(Int,YmaxR)); /* Dimensions de l'image Resultat. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Int,XminA)); DEFV(Argument,DEFV(Int,XmaxA)); DEFV(Argument,DEFV(Int,YminA)); DEFV(Argument,DEFV(Int,YmaxA)); /* Dimensions de l'image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_imageQ(DoIn ,YminA,YmaxA,pasY ,DoIn ,XminA,XmaxA,pasX ) Bblock DEFV(Int,INIT(X_replie,MODU(X,XminR,XmaxR))); DEFV(Int,INIT(Y_replie,MODU(Y,YminR,YmaxR))); /* Coordonnees repliees a l'interieur du bloc rectangulaire... */ DEFV(genere_p,INIT(niveau_courant_de_imageA,NIVEAU_UNDEF)); DEFV(genere_p,INIT(niveau_courant_de_imageR,NIVEAU_UNDEF)); EGAL(niveau_courant_de_imageA,load_point_valide(imageA,X,Y)); EGAL(niveau_courant_de_imageR,load_point_valide(imageR,X_replie,Y_replie)); /* Niveaux courants... */ store_point_valide(COND(IL_FAUT(Imove_points_avec_repliement_____utiliser_le_maximum) ,MAX2(niveau_courant_de_imageA,niveau_courant_de_imageR) ,PRODUIT_MASQUE_ANTI_ALIASE(niveau_courant_de_imageA,niveau_courant_de_imageR) ) ,imageR ,X_replie,Y_replie ,FVARIABLE ); Eblock end_imageQ(EDoI,EDoI) RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* I N T R O D U C T I O N D ' U N E D I S C O N T I N U I T E D A N S U N C H A M P : */ /* */ /* */ /* Definition : */ /* */ /* Un champ contient des niveaux */ /* N(x,y) designes ci-apres par 'N'. */ /* Les extrema de 'N' seront designes */ /* par 'm' (minimum) et 'M' (maximum). */ /* */ /* */ /* . */ /* N/|\ */ /* | . */ /* | . */ /* | . */ /* M |-----------------------------------------------* */ /* | *+ | */ /* | * + | */ /* | * + | */ /* | * + | */ /* | * + | */ /* C |-----------------------------*-----+ | */ /* | * + | | */ /* | * + | | */ /* B |-----------------------------* | | */ /* | + * | | */ /* | + * | | */ /* A |-----------------------+-----* | | */ /* | + | * | | | */ /* | + * | | | */ /* | + * | | | | */ /* | + * | | | | */ /* | +* | | | | */ /* m |-----------* | | | | */ /* | . | | | | | */ /* | . | | | | | */ /* | . | | | | | */ /* | . | | | | | */ /* | . | | | | | */ /* 0-----------------------------------------------------------> */ /* m A B C M N */ /* */ /* */ /* On a : */ /* */ /* N E [m,M] = [m,B]U[B,M] */ /* */ /* 'B' designant l'emplacement de la discontinuite. */ /* Apres application de la discontinuite, on a : */ /* */ /* N E [m,A]U[C,M] */ /* */ /* On notera que cela pourrait se faire avec */ /* 'IFmove_avec_substitution(...)' mais qu'etant */ /* donne que l'on souhaite que cette discontinuite */ /* soit introduite avec le maximum de precision, il */ /* est preferable d'introduire une fonction specifique... */ /* */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Logical,SINT(IFmove_avec_introduction_d_une_discontinuite_____forcer_les_extrema,FAUX))); /* Indique si les niveaux {m,M} doivent etre forces ('VRAI') ou calcules a priori ('FAUX'). */ DEFV(Common,DEFV(genere_Float,SINT(IFmove_avec_introduction_d_une_discontinuite_____m_niveau_minimal ,COORDONNEE_BARYCENTRIQUE_MINIMALE ) ) ); DEFV(Common,DEFV(genere_Float,SINT(IFmove_avec_introduction_d_une_discontinuite_____M_niveau_maximal ,COORDONNEE_BARYCENTRIQUE_MAXIMALE ) ) ); /* Niveaux extrema {m,M} s'ils doivent etre forces... */ DEFV(Common,DEFV(Logical,SINT(IFmove_avec_introduction_d_une_discontinuite_____le_test_est_strict,VRAI))); /* Afin de savoir si l'on doit faire 'IFLT(N,B)' ('VRAI') ou 'IFLE(N,B)' ('FAUX'). */ DEFV(Common,DEFV(FonctionF,POINTERF(IFmove_avec_introduction_d_une_discontinuite(imageR ,imageA ,A_niveau_maximal_intermediaire ,B_niveau_de_discontinuite ,C_niveau_minimal_intermediaire ) ) ) ) /* Fonction introduite le 20110425083628. */ DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=discontinuite(imageA[X][Y]). */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(genere_Float,A_niveau_maximal_intermediaire)); DEFV(Argument,DEFV(genere_Float,B_niveau_de_discontinuite)); DEFV(Argument,DEFV(genere_Float,C_niveau_minimal_intermediaire)); /* Definition des niveaux {A,B,C}. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(genere_Float,INIT(m_niveau_minimal,IFmove_avec_introduction_d_une_discontinuite_____m_niveau_minimal)); DEFV(genere_Float,INIT(M_niveau_maximal,IFmove_avec_introduction_d_une_discontinuite_____M_niveau_maximal)); /* Definition des extrema {m,M} a priori... */ DEFV(Float,INIT(coefficient_A_inferieur,FLOT__UNDEF)); DEFV(Float,INIT(coefficient_B_inferieur,FLOT__UNDEF)); /* Definition de la transformation lineaire "inferieure" (en-dessous de la discontinuite). */ DEFV(Float,INIT(coefficient_A_superieur,FLOT__UNDEF)); DEFV(Float,INIT(coefficient_B_superieur,FLOT__UNDEF)); /* Definition de la transformation lineaire "superieure" (au-dessus de la discontinuite). */ /*..............................................................................................................................*/ Test(IL_NE_FAUT_PAS(IFmove_avec_introduction_d_une_discontinuite_____forcer_les_extrema)) Bblock CALS(IFnivo_extrema(imageA ,ADRESSE(m_niveau_minimal) ,ADRESSE(M_niveau_maximal) ) ); /* Recherche des extrema de 'imageA' lorsqu'ils ne sont pas forces... */ Eblock ATes Bblock Eblock ETes EGAL(coefficient_A_inferieur ,DIVI(SOUS(A_niveau_maximal_intermediaire,m_niveau_minimal) ,SOUS(B_niveau_de_discontinuite,m_niveau_minimal) ) ); EGAL(coefficient_B_inferieur ,SCAL(m_niveau_minimal ,SOUS(B_niveau_de_discontinuite,m_niveau_minimal) ,SOUS(B_niveau_de_discontinuite,A_niveau_maximal_intermediaire) ) ); /* Definition de la transformation lineaire "inferieure" (en-dessous de la discontinuite). */ EGAL(coefficient_A_superieur ,DIVI(SOUS(M_niveau_maximal,C_niveau_minimal_intermediaire) ,SOUS(M_niveau_maximal,B_niveau_de_discontinuite) ) ); EGAL(coefficient_B_superieur ,SCAL(M_niveau_maximal ,SOUS(M_niveau_maximal,B_niveau_de_discontinuite) ,SOUS(C_niveau_minimal_intermediaire,B_niveau_de_discontinuite) ) ); /* Definition de la transformation lineaire "superieure" (au-dessus de la discontinuite). */ begin_image Bblock DEFV(genere_Float,INIT(niveau_avant_discontinuite,loadF_point(imageA,X,Y))); DEFV(genere_Float,INIT(niveau_apres_discontinuite,FLOT__UNDEF)); Test(IFLc(niveau_avant_discontinuite ,B_niveau_de_discontinuite ,IFmove_avec_introduction_d_une_discontinuite_____le_test_est_strict ) ) Bblock EGAL(niveau_apres_discontinuite,AXPB(coefficient_A_inferieur,niveau_avant_discontinuite,coefficient_B_inferieur)); /* Cas ou le niveau est en-dessous de la discontinuite. */ Eblock ATes Bblock EGAL(niveau_apres_discontinuite,AXPB(coefficient_A_superieur,niveau_avant_discontinuite,coefficient_B_superieur)); /* Cas ou le niveau est au-dessus de la discontinuite. */ Eblock ETes storeF_point(niveau_apres_discontinuite,imageR,X,Y); Eblock end_image RETIF(imageR); Eblock EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E C A L A G E C I R C U L A I R E G E N E R A L D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ #define DECALAGE_CIRCULAIRE_GENERAL_D_UNE_IMAGE(operation_de_decalage_circulaire) \ Bblock \ traite_image_BH_GD(BLOC(Bblock \ DEFV(Int,INIT(new_X,X)); \ DEFV(Int,INIT(new_Y,Y)); \ /* Coordonnees temporaires definissant le decalage circulaire. */ \ Test(IL_FAUT(decalage_horizontal)) \ Bblock \ INCR(new_X,_lDENORMALISE_OX(ASI1(translation,dx))); \ /* Cas du decalage circulaire horizontal... */ \ Test(IFEXff(new_X,Xmin,Xmax)) \ Bblock \ EGAL(new_X,MODX(new_X)); \ INCR(new_Y,_lDENORMALISE_OY(ASI1(translation,dy))); \ EGAL(new_Y,MODY(new_Y)); \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ ATes \ Bblock \ INCR(new_Y,_lDENORMALISE_OY(ASI1(translation,dy))); \ /* Cas du decalage circulaire vertical... */ \ Test(IFEXff(new_Y,Ymin,Ymax)) \ Bblock \ EGAL(new_Y,MODY(new_Y)); \ INCR(new_X,_lDENORMALISE_OX(ASI1(translation,dx))); \ EGAL(new_X,MODX(new_X)); \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ ETes \ \ BLOC(operation_de_decalage_circulaire); \ Eblock \ ) \ ); \ Eblock \ /* Definition d'un decalage circulaire quelconque d'une image... */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E C A L A G E C I R C U L A I R E D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Idecalage_circulaire(imageR,imageA,ARGUMENT_POINTERs(translation),decalage_horizontal)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X+trans_x][Y+trans_y] decale */ /* circulairement. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(deltaF_2D,POINTERs(translation))); /* Translation horizontale ('dx') et verticale ('dy') de l'image argument ; on */ /* n'oubliera pas que cette translation est exprimee dans des unites telles */ /* l'unite soit respectivement [Xmin,Xmax] et [Ymin,Ymax]. */ DEFV(Argument,DEFV(Logical,decalage_horizontal)); /* Le decalage circulaire est-il horizontal ('VRAI') ou vertical ('FAUX') ? */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ DECALAGE_CIRCULAIRE_GENERAL_D_UNE_IMAGE(BLOC(store_point_valide(load_point(imageA,X,Y),imageR,new_X,new_Y,FVARIABLE);)); RETI(imageR); Eblock EFonctionP #undef DECALAGE_CIRCULAIRE_GENERAL_D_UNE_IMAGE _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* T R A N S L A T I O N G E N E R A L E D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ #define TRANSLATION_GENERALE_D_UNE_IMAGE(operation_de_translation) \ Bblock \ DEFV(Int,INIT(new_X,UNDEF)); \ /* Nouvelle coordonnee horizontale apres modification, */ \ DEFV(Int,INIT(new_Y,UNDEF)); \ /* Et nouvelle coordonnee verticale... */ \ traite_image_BH_GD(BLOC(Bblock \ EGAL(new_X,ADD2(X,_lDENORMALISE_OX(ASI1(translation,dx)))); \ EGAL(new_Y,ADD2(Y,_lDENORMALISE_OY(ASI1(translation,dy)))); \ \ Test(IL_FAUT(tore_horizontal)) \ Bblock \ EGAL(new_X,MODX(new_X)); \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ Test(IL_FAUT(tore_vertical)) \ Bblock \ EGAL(new_Y,MODY(new_Y)); \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ BLOC(operation_de_translation); \ Eblock \ ) \ ); \ Eblock \ /* Definition d'une tranlation quelconque d'une image... */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* T R A N S L A T I O N D ' U N E I M A G E " S T A N D A R D " : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Itranslation(imageR,imageA,ARGUMENT_POINTERs(translation),tore_horizontal,tore_vertical)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X+trans_x][Y+trans_y]. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(deltaF_2D,POINTERs(translation))); /* Translation horizontale ('dx') et verticale ('dy') de l'image argument ; on */ /* n'oubliera pas que cette translation est exprimee dans des unites telles */ /* l'unite soit respectivement [Xmin,Xmax] et [Ymin,Ymax]. */ DEFV(Argument,DEFV(Logical,tore_horizontal)); /* La direction horizontale ('X') est-elle repliee sur elle-meme ('VRAI') */ /* ou non ('FAUX'). */ DEFV(Argument,DEFV(Logical,tore_vertical)); /* La direction verticale ('X') est-elle repliee sur elle-meme ('VRAI') */ /* ou non ('FAUX'). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ TRANSLATION_GENERALE_D_UNE_IMAGE(BLOC(store_point_valide(load_point(imageA,X,Y),imageR,new_X,new_Y,FVARIABLE);)); RETI(imageR); Eblock EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* T R A N S L A T I O N D ' U N E I M A G E " F L O T T A N T E " : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFtranslation(imageR,imageA,ARGUMENT_POINTERs(translation),tore_horizontal,tore_vertical)))) DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X+trans_x][Y+trans_y]. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(deltaF_2D,POINTERs(translation))); /* Translation horizontale ('dx') et verticale ('dy') de l'image argument ; on */ /* n'oubliera pas que cette translation est exprimee dans des unites telles */ /* l'unite soit respectivement [Xmin,Xmax] et [Ymin,Ymax]. */ DEFV(Argument,DEFV(Logical,tore_horizontal)); /* La direction horizontale ('X') est-elle repliee sur elle-meme ('VRAI') */ /* ou non ('FAUX'). */ DEFV(Argument,DEFV(Logical,tore_vertical)); /* La direction verticale ('X') est-elle repliee sur elle-meme ('VRAI') */ /* ou non ('FAUX'). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ TRANSLATION_GENERALE_D_UNE_IMAGE(BLOC(storeF_point_valide(loadF_point(imageA,X,Y),imageR,new_X,new_Y);)); RETIF(imageR); Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* T R A N S L A T I O N D ' U N E I M A G E " C O M P L E X E " : */ /* */ /*************************************************************************************************************************************/ BFonctionJ DEFV(Common,DEFV(FonctionJ,POINTERJ(IJtranslation(imageR,imageA,ARGUMENT_POINTERs(translation),tore_horizontal,tore_vertical)))) DEFV(Argument,DEFV(imageJ,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X+trans_x][Y+trans_y]. */ DEFV(Argument,DEFV(imageJ,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(deltaF_2D,POINTERs(translation))); /* Translation horizontale ('dx') et verticale ('dy') de l'image argument ; on */ /* n'oubliera pas que cette translation est exprimee dans des unites telles */ /* l'unite soit respectivement [Xmin,Xmax] et [Ymin,Ymax]. */ DEFV(Argument,DEFV(Logical,tore_horizontal)); /* La direction horizontale ('X') est-elle repliee sur elle-meme ('VRAI') */ /* ou non ('FAUX'). */ DEFV(Argument,DEFV(Logical,tore_vertical)); /* La direction verticale ('X') est-elle repliee sur elle-meme ('VRAI') */ /* ou non ('FAUX'). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ TRANSLATION_GENERALE_D_UNE_IMAGE(BLOC(storeJ_point_valide(loadJ_point(imageA,X,Y),imageR,new_X,new_Y);)); RETIJ(imageR); Eblock EFonctionJ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* T R A N S L A T I O N D ' U N E I M A G E " S T A N D A R D " */ /* A V E C G E S T I O N D U ' Z - B U F F E R ' : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Itranslation_3D(imageR,imageA,Zf,ARGUMENT_POINTERs(translation),tore_horizontal,tore_vertical)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X+trans_x][Y+trans_y] pour les points */ /* {X,Y} qui ne sont pas caches par d'autres points plus pres de l'observateur (voir la */ /* gestion du 'Z-Buffer'). */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Float,Zf)); /* Troisieme coordonnee dans [0,1] a attribuer aux points non masques de ce plan. */ DEFV(Argument,DEFV(deltaF_2D,POINTERs(translation))); /* Translation horizontale ('dx') et verticale ('dy') de l'image argument ; on */ /* n'oubliera pas que cette translation est exprimee dans des unites telles */ /* l'unite soit respectivement [Xmin,Xmax] et [Ymin,Ymax]. */ DEFV(Argument,DEFV(Logical,tore_horizontal)); /* La direction horizontale ('X') est-elle repliee sur elle-meme ('VRAI') */ /* ou non ('FAUX'). */ DEFV(Argument,DEFV(Logical,tore_vertical)); /* La direction verticale ('X') est-elle repliee sur elle-meme ('VRAI') */ /* ou non ('FAUX'). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ TRANSLATION_GENERALE_D_UNE_IMAGE(BLOC(store_point_3D(load_point(imageA,X,Y),imageR,new_X,new_Y,Zf);)); RETI(imageR); Eblock EFonctionP #undef TRANSLATION_GENERALE_D_UNE_IMAGE _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* R E M P L A C E M E N T D ' U N N I V E A U P A R T I C U L I E R */ /* P A R U N N I V E A U I N T E R P O L E D A N S U N R E C T A N G L E D O N T */ /* L ' E X T E R I E U R N E C O N T I E N T P A S C E N I V E A U P A R T I C U L I E R : */ /* */ /* */ /* #################%%%%%%%%%%%%%%%%%%%%%%OOOOOOOOOOOOOOOOOOOOOOOoo */ /* ############%%%%%%%%%%%%%%%%%%%%%%%%OOOOOOOOOOOOOOOOOOOOOOOOOooo */ /* ######%%%%%%%%%%%%%%%%%%%%%%%%%%OOOOOOOOOOOOOOOOOOOOOOOOOOOooooo */ /* %%%%%%%%%%%%%%%%%%%%%%%%%%%%OOOOOOOOOOOOOOOOOOOOOOOOOOOOoooooooo */ /* %%%%%%%%%%%%%%%%%%%%%%%OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOoooooooooo */ /* %%%%%%%%%%%%%%%%OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOooooooooooooo */ /* %%%%%%%%OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOooooooooooooooooo */ /* OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOoooooooooooooooooooooo */ /* OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOooooooooooooooooooooooooooooo */ /* OOOOOOOOOOOOOOOOOOOOOOOOOOOooooooooooooooooooooooooooooooooooooo */ /* OOOOOOOOOOOOOOOooooooooooooooooooooooooooooooooooooooooooooooooo */ /* oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo */ /* oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo */ /* oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo */ /* oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo */ /* :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: */ /* :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: */ /* :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: */ /* :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: */ /* ----:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: */ /* --------------------:::::::::::::::::::::::::::::::::::::::::::: */ /* -------------------------------::::::::::::::::::::::::::::::::: */ /* ---------------------------------------::::::::::::::::::::::::: */ /* ..------------------------------------------:::::::::::::::::::: */ /* ...........--------------------------------------::::::::::::::: */ /* ...................----------------------------------::::::::::: */ /* .........................-------------------------------:::::::: */ /* ..............................----------------------------:::::: */ /* ..................................--------------------------:::: */ /* ......................................------------------------:: */ /* .........................................----------------------- */ /* ...........................................-------------------- */ /* */ /* */ /* obtenue par : */ /* */ /* $xci/remplace.01$X A=$xiio/BLANC n=$BLANC nmm=$NOIR nMm=$GRIS_3 nMM=$GRIS_5 nmM=$BLANC */ /* */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Iremplacement_d_un_niveau_par_interpolation(imageR ,imageA ,niveau_a_remplacer ,niveau_minimum_de_X_minimum_de_Y ,niveau_maximum_de_X_minimum_de_Y ,niveau_minimum_de_X_maximum_de_Y ,niveau_maximum_de_X_maximum_de_Y ) ) ) ) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] uniquement en ce qui concerne les */ /* points de niveau 'niveau_a_remplacer' qui sont remplaces par une interpolation faite a */ /* l'interieur d'un rectangle dont l'exterieur ne contient pas 'niveau_a_remplacer'... */ /* Les points possedant un niveau different de 'niveau_a_remplacer' ne sont pas changes */ /* et conservent la valeur qu'ils possedaient dans 'imageR' ; cela permet de faire en */ /* quelque sorte des "accumulations" (voir le programme 'v $xri/escalier.02$K'). */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(genere_p,niveau_a_remplacer)); /* Niveau a remplacer. */ DEFV(Argument,DEFV(genere_p,niveau_minimum_de_X_minimum_de_Y)); DEFV(Argument,DEFV(genere_p,niveau_maximum_de_X_minimum_de_Y)); DEFV(Argument,DEFV(genere_p,niveau_minimum_de_X_maximum_de_Y)); DEFV(Argument,DEFV(genere_p,niveau_maximum_de_X_maximum_de_Y)); /* Niveaux a interpoler au sommet d'un rectangle... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Int,INIT(minimum_de_X,SUCX(Xmax))); DEFV(Int,INIT(minimum_de_Y,SUCY(Ymax))); DEFV(Int,INIT(maximum_de_X,PREX(Xmin))); DEFV(Int,INIT(maximum_de_Y,PREY(Ymin))); /* Definition d'un rectangle dont l'exterieur ne contient pas le niveau */ /* 'niveau_a_remplacer'. */ /*..............................................................................................................................*/ begin_image Bblock Test(IFEQ(load_point(imageA,X,Y),niveau_a_remplacer)) Bblock EGAL(minimum_de_X,MIN2(minimum_de_X,X)); EGAL(minimum_de_Y,MIN2(minimum_de_Y,Y)); EGAL(maximum_de_X,MAX2(maximum_de_X,X)); EGAL(maximum_de_Y,MAX2(maximum_de_Y,Y)); /* Recherche d'un rectangle dont l'exterieur ne contient pas le niveau 'niveau_a_remplacer'. */ /* On notera bien evidemment que ce rectangle n'est pas necessairement le plus petit qui */ /* possede cette caracteristique ; pour cela, un degre de liberte supplementaire serait */ /* necessaire (il faudrait que les cotes puissent ne plus etre horizontaux et verticaux */ /* respectivement). */ Eblock ATes Bblock Eblock ETes Eblock end_image begin_image Bblock Test(IFEQ(load_point(imageA,X,Y),niveau_a_remplacer)) Bblock /* Cas des points qui sont du type 'niveau_a_remplacer' : on va les remplacer par le */ /* resultat d'une interpolation a l'interieur du rectangle calcule precedemment... */ store_point(GENP(NIVA(DIVI(ADD2(ADD2(MUL2(NIVR(niveau_minimum_de_X_minimum_de_Y) ,MUL2(SOUS(maximum_de_X,X),SOUS(maximum_de_Y,Y)) ) ,MUL2(NIVR(niveau_maximum_de_X_minimum_de_Y) ,MUL2(SOUS(X,minimum_de_X),SOUS(maximum_de_Y,Y)) ) ) ,ADD2(MUL2(NIVR(niveau_minimum_de_X_maximum_de_Y) ,MUL2(SOUS(maximum_de_X,X),SOUS(Y,minimum_de_Y)) ) ,MUL2(NIVR(niveau_maximum_de_X_maximum_de_Y) ,MUL2(SOUS(X,minimum_de_X),SOUS(Y,minimum_de_Y)) ) ) ) ,ADD2(ADD2(MUL2(SOUS(maximum_de_X,X),SOUS(maximum_de_Y,Y)) ,MUL2(SOUS(X,minimum_de_X),SOUS(maximum_de_Y,Y)) ) ,ADD2(MUL2(SOUS(maximum_de_X,X),SOUS(Y,minimum_de_Y)) ,MUL2(SOUS(X,minimum_de_X),SOUS(Y,minimum_de_Y)) ) ) ) ) ) ,imageR ,X,Y ,FVARIABLE ); /* Le schema d'interpolation est le suivant : */ /* */ /* */ /* HG (minX,maxY) HD (maxX,maxY) */ /* */ /* nHG <-----h3------> <---h4---> nHD */ /* *--------------------------* */ /* ^|\ . /|^ */ /* || \ . / || */ /* || \ . / || */ /* v1| 4 . 3 |v2 */ /* || \ . / || */ /* || \ . / || */ /* V| point\ ./ courant |V */ /* Y ................#..........| */ /* ^| / .\ |^ */ /* || / . \ || */ /* v4| 1 . 2 |v3 */ /* || / . \ || */ /* V| / . \ |V */ /* *---------------.----------* */ /* nBG <-----h2------> <---h1---> nBD */ /* X */ /* BG (minX,minY) BD (maxX,minY) */ /* */ /* */ /* le niveau 'N' du point courant {X,Y} est donne par la formule d'interpolation : */ /* */ /* N = (nBG.h1.v1) + (nBD.h2.v2) + (nHG.h3.v3) + (nHD.h4.v4) */ /* */ /* sachant qu'a l'exterieur du rectangle {BG,BD,HD,HG} le niveau 'niveau_a_remplacer' */ /* n'existe pas (il n'est present qu'a l'interieur de ce rectangle). */ Eblock ATes Bblock /* Cas des points qui ne sont pas du type 'niveau_a_remplacer' : on laisse alors inchanges */ /* les points de l'image 'imageR'. */ Eblock ETes Eblock end_image RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* " T R I C R O I S S A N T H O R I Z O N T A L " D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ BFonctionP #define gPREX(x) \ SOUS(x,pasX_global) #define gSUCX(x) \ ADD2(x,pasX_global) /* Voisins de gauche et de droite respectivement (voir 'v $xiii/begin_end$DEF' qui explique */ /* pourquoi on est oblige d'utiliser 'pasX_global', et ce a cause de 'begin_ligneQ(...)'). */ #define tCOXR(x) \ SOUS(x,X) #define tCOXA(x) \ ADD2(x,X) /* Passage des coordonnees absolues ('x') aux coordonnees relatives (a l'origine 'X' du */ /* segment courant) et reciproquement. */ #define eFRA2(x) \ QUOE(x,DEUX) \ /* Division par 2 par exces... */ DEFV(Common,DEFV(FonctionP,POINTERp(Itri_croissant_horizontal(imageR,imageA,pas_horizontal_relatif,un_tri_monotone)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[[X][Y]=imageA[X][Y], les points ayant ete tries par */ /* "paquets horizontalement", et ce par niveaux croissants... */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument a trier... */ DEFV(Argument,DEFV(Float,pas_horizontal_relatif)); /* Pas de parcours de l'image qui definit la longueur des segments sur lesquels ont lieu */ /* le tri ; ce pas est exprime dans [0,1]. */ DEFV(Argument,DEFV(Logical,un_tri_monotone)); /* Indique si le tri doit etre "monotone" ('VRAI') ce qui est un tri "standard", ou non */ /* ('FAUX') auquel cas le tri est fait de facon "originale" c'est-a-dire de la facon */ /* suivante : */ /* */ /* */ /* | *| | | | * || */ /* | * || | | | *|* || */ /* | * || | | | * | * || */ /* | * || | | |* | *|| */ /* | * || * | * | *| */ /* | * || |* | *| | || */ /* | * || | * | * | | || */ /* | * || | *|* | | || */ /* * || | * | | || */ /* ------------------ ------------------ */ /* X X */ /* */ /* en supposant qu'un tri "monotone" a ete fait au prealable sur 'imageA'... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Positive,INIT(pas_horizontal_absolu,_lDENORMALISE_OX(pas_horizontal_relatif))); /* Pas de parcours de l'image qui definit la longueur des segments sur lesquels ont lieu */ /* le tri ; ce pas est exprime dans [Xmin,Xmax]. */ /*..............................................................................................................................*/ Test(IL_FAUT(un_tri_monotone)) Bblock iMOVE(imageR,imageA); /* Initialisation de l'image Resultat (voir les commentaires relatifs a la procedure */ /* 'iMOVE(...)' dans 'v $xiii/di_image$DEF') lorsqu'il s'agit d'un tri "monotone"... */ Eblock ATes Bblock Eblock ETes begin_colonne Bblock begin_ligneQ(DoIn,Xmin,Xmax,pas_horizontal_absolu) /* ATTENTION, 'begin_ligneQ(...)' redefinit ici 'pasX' et lui donne la valeur */ /* 'pas_horizontal_absolu' (voir 'v $xiii/begin_end$DEF'). */ Bblock Test(IL_FAUT(un_tri_monotone)) Bblock DEFV(Int,INIT(Xsuperieur,UNDEF)); DoDe(Xsuperieur,gSUCX(X),gPREX(ADD2(X,pas_horizontal_absolu)),pasX_global) /* Le segment courant sur lequel a lieu le tri est [X,X+pas_horizontal_absolu-pasX]. */ /* ATTENTION, on utilise 'pasX_global' et non pas 'pasX' car, en effet, la definition de */ /* 'begin_ligneQ(...)' est telle que en fait 'pasX' le pas que l'on a fixe lors de son */ /* appel, c'est-a-dire donc ici 'pas_horizontal_absolu' (voir 'v $xiii/begin_end$DEF'). */ /* C'est ce qui explique aussi l'utilisation de 'gPREX(...)'... */ Bblock DEFV(Int,INIT(Xcourant,UNDEF)); DoIn(Xcourant,X,Xsuperieur,pasX_global) /* Le segment courant sur lequel ont lieu les permutations deux a deux est [X,Xsuperieur]. */ /* ATTENTION, on utilise 'pasX_global' et non pas 'pasX' car, en effet, la definition de */ /* 'begin_ligneQ(...)' est telle que en fait 'pasX' le pas que l'on a fixe lors de son */ /* appel, c'est-a-dire donc ici 'pas_horizontal_absolu' (voir 'v $xiii/begin_end$DEF'). */ Bblock Test(TEST_DANS_L_IMAGE(gSUCX(Xcourant),Y)) /* ATTENTION a l'utilisation de 'gSUCX(...) (voir 'v $xiii/begin_end$DEF'). */ Bblock DEFV(genere_p,INIT(niveau_a_gauche,load_point(imageR,Xcourant,Y))); DEFV(genere_p,INIT(niveau_a_droite,load_point(imageR,gSUCX(Xcourant),Y))); /* Recuperation des deux deux niveaux courants voisins (dits "a gauche" et "a droite"). */ /* ATTENTION a l'utilisation de 'gSUCX(...) (voir 'v $xiii/begin_end$DEF'). */ Test(IFGT(niveau_a_gauche,niveau_a_droite)) Bblock store_point(niveau_a_gauche,imageR,gSUCX(Xcourant),Y,FVARIABLE); store_point(niveau_a_droite,imageR,Xcourant,Y,FVARIABLE); /* Lorsque l'odre de ces deux niveaux est mauvais (decroissant), on les permute... */ /* ATTENTION a l'utilisation de 'gSUCX(...) (voir 'v $xiii/begin_end$DEF'). */ Eblock ATes Bblock Eblock ETes Eblock ATes Bblock Eblock ETes Eblock EDoI Eblock EDoD Eblock ATes Bblock DEFV(Int,INIT(Xcourant,UNDEF)); DoIn(Xcourant,X,gPREX(ADD2(X,pas_horizontal_absolu)),pasX_global) /* Le segment courant sur lequel ont lieu les permutations deux a deux est [X,Xsuperieur]. */ /* ATTENTION, on utilise 'pasX_global' et non pas 'pasX' car, en effet, la definition de */ /* 'begin_ligneQ(...)' est telle que en fait 'pasX' le pas que l'on a fixe lors de son */ /* appel, c'est-a-dire donc ici 'pas_horizontal_absolu' (voir 'v $xiii/begin_end$DEF'). */ Bblock Test(DIVISIBLE(tCOXR(Xcourant),DEUX)) Bblock store_point_valide(load_point_valide(imageA,Xcourant,Y) ,imageR ,tCOXA(ADD2(FRA2(tCOXR(Xcourant)),GRO1(FRA4(pas_horizontal_absolu)))),Y ,FVARIABLE ); /* Les points de rang pair par rapport a l'origine 'X' du segment courant sont conserves */ /* dans l'ordre et ramene au centre de ce meme segment : */ /* */ /* */ /* | *| | | | * || */ /* | * || | | | *| || */ /* | * || | | | * | || */ /* | * || | | |* | || */ /* | * || | | * | || */ /* | * || | | *| | || */ /* | * || | | * | | || */ /* | * || | |* | | || */ /* * || | * | | || */ /* ------------------ ------------------ */ /* X X */ /* */ Eblock ATes Bblock Test(IFLT(tCOXR(Xcourant),FRA2(pas_horizontal_absolu))) Bblock store_point_valide(load_point_valide(imageA,Xcourant,Y) ,imageR ,tCOXA(SOUS(GRO1(FRA4(pas_horizontal_absolu)),eFRA2(tCOXR(Xcourant)))),Y ,FVARIABLE ); /* Les points de rang impair par rapport a l'origine 'X' de la moitie de gauche du segment */ /* courant voient leur ordre s'inverser : */ /* */ /* */ /* | | || | | | | || */ /* | | || | | | | || */ /* | | || | | | | || */ /* | | || | | | | || */ /* | * || * | | | || */ /* | * | || |* | | | || */ /* | * | || | * | | | || */ /* | * | || | *| | | || */ /* * | || | * | | || */ /* ------------------ ------------------ */ /* X X */ /* */ Eblock ATes Bblock store_point_valide(load_point_valide(imageA,Xcourant,Y) ,imageR ,tCOXA(SOUS(GRO5(FRA4(pas_horizontal_absolu)),eFRA2(tCOXR(Xcourant)))),Y ,FVARIABLE ); /* Les points de rang impair par rapport a l'origine 'X' de la moitie de droite du segment */ /* courant voient leur ordre s'inverser : */ /* */ /* */ /* | | *| | | | |* || */ /* | | * || | | | | * || */ /* | | * || | | | | *|| */ /* | | * || | | | | *| */ /* | | || | | | | || */ /* | | || | | | | || */ /* | | || | | | | || */ /* | | || | | | | || */ /* | | || | | | | || */ /* ------------------ ------------------ */ /* X X */ /* */ Eblock ETes Eblock ETes Eblock EDoI Eblock ETes Eblock end_ligneQ(EDoI) Eblock end_colonne RETI(imageR); Eblock #undef eFRA2 #undef tCOXR #undef tCOXA #undef gPREX #undef gSUCX EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* T R I C R O I S S A N T D E S N I V E A U X D ' U N E I M A G E " S T A N D A R D " : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Itri_croissant_des_niveaux(imageR,imageA,trier_en_lignes)))) /* Fonction introduite le 20040130145601. */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] avec tri croissant des niveaux. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Logical,trier_en_lignes)); /* Choix entre tri en lignes ('VRAI') et tri en colonnes ('FAUX'). Cet argument a ete */ /* introduit le 20040203174713. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Int,INIT(coordonnee_X_de_tri,Xmin)); DEFV(Int,INIT(coordonnee_Y_de_tri,Ymin)); /* Coordonnee {X,Y} de tri... */ /*..............................................................................................................................*/ BoIn(niveau,NOIR,BLANC,PAS_COULEURS) Bblock begin_image Bblock Test(IFEQ(load_point(imageA,X,Y),niveau)) Bblock store_point(niveau ,imageR ,coordonnee_X_de_tri,coordonnee_Y_de_tri ,FVARIABLE ); Test(IL_FAUT(trier_en_lignes)) Bblock INCR(coordonnee_X_de_tri,pasX); /* Changement d'abscisse de tri... */ Test(IFGT(coordonnee_X_de_tri,Xmax)) Bblock EGAL(coordonnee_X_de_tri,Xmin); /* Reinitialisation de l'abscisse de tri... */ INCR(coordonnee_Y_de_tri,pasY); /* Changement d'ordonnee de tri... */ Eblock ATes Bblock Eblock ETes Eblock ATes Bblock INCR(coordonnee_Y_de_tri,pasY); /* Changement d'ordonnee de tri... */ Test(IFGT(coordonnee_Y_de_tri,Ymax)) Bblock EGAL(coordonnee_Y_de_tri,Ymin); /* Reinitialisation de l'ordonnee de tri... */ INCR(coordonnee_X_de_tri,pasX); /* Changement d'abscisse de tri... */ Eblock ATes Bblock Eblock ETes Eblock ETes Eblock ATes Bblock Eblock ETes Eblock end_image Eblock EBoI Test(IL_FAUT(trier_en_lignes)) Bblock DECR(coordonnee_Y_de_tri,pasY); Eblock ATes Bblock DECR(coordonnee_X_de_tri,pasX); Eblock ETes Test(IFOU(IFET(IL_FAUT(trier_en_lignes) ,IFET(IFEQ(coordonnee_X_de_tri,Xmin) ,IFEQ(coordonnee_Y_de_tri,Ymax) ) ) ,IFET(IL_NE_FAUT_PAS(trier_en_lignes) ,IFET(IFEQ(coordonnee_X_de_tri,Xmax) ,IFEQ(coordonnee_Y_de_tri,Ymin) ) ) ) ) Bblock Eblock ATes Bblock PRINT_ERREUR("le tri croissant des niveaux est incoherent"); CAL1(Prer2(" (les coordonnees du point courant sont {%d,%d}).\n",coordonnee_X_de_tri,coordonnee_Y_de_tri)); Eblock ETes RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* " A U T O - N U M E R O T A T I O N " D ' U N E I M A G E " F L O T T A N T E " : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Logical,SINT(IFauto_numerotation_____en_colonne,VRAI))); /* Afin de chosir entre le mode "colonne" et le mode "ligne"... */ DEFV(Common,DEFV(genere_Float,SINT(IFauto_numerotation_____niveau_du_fond,FZERO))); /* Niveau du "fond"... */ DEFV(Common,DEFV(genere_Float,SINT(IFauto_numerotation_____premier_auto_numero,FU))); DEFV(Common,DEFV(genere_Float,SINT(IFauto_numerotation_____increment_de_l_auto_numero,FU))); /* Premier "auto-numero" de chaque colonne et son increment... */ #define AUTO_NUMEROTATION_EN_COLONNE_OU_EN_LIGNE(begin_1,begin_2,end_2,end_1) \ Bblock \ begin_1 \ Bblock \ DEFV(genere_Float,INIT(auto_numero_courant_de_la_colonne_ou_de_la_ligne_courante \ ,IFauto_numerotation_____premier_auto_numero \ ) \ ); \ DEFV(genere_Float,INIT(niveau_du_point_precedent,FLOT__NIVEAU_UNDEF)); \ DEFV(Logical,INIT(le_premier_point_a_ete_rencontre,FAUX)); \ \ begin_2 \ Bblock \ DEFV(genere_Float,INIT(niveau_du_point_courant,loadF_point(imageA,X,Y))); \ \ Test(IFNE(niveau_du_point_courant,IFauto_numerotation_____niveau_du_fond)) \ Bblock \ Test(EST_FAUX(le_premier_point_a_ete_rencontre)) \ Bblock \ EGAL(le_premier_point_a_ete_rencontre,VRAI); \ Eblock \ ATes \ Bblock \ Test(IFEQ(niveau_du_point_courant,niveau_du_point_precedent)) \ Bblock \ /* Les points identiques et successifs de la colonne courante recoivent le meme numero... */ \ Eblock \ ATes \ Bblock \ INCR(auto_numero_courant_de_la_colonne_ou_de_la_ligne_courante \ ,IFauto_numerotation_____increment_de_l_auto_numero \ ); \ /* Le numero change lorsque deux points successifs different... */ \ Eblock \ ETes \ Eblock \ ETes \ \ storeF_point(auto_numero_courant_de_la_colonne_ou_de_la_ligne_courante,imageR,X,Y); \ \ EGAL(niveau_du_point_precedent,niveau_du_point_courant); \ Eblock \ ATes \ Bblock \ storeF_point(niveau_du_point_courant,imageR,X,Y); \ /* Les points du "fond" restent inchanges... */ \ Eblock \ ETes \ Eblock \ end_2 \ Eblock \ end_1 \ Eblock \ /* Auto-numerotation en colonne ou en ligne (introduit le 20171010114744...). */ DEFV(Common,DEFV(FonctionF,POINTERF(IFauto_numerotation(imageR,imageA)))) /* Fonction introduite le 20171010105437... */ /* */ /* On notera le type 'FonctionF' afin d'eviter des debordements de l'auto-numero qui */ /* seraient frequents avec le type 'FonctionP' lorsque 'dimX' et/ou 'dimY' seraient */ /* superieurs a 'COULEURS'... */ DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ Test(IL_FAUT(IFauto_numerotation_____en_colonne)) Bblock AUTO_NUMEROTATION_EN_COLONNE_OU_EN_LIGNE(begin_ligne,begin_colonne,end_colonne,end_ligne) /* Auto-numerotation en colonne. */ Eblock ATes Bblock AUTO_NUMEROTATION_EN_COLONNE_OU_EN_LIGNE(begin_colonne,begin_ligne,end_ligne,end_colonne) /* Auto-numerotation en ligne. */ Eblock ETes RETIF(imageR); Eblock #undef AUTO_NUMEROTATION_EN_COLONNE_OU_EN_LIGNE EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* " S P I R A L I S A T I O N " D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Ispiralise(imageR,imageA)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[spirale(X)][spirale(Y)]=imageA[X][Y]. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument a spiraliser... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(pointI_2D,point_courant); /* Point (entier) courant. */ SPIRALE_DEFINITION /* Donnees de generation d'une spirale de parcours d'une image. */ /*..............................................................................................................................*/ SPIRALE_VALIDATION; /* Validation des pas de parcours (pasX,pasY) des images. */ INITIALISATION_POINT_2D(point_courant,Xcentre,Ycentre); /* Et on se place au centre de l'image. */ begin_image Bblock store_point_valide(load_point(imageA,X,Y) ,imageR ,ASD1(point_courant,x),ASD1(point_courant,y) ,FVARIABLE ); /* Et on "spiralise" : imageR[spirale(X)][spirale(Y)]=imageA[X][Y]. */ SPIRALE_INITIALISATION; /* Initialisation dynamique de 'spirale_nombre_de_points_a_traiter'. */ SPIRALE_DEPLACEMENT(ASD1(point_courant,x),ASD1(point_courant,y)); /* Deplacement du point courant de la spirale... */ /* ATTENTION : on n'utilise pas 'SPIRALE_DEPLACEMENT_ET_PARCOURS(...)' afin de garantir le */ /* traitement de tous les points de l'image... */ SPIRALE_PARCOURS; /* Parcours de la spirale avec rotation eventuelle de PI/2 du bras courant... */ Eblock end_image RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* " D E - S P I R A L I S A T I O N " D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Ide_spiralise(imageR,imageA)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[spirale(X)][spirale(Y)]. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument a de-spiraliser... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(pointI_2D,point_courant); /* Point (entier) courant. */ SPIRALE_DEFINITION /* Donnees de generation d'une spirale de parcours d'une image. */ /*..............................................................................................................................*/ SPIRALE_VALIDATION; /* Validation des pas de parcours (pasX,pasY) des images. */ INITIALISATION_POINT_2D(point_courant,Xcentre,Ycentre); /* Et on se place au centre de l'image. */ begin_image Bblock store_point(load_point_valide(imageA,ASD1(point_courant,x),ASD1(point_courant,y)) ,imageR ,X,Y ,FVARIABLE ); /* Et on "de-spiralise" : imageR[X][Y]=imageA[spirale(X)][spirale(Y)]. */ SPIRALE_INITIALISATION; /* Initialisation dynamique de 'spirale_nombre_de_points_a_traiter'. */ SPIRALE_DEPLACEMENT(ASD1(point_courant,x),ASD1(point_courant,y)); /* Deplacement du point courant de la spirale... */ /* ATTENTION : on n'utilise pas 'SPIRALE_DEPLACEMENT_ET_PARCOURS(...)' afin de garantir le */ /* traitement de tous les points de l'image... */ SPIRALE_PARCOURS; /* Parcours de la spirale avec rotation eventuelle de PI/2 du bras courant... */ Eblock end_image RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* S Y M E T R I E D ' A X E H O R I Z O N T A L ( O X ) D ' U N E I M A G E " S T A N D A R D " : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Ix_symetrie(imageR,imageA)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=symetrie_OX(imageA[X][Y]). */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock store_point(load_point(imageA,X,Y),imageR,X,RENY(Y),FVARIABLE); Eblock end_image RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* S Y M E T R I E D ' A X E H O R I Z O N T A L ( O X ) D ' U N E I M A G E " F L O T T A N T E " : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFx_symetrie(imageR,imageA)))) DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=symetrie_OX(imageA[X][Y]). */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock storeF_point(loadF_point(imageA,X,Y),imageR,X,RENY(Y)); Eblock end_image RETIF(imageR); Eblock EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* S Y M E T R I E D ' A X E V E R T I C A L ( O Y ) D ' U N E I M A G E " S T A N D A R D " : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Iy_symetrie(imageR,imageA)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=symetrie_OY(imageA[X][Y]). */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock store_point(load_point(imageA,X,Y),imageR,RENX(X),Y,FVARIABLE); Eblock end_image RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* S Y M E T R I E D ' A X E V E R T I C A L ( O Y ) D ' U N E I M A G E " F L O T T A N T E " : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFy_symetrie(imageR,imageA)))) DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=symetrie_OY(imageA[X][Y]). */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock storeF_point(loadF_point(imageA,X,Y),imageR,RENX(X),Y); Eblock end_image RETIF(imageR); Eblock EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* P E R I O D I S A T I O N D ' U N E I M A G E " S T A N D A R D " : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Iperiodisation(imageR,imageA)))) /* Fonction introduite le 20150603145018... */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=periodise(imageA[X][Y]). */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock store_point(MOY4(load_point(imageA,NEUT(X),NEUT(Y)) ,load_point(imageA,RENX(X),NEUT(Y)) ,load_point(imageA,RENX(X),RENY(Y)) ,load_point(imageA,NEUT(X),RENY(Y)) ) ,imageR ,X,Y ,FVARIABLE ); /* La periodisation est obtenue grace a la moyenne des quatre sommets d'un carre centre */ /* et dont l'un des sommets est le point courant {X,Y}... */ Eblock end_image RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* P E R I O D I S A T I O N D ' U N E I M A G E " F L O T T A N T E " : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFperiodisation(imageR,imageA)))) /* Fonction introduite le 20150603145018... */ DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=periodise(imageA[X][Y]). */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock storeF_point(MOY4(loadF_point(imageA,NEUT(X),NEUT(Y)) ,loadF_point(imageA,RENX(X),NEUT(Y)) ,loadF_point(imageA,RENX(X),RENY(Y)) ,loadF_point(imageA,NEUT(X),RENY(Y)) ) ,imageR ,X,Y ); /* La periodisation est obtenue grace a la moyenne des quatre sommets d'un carre centre */ /* et dont l'un des sommets est le point courant {X,Y}... */ Eblock end_image RETIF(imageR); Eblock EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* I N V E R S I O N ( A U S E N S G E O M E T R I Q U E D U T E R M E ) */ /* D ' U N E I M A G E " F L O T T A N T E " : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFinversion_geometrique(imageR,imageA,pole,puissance)))) /* Fonction introduite le 20050826140832... */ DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=inversion(imageA[X][Y]). */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Float,pole)); DEFV(Argument,DEFV(Float,puissance)); /* Pole et puissance de l'inversion... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock DEFV(genere_Float,INIT(niveau_avant,loadF_point(imageA,X,Y))); DEFV(genere_Float,INIT(niveau_apres,FLOT__UNDEF)); /* Niveau courant au point {X,Y} avant et apres l'inversion... */ EGAL(niveau_apres,INVG(niveau_avant,pole,puissance)); /* Le niveau "avant" N1 est transforme en niveau "apres" N2 de la facon suivante : */ /* */ /* (N1 - pole)x(N2 - pole) = puissance */ /* */ /* soit : */ /* */ /* puissance */ /* N2 = ----------- + pole */ /* N1 - pole */ /* */ /* ce qui correspond a la definition de l'inversion geometrique... */ storeF_point(niveau_apres,imageR,X,Y); Eblock end_image RETIF(imageR); Eblock EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* V A L E U R A B S O L U E D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Ivaleur_absolue(imageR,imageA)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR=abs(imageA). */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock PABS(X,Y,imageA,imageR); Eblock end_image RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* V A L E U R A B S O L U E D ' U N E I M A G E F L O T T A N T E : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFvaleur_absolue(imageR,imageA)))) DEFV(Argument,DEFV(imageF,imageR)); /* Image flottante Resultat, telle que : imageR=|imageA|. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image flottante Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock storeF_point(ABSO(loadF_point(imageA,X,Y)) ,imageR ,X,Y ); Eblock end_image RETIF(imageR); Eblock EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* C O M P L E M E N T A T I O N D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Icomplementation(imageR,imageA)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR=BLANC-imageA. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock PCOMP(X,Y,imageA,imageR); Eblock end_image RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* C O M P L E M E N T A T I O N D ' U N E I M A G E " F L O T T A N T E " : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Logical,SINT(IFcomplementation_____forcer_les_extrema,FAUX))); /* Indique si les niveaux {niveau_minimum,niveau_maximum} doivent etre forces ('VRAI') ou */ /* calcules a priori ('FAUX'). */ DEFV(Common,DEFV(genere_Float,SINT(IFcomplementation_____niveau_minimum,COORDONNEE_BARYCENTRIQUE_MINIMALE))); DEFV(Common,DEFV(genere_Float,SINT(IFcomplementation_____niveau_maximum,COORDONNEE_BARYCENTRIQUE_MAXIMALE))); /* Niveaux extrema a priori si 'IL_FAUT(IFcomplementation_____forcer_les_extrema)'. */ DEFV(Common,DEFV(FonctionF,POINTERF(IFcomplementation(imageR,imageA)))) DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR=Min(imageA)+(Max(imageA)-imageA). */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(genere_Float,INIT(niveau_minimum,IFcomplementation_____niveau_minimum)); DEFV(genere_Float,INIT(niveau_maximum,IFcomplementation_____niveau_maximum)); /* Afin de rechercher les niveaux minimal et maximal de 'imageA'. */ /*..............................................................................................................................*/ Test(IL_NE_FAUT_PAS(IFcomplementation_____forcer_les_extrema)) Bblock CALS(IFnivo_extrema(imageA ,ADRESSE(niveau_minimum) ,ADRESSE(niveau_maximum) ) ); /* Recherche des extrema de 'imageA' lorsqu'ils ne sont pas forces... */ Test(IFEQ(niveau_minimum,niveau_maximum)) /* Test introduit le 20101012164700 car, en effet, ce cas n'avait pas ete prevu... */ Bblock PRINT_ATTENTION("les extrema etant egaux, la complementation a 1 est forcee"); EGAL(niveau_minimum,IFcomplementation_____niveau_minimum); EGAL(niveau_maximum,IFcomplementation_____niveau_maximum); Eblock ATes Bblock Eblock ETes Eblock ATes Bblock Eblock ETes begin_image Bblock storeF_point(ADD2(niveau_minimum ,SOUS(niveau_maximum ,loadF_point(imageA,X,Y) ) ) ,imageR ,X,Y ); Eblock end_image RETIF(imageR); Eblock EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* I N C R E M E N T A T I O N D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Iincrementation(imageR,imageA,increment)))) DEFV(Argument,DEFV(image,imageR)); /* Image resultat, telle que : imageR=imageA+increment. */ DEFV(Argument,DEFV(image,imageA)); /* Image argument. */ DEFV(Argument,DEFV(Int,increment)); /* Increment (positif ou negatif). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock PINC(X,Y,imageA,increment,imageR); Eblock end_image RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* M I S E A L ' E C H E L L E D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(Logical,SINT(Iscale_____conserver_le_NOIR,FAUX))); /* La valeur par defaut garantit la compatibilite anterieure au 20230814105219... */ DEFV(Common,DEFV(FonctionP,POINTERp(Iscale(imageR,facteur_d_echelle,imageA,facteur_de_translation)))) DEFV(Argument,DEFV(image,imageR)); /* Image resultat, telle que : imageR[X][Y]=echelle*imageA[X][Y] + translation. */ DEFV(Argument,DEFV(Float,facteur_d_echelle)); /* Facteur d'echelle... */ DEFV(Argument,DEFV(image,imageA)); /* Image argument. */ DEFV(Argument,DEFV(Float,facteur_de_translation)); /* Facteur de translation... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock DEFV(genere_p,INIT(niveau_imageA,load_point(imageA,X,Y))); DEFV(genere_p,INIT(niveau_imageR,NIVEAU_UNDEF)); Test(IFET(IFEQ(niveau_imageA,NOIR),IL_FAUT(Iscale_____conserver_le_NOIR))) Bblock EGAL(niveau_imageR,niveau_imageA); Eblock ATes Bblock EGAL(niveau_imageR ,TRNF(AXPB(facteur_d_echelle ,FLOT(NIVR(niveau_imageA)) ,facteur_de_translation ) ) ); Eblock ETes store_point(niveau_imageR,imageR,X,Y,FVARIABLE); /* Jusqu'au 20230814105219, il y avait ici : */ /* */ /* PAXPB(X,Y,facteur_d_echelle,facteur_de_translation,imageA,imageR); */ /* */ /* mais, le besoin de pouvoir conserver le NOIR a implique cette modification... */ Eblock end_image RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* T R A N S L A T I O N D ' U N E I M A G E F L O T T A N T E P A R R A P P O R T A U M I N I M U M : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFtranslation_par_rapport_au_minimum(imageR,imageA)))) DEFV(Argument,DEFV(imageF,imageR)); /* Image flottante Resultat, telle que : imageR[X][Y]=imageA[X][Y]-minimum(imageA). */ DEFV(Argument,DEFV(imageF,imageA)); /* Image flottante Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(genere_Float,INIT(nivo_minimum,IFnivo_minimum(imageA))); /* Minimum des niveaux de l'image Argument. */ /*..............................................................................................................................*/ begin_image Bblock storeF_point(SOUS(loadF_point(imageA,X,Y) ,nivo_minimum ) ,imageR ,X,Y ); Eblock end_image RETIF(imageR); Eblock EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* N O R M A L I S A T I O N B R U T A L E D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Inormalisation(imageR,imageA)))) /* Fonction introduite le 20141105135700 pour 'v $xci/gauss$K Inormalisation'... */ DEFV(Argument,DEFV(image,imageR)); /* Image resultat, telle que : imageR=imageA renormalisee dans [NOIR,BLANC] brutalement. */ DEFV(Argument,DEFV(image,imageA)); /* Image argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ BDEFV(imageF,imageA_flottante); CALS(Istd_float(imageA_flottante,FLOT__NOIR,FLOT__BLANC,imageA)); CALS(Ifloat_std_avec_renormalisation(imageA,imageA_flottante)); /* Normalisation brutale dans [NOIR,BLANC]... */ EDEFV(imageF,imageA_flottante); RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* M I S E A L ' E C H E L L E D ' U N E I M A G E C O M P L E X E : */ /* */ /*************************************************************************************************************************************/ BFonctionJ DEFV(Common,DEFV(Logical,SINT(IJscale_____translater_aussi_la_partie_Imaginaire,VRAI))); /* Indique si l'on va translater par 'facteur_de_translation' la partie Imaginaire ('VRAI') */ /* en plus de la partie Reelle ('FAUX'). Ceci a ete ajoute le 19990909105042 pour assurer la */ /* compatibilite avec la programmation precedente (voir le commentaire du 19990908111727). */ DEFV(Common,DEFV(FonctionJ,POINTERJ(IJscale(imageR,facteur_d_echelle,facteur_de_translation,imageA)))) DEFV(Argument,DEFV(imageJ,imageR)); /* Image complexe Resultat, telle que : imageR[X][Y]=echelle*imageA[X][Y] + translation, */ /* en traitant separemment les parties reelle et imaginaire... */ DEFV(Argument,DEFV(Float,facteur_d_echelle)); /* Facteur d'echelle... */ DEFV(Argument,DEFV(Float,facteur_de_translation)); /* Facteur de translation... */ DEFV(Argument,DEFV(imageJ,imageA)); /* Image complexe Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock DEFV(complexe,nombre_complexe_courant); DEFV(complexe,nombre_complexe_courant_mis_a_l_echelle); Cegal(nombre_complexe_courant,loadJ_point(imageA,X,Y)); /* Nombre complexe courant. */ Cforme_lineaire(nombre_complexe_courant_mis_a_l_echelle,facteur_d_echelle,nombre_complexe_courant,facteur_de_translation); /* Mise a l'echelle. */ Test(EST_VRAI(IJscale_____translater_aussi_la_partie_Imaginaire)) Bblock Cinitialisation(nombre_complexe_courant_mis_a_l_echelle ,NEUT(Reelle(nombre_complexe_courant_mis_a_l_echelle)) ,ADD2(Imaginaire(nombre_complexe_courant_mis_a_l_echelle),facteur_de_translation) ); /* Ceci n'est pas tres "mathematique" mais est la pour la compatibilite... */ Eblock ATes Bblock Eblock ETes storeJ_point(nombre_complexe_courant_mis_a_l_echelle ,imageR ,X,Y ); /* Et rangement. On notera qu'avant le 19990908111727, cette operation etait realisee a */ /* l'aide de : */ /* */ /* storeRJ_point(AXPB(facteur_d_echelle */ /* ,loadRJ_point(imageA,X,Y) */ /* ,facteur_de_translation */ /* ) */ /* ,imageR */ /* ,X,Y */ /* ); */ /* storeIJ_point(AXPB(facteur_d_echelle */ /* ,loadIJ_point(imageA,X,Y) */ /* ,facteur_de_translation */ /* ) */ /* ,imageR */ /* ,X,Y */ /* ); */ /* */ /* mais que cela n'etait pas en accord avec la notion de 'Cforme_lineaire(...)' puisque */ /* la partie Imaginaire faisait aussi l'objet de 'facteur_de_translation'... */ Eblock end_image RETIJ(imageR); Eblock EFonctionJ _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* T R O N C A T I O N D E S N I V E A U X D ' U N E I M A G E " S T A N D A R D " : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Itroncation(imageR,imageA,seuil_inferieur,seuil_superieur)))) /* Fonction introduite le 20061128113437... */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] avec tous les niveaux dans */ /* [seuil_inferieur,seuil_superieur]. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(genere_p,seuil_inferieur)); DEFV(Argument,DEFV(genere_p,seuil_superieur)); /* Seuils de troncation. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock store_point(TRON(load_point(imageA,X,Y),seuil_inferieur,seuil_superieur) ,imageR ,X,Y ,FVARIABLE ); Eblock end_image RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* T R O N C A T I O N D E S N I V E A U X D ' U N E I M A G E " F L O T T A N T E " : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFtroncation(imageR,imageA,seuil_inferieur,seuil_superieur)))) /* Fonction introduite le 20061128113437... */ DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] avec tous les niveaux dans */ /* [seuil_inferieur,seuil_superieur]. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(genere_Float,seuil_inferieur)); DEFV(Argument,DEFV(genere_Float,seuil_superieur)); /* Seuils de troncation. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock storeF_point(TRON(loadF_point(imageA,X,Y),seuil_inferieur,seuil_superieur) ,imageR ,X,Y ); Eblock end_image RETIF(imageR); Eblock EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* M O D U L O D E S N I V E A U X D ' U N E I M A G E " S T A N D A R D " : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Imodulo(imageR,imageA,seuil_inferieur,seuil_superieur)))) /* Fonction introduite le 20061128113437... */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] avec tous les niveaux dans */ /* [seuil_inferieur,seuil_superieur]. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(genere_p,seuil_inferieur)); DEFV(Argument,DEFV(genere_p,seuil_superieur)); /* Seuils de modulo. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock store_point(MODS(load_point(imageA,X,Y),seuil_inferieur,seuil_superieur) ,imageR ,X,Y ,FVARIABLE ); Eblock end_image RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* M O D U L O D E S N I V E A U X D ' U N E I M A G E " F L O T T A N T E " : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFmodulo(imageR,imageA,seuil_inferieur,seuil_superieur)))) /* Fonction introduite le 20061128113437... */ DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] avec tous les niveaux dans */ /* [seuil_inferieur,seuil_superieur]. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(genere_Float,seuil_inferieur)); DEFV(Argument,DEFV(genere_Float,seuil_superieur)); /* Seuils de modulo. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock storeF_point(MODF(loadF_point(imageA,X,Y),seuil_inferieur,seuil_superieur) ,imageR ,X,Y ); Eblock end_image RETIF(imageR); Eblock EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* T R A N S F O R M A T I O N " S I G M O I D E " D ' U N E I M A G E " F L O T T A N T E " : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Float,SINT(IFsigmoide_____diviseur,FDEUX))); DEFV(Common,DEFV(FonctionF,POINTERF(IFsigmoide(imageR,imageA,echelle)))) /* Fonction introduite le 20240702174203... */ DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(genere_Float,echelle)); /* Echelle de la transformation... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock storeF_point(SIGM(AXPB(echelle,loadF_point(imageA,X,Y),NEGA(DIVI(echelle,IFsigmoide_____diviseur)))) ,imageR ,X,Y ); Eblock end_image RETIF(imageR); Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* T R A N S F O R M A T I O N " S I G M O I D E " D ' U N E I M A G E " S T A N D A R D " : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Isigmoide(imageR,imageA,echelle)))) /* Fonction introduite le 20240703074813... */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(genere_Float,echelle)); /* Echelle de la transformation... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ BDEFV(imageF,imageA_flottante); BDEFV(imageF,imageR_flottante); CALS(Istd_float(imageA_flottante,COORDONNEE_BARYCENTRIQUE_MINIMALE,COORDONNEE_BARYCENTRIQUE_MAXIMALE,imageA)); /* Normalisation brutale dans [NOIR,BLANC]... */ CALS(IFsigmoide(imageR_flottante,imageA_flottante,echelle)); CALS(Ifloat_std_avec_renormalisation(imageR,imageR_flottante)); /* Normalisation brutale dans [NOIR,BLANC]... */ EDEFV(imageF,imageR_flottante); EDEFV(imageF,imageA_flottante); RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* F I L T R A G E P A S S E _ B A N D E D ' U N E I M A G E */ /* L E S S E U I L S I N F E R I E U R E T S U P E R I E U R E T A N T I N C L U S : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(Logical,SINT(Ipasse_bande_____forcer_niveau_intermediaire,FAUX))); DEFV(Common,DEFV(genere_p,SINT(Ipasse_bande_____niveau_intermediaire,BLANC))); /* Introduit le 20091104131734 afin de pouvoir forcer un niveau uniforme dans la bande */ /* seuil_inferieur,seuil_superieur] qui est conservee. La valeur par defaut garantit la */ /* compatibilite anterieure... */ DEFV(Common,DEFV(Logical,SINT(Ipasse_bande_____tests_stricts_a_gauche,VRAI))); DEFV(Common,DEFV(Logical,SINT(Ipasse_bande_____tests_stricts_a_droite,VRAI))); /* Afin de pouvoir gerer des "fermes-fermes" (seule possibilite avant le 20020625105813), */ /* des "ouverts-ouverts", des "fermes-ouverts" ou encore des "ouverts-fermes"... */ DEFV(Common,DEFV(genere_p,SINT(Ipasse_bande_____niveau_inferieur,NIVEAU_PASSE_BANDE_INFERIEUR))); DEFV(Common,DEFV(genere_p,SINT(Ipasse_bande_____niveau_superieur,NIVEAU_PASSE_BANDE_SUPERIEUR))); /* Niveaux a utiliser si 'IL_FAUT(forcer_le_NOIR)'. */ DEFV(Common,DEFV(FonctionP,POINTERp(Ipasse_bande(imageR,imageA,seuil_inferieur,seuil_superieur,forcer_le_NOIR)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR=imageA pour tous les points de "imageA" */ /* tels que seuil_inferieur <= imageA[X][Y] <= seuil_superieur ; pour les autres */ /* points, c'est le "seuil" correspondant a une unite ("I") pres qui est utilise */ /* (-I pour le "inf" et +I pour le "sup"). */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(genere_p,seuil_inferieur)); DEFV(Argument,DEFV(genere_p,seuil_superieur)); /* Seuils de test. */ DEFV(Argument,DEFV(Logical,forcer_le_NOIR)); /* Cet indicateur precise la methode de visualisation de ce qui est exclu : */ /* */ /* 'VRAI' : on utilise respectivement 'Ipasse_bande_____niveau_inferieur' et */ /* 'Ipasse_bande_____niveau_superieur', */ /* 'FAUX' : on utilise respectivement 'PREN(seuil_inferieur)' et 'SUCN(seuil_superieur)'. */ /* */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock DEFV(genere_p,INIT(point,NIVEAU_UNDEF)); /* Variables de manoeuvre (valeur du point courant). */ EGAL(point,load_point(imageA,X,Y)); /* Memorisation du point argument courant. */ store_point(COND(IL_NE_FAUT_PAS(Ipasse_bande_____forcer_niveau_intermediaire) ,point ,Ipasse_bande_____niveau_intermediaire ) ,imageR ,X,Y ,FVARIABLE ); /* Initialisation a priori du point resultat courant. */ Test(IFLc(point,seuil_inferieur,Ipasse_bande_____tests_stricts_a_gauche)) Bblock store_point(COND(IL_FAUT(forcer_le_NOIR) ,Ipasse_bande_____niveau_inferieur ,PREN(seuil_inferieur) ) ,imageR ,X,Y ,FVARIABLE ); Eblock ATes Bblock Eblock ETes Test(IFGc(point,seuil_superieur,Ipasse_bande_____tests_stricts_a_droite)) Bblock store_point(COND(IL_FAUT(forcer_le_NOIR) ,Ipasse_bande_____niveau_superieur ,SUCN(seuil_superieur) ) ,imageR ,X,Y ,FVARIABLE ); Eblock ATes Bblock Eblock ETes Eblock end_image RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* F I L T R A G E P A S S E _ B A N D E D ' U N E I M A G E F L O T T A N T E */ /* L E S S E U I L S I N F E R I E U R E T S U P E R I E U R E T A N T I N C L U S : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Logical,SINT(IFpasse_bande_____tests_stricts_a_gauche,VRAI))); DEFV(Common,DEFV(Logical,SINT(IFpasse_bande_____tests_stricts_a_droite,VRAI))); /* Afin de pouvoir gerer des "fermes-fermes" (seule possibilite avant le 20020625105813), */ /* des "ouverts-ouverts", des "fermes-ouverts" ou encore des ouverts-fermes"... */ DEFV(Common,DEFV(Logical,SINT(IFpasse_bande_____forcer_les_valeurs_intermediaires,FAUX))); DEFV(Common,DEFV(genere_Float,SINT(IFpasse_bande_____valeur_intermediaire,FLOT__NOIR))); /* Afin de pouvoir gerer les zones intermediaires (introduit le 20170220131708). */ DEFV(Common,DEFV(FonctionF,POINTERF(IFpasse_bande(imageR,imageA,seuil_inferieur,seuil_superieur,valeur_inferieure,valeur_superieure)))) DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR=imageA pour tous les points de "imageA" */ /* tels que seuil_inferieur <= imageA[X][Y] <= seuil_superieur ; pour les autres */ /* points, ce sont les valeurs "inferieure" et "superieure" qui sont utilisees... */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(genere_Float,seuil_inferieur)); DEFV(Argument,DEFV(genere_Float,seuil_superieur)); /* Seuils de test. */ DEFV(Argument,DEFV(genere_Float,valeur_inferieure)); DEFV(Argument,DEFV(genere_Float,valeur_superieure)); /* Valeurs de substitution pour les points qui sont en dehors de la bande... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock DEFV(genere_Float,INIT(point,FLOT__NIVEAU_UNDEF)); /* Variables de manoeuvre (valeur du point courant). */ EGAL(point,loadF_point(imageA,X,Y)); /* Memorisation du point argument courant. */ storeF_point(COND(IFLc(point,seuil_inferieur,IFpasse_bande_____tests_stricts_a_gauche) ,valeur_inferieure ,COND(IFGc(point,seuil_superieur,IFpasse_bande_____tests_stricts_a_droite) ,valeur_superieure ,COND(IL_FAUT(IFpasse_bande_____forcer_les_valeurs_intermediaires) ,IFpasse_bande_____valeur_intermediaire ,point ) ) ) ,imageR ,X,Y ); /* Filtrage passe-bande... */ Eblock end_image RETIF(imageR); Eblock EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* F I L T R A G E C O U P E _ B A N D E D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(Logical,SINT(Icoupe_bande_____tests_stricts_a_gauche,VRAI))); DEFV(Common,DEFV(Logical,SINT(Icoupe_bande_____tests_stricts_a_droite,VRAI))); /* Afin de pouvoir gerer des "fermes-fermes" (seule possibilite avant le 20020625105813), */ /* des "ouverts-ouverts", des "fermes-ouverts" ou encore des ouverts-fermes"... */ DEFV(Common,DEFV(genere_p,SINT(Icoupe_bande_____niveau_intermediaire,NIVEAU_COUPE_BANDE))); /* Niveau a utiliser si 'IL_FAUT(forcer_le_NOIR)'. */ DEFV(Common,DEFV(FonctionP,POINTERp(Icoupe_bande(imageR,imageA,seuil_inferieur,seuil_superieur,forcer_le_NOIR)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR=imageA pour tous les points de "imageA" */ /* */ /* tels que : */ /* */ /* imageA[X][Y] < seuil_inferieur */ /* */ /* ou : */ /* */ /* imageA[X][Y] > seuil_superieur */ /* */ /* pour les autres points, c'est le "seuil moyen" ((min+max)/2) correspondant qui */ /* est utilisee. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(genere_p,seuil_inferieur)); DEFV(Argument,DEFV(genere_p,seuil_superieur)); /* Seuils de test. */ DEFV(Argument,DEFV(Logical,forcer_le_NOIR)); /* Cet indicateur precise la methode de visualisation de ce qui est exclu : */ /* */ /* 'VRAI' : on utilise 'Icoupe_bande_____niveau_intermediaire', */ /* 'FAUX' : on utilise 'MOYE(seuil_inferieur,seuil_superieur)'. */ /* */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(genere_p,INIT(moyenne_min_max,COND(IL_FAUT(forcer_le_NOIR) ,Icoupe_bande_____niveau_intermediaire ,MOYE(seuil_inferieur,seuil_superieur) ) ) ); /* Niveau a attribuer aux points de la bande exclue... */ /*..............................................................................................................................*/ begin_image Bblock DEFV(genere_p,INIT(point,NIVEAU_UNDEF)); /* Variables de manoeuvre (valeur du point courant). */ EGAL(point,load_point(imageA,X,Y)); /* Memorisation du point argument courant. */ store_point(moyenne_min_max,imageR,X,Y,FVARIABLE); /* Initialisation a priori du point resultat courant. */ Test(IFLc(point,seuil_inferieur,Icoupe_bande_____tests_stricts_a_gauche)) Bblock store_point(point,imageR,X,Y,FVARIABLE); Eblock ATes Bblock Eblock ETes Test(IFGc(point,seuil_superieur,Icoupe_bande_____tests_stricts_a_droite)) Bblock store_point(point,imageR,X,Y,FVARIABLE); Eblock ATes Bblock Eblock ETes Eblock end_image RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* F I L T R A G E C O U P E _ B A N D E D ' U N E I M A G E F L O T T A N T E : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Logical,SINT(IFcoupe_bande_____tests_stricts_a_gauche,VRAI))); DEFV(Common,DEFV(Logical,SINT(IFcoupe_bande_____tests_stricts_a_droite,VRAI))); /* Afin de pouvoir gerer des "fermes-fermes" (seule possibilite avant le 20020625105813), */ /* des "ouverts-ouverts", des "fermes-ouverts" ou encore des ouverts-fermes"... */ DEFV(Common,DEFV(FonctionF,POINTERF(IFcoupe_bande(imageR,imageA,seuil_inferieur,seuil_superieur,valeur_de_la_bande)))) DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR=imageA pour tous les points de "imageA" */ /* */ /* tels que : */ /* */ /* imageA[X][Y] < seuil_inferieur */ /* */ /* ou : */ /* */ /* imageA[X][Y] > seuil_superieur */ /* */ /* pour les autres points, c'est la valeur "de la bande" qui est utilisee... */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(genere_Float,seuil_inferieur)); DEFV(Argument,DEFV(genere_Float,seuil_superieur)); /* Seuils de test. */ DEFV(Argument,DEFV(genere_Float,valeur_de_la_bande)); /* Valeur a attribuer aux points de la bande exclue... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock DEFV(genere_Float,INIT(point,FLOT__NIVEAU_UNDEF)); /* Variables de manoeuvre (valeur du point courant). */ EGAL(point,loadF_point(imageA,X,Y)); /* Memorisation du point argument courant. */ storeF_point(valeur_de_la_bande,imageR,X,Y); /* Initialisation a priori du point resultat courant. */ Test(IFLc(point,seuil_inferieur,IFcoupe_bande_____tests_stricts_a_gauche)) Bblock storeF_point(point,imageR,X,Y); Eblock ATes Bblock Eblock ETes Test(IFGc(point,seuil_superieur,IFcoupe_bande_____tests_stricts_a_droite)) Bblock storeF_point(point,imageR,X,Y); Eblock ATes Bblock Eblock ETes Eblock end_image RETIF(imageR); Eblock EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* R E M O N T E E D U N O I R : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Iremontee_du_NOIR(imageR,imageA)))) /* Cette fonction a ete introduite le 20040910161628 pour permettre de renormaliser des */ /* images ayant subies un 'Ipasse_bande(...)' au prealable. En fait a defaut de cela, la */ /* renormalisation est en general ineffective parce que le minimum de l'image est deja le */ /* NOIR. Il faut donc remonter celui-ci pour pouvoir disposer de tous les niveaux... */ /* */ /* On notera le 20040913111345 que la fonction "descente du BLANC" peut s'obtenir simplement */ /* par une complementation avant et une complementation apres (la remontee du 'NOIR'). Cela */ /* a ete introduit dans 'v $xci/remonte_NOIR$K 20040913111603'. */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] le 'NOIR' ayant ete "remonte". */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ CALS(Ihistogramme(imageA)); /* Calcul de l'histogramme de 'imageA'. */ Test(IFOU(IZEQ(ACCES_HISTOGRAMME(NEUT(NOIR))) ,IZNE(ACCES_HISTOGRAMME(SUCN(NOIR))) ) ) Bblock iMOVE(imageR,imageA); /* On ne peut remonter le 'NOIR' car il est soit absent, soit le niveau qui le suit est */ /* deja occupe ; 'imageA' est donc conservee en l'etat... */ Eblock ATes Bblock DEFV(genere_p,INIT(niveau_courant,SUCN(NOIR))); /* Niveau courant de balayage de l'histogramme de 'imageA'. */ DEFV(genere_p,INIT(niveau_de_remplacement_du_NOIR,NOIR)); /* Futur niveau de remplacement du 'NOIR' actuel (a priori, il ne changera pas...). */ DEFV(Logical,INIT(poursuivre_la_recherche_du_niveau_de_remplacement_du_NOIR,VRAI)); /* Futur niveau de remplacement du 'NOIR' actuel qui n'a pas encore ete trouve... */ Tant(EST_VRAI(poursuivre_la_recherche_du_niveau_de_remplacement_du_NOIR)) Bblock Test(IZEQ(ACCES_HISTOGRAMME(NEUT(niveau_courant)))) Bblock Test(IZNE(ACCES_HISTOGRAMME(SUCN(niveau_courant)))) Bblock EGAL(niveau_de_remplacement_du_NOIR,niveau_courant); EGAL(poursuivre_la_recherche_du_niveau_de_remplacement_du_NOIR,FAUX); /* On a trouve le niveau de remplacement du 'NOIR' et on arrete... */ Eblock ATes Bblock Eblock ETes Eblock ATes Bblock EGAL(poursuivre_la_recherche_du_niveau_de_remplacement_du_NOIR,FAUX); /* On n'a pas trouve de niveau de remplacement du 'NOIR', mais on est oblige de s'arreter */ /* car on n'a pas trouve de suite de niveaux vides apres le 'NOIR'... */ Eblock ETes Test(IFGE(niveau_courant,PREN(BLANC))) Bblock EGAL(poursuivre_la_recherche_du_niveau_de_remplacement_du_NOIR,FAUX); /* On a tout explore sans rien trouver... */ Eblock ATes Bblock INCR(niveau_courant,PAS_COULEURS); Eblock ETes Eblock ETan begin_image Bblock DEFV(genere_p,INIT(ancien__niveau,load_point(imageA,X,Y))); DEFV(genere_p,INIT(nouveau_niveau,niveau_de_remplacement_du_NOIR)); /* Ancien, puis nouveau niveau au point {X,Y} a priori... */ Test(IFNE(ancien__niveau,NOIR)) Bblock EGAL(nouveau_niveau,ancien__niveau); /* Un point non 'NOIR' est conserve... */ Eblock ATes Bblock /* Un point 'NOIR' est "remonte"... */ Eblock ETes store_point(nouveau_niveau ,imageR ,X,Y ,FVARIABLE ); /* Et enfin, mise a jour de 'imageR'... */ Eblock end_image Eblock ETes RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* C O M P A C T A G E D E S N I V E A U X : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Icompactage_des_niveaux(imageR,imageA)))) /* Cette fonction a ete introduite le 20040911094451 pour permettre de generaliser la */ /* fonction 'Iremontee_du_NOIR(...)'. */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] avec les niveaux compactes. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(genere_p,INIT(niveau_compacte,NOIR)); /* Niveau courant compacte. */ /*..............................................................................................................................*/ CALS(Ihistogramme(imageA)); /* Calcul de l'histogramme de 'imageA'. */ BoIn(niveau_courant,NOIR,BLANC,PAS_COULEURS) Bblock Test(IZNE(ACCES_HISTOGRAMME(niveau_courant))) Bblock /* Cas ou 'niveau_courant' est present dans 'imageA' : */ MODIFICATION_LISTE_DE_SUBSTITUTION(niveau_courant,niveau_compacte); INCR(niveau_compacte,PAS_COULEURS); /* Ainsi dans 'imageR', les niveaux seront consecutifs dans [NOIR,...]. */ Eblock ATes Bblock /* Cas ou 'niveau_courant' est absent dans 'imageA' : */ MODIFICATION_LISTE_DE_SUBSTITUTION(niveau_courant,NIVEAU_UNDEF); /* Les niveaux non presents dans 'imageA' vont donc disparaitre, l'initialisation avec */ /* 'NIVEAU_UNDEF' etant juste une question "hygienique"... */ Eblock ETes Eblock EBoI PUSH_FILTRAGE; /* Sauvegarde de l'etat courant de filtrage des niveaux. */ SET_FILTRAGE(ACTIF); /* On autorise tous les filtrages afin d'avoir la 'SUBSTITUTION'. */ PUSH_SUBSTITUTION; /* Sauvegarde de la substitution courante. */ SUBSTITUTION(L_SUBSTITUTION_VARIABLE); /* Mise en place de la substitution de compactage. */ iMOVE(imageR,imageA); /* Deplacement de l'image avec compactage des niveaux. */ PULL_SUBSTITUTION; PULL_FILTRAGE; /* Et restauration des conditions initiales... */ RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* E N T R E L A C A G E L I N E A I R E D I R E C T D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ #define INDEXATION_D_ENTRELACAGE_LINEAIRE(x,y) \ AXPB(COYR(y),dimX,COXR(x)) #define PROGRESSION_DE_LINDEX_D_ENTRELACAGE_LINEAIRE \ Bblock \ INCR(index_courant_d_entrelacage,pas_d_entrelacage); \ \ Test(IFGT(index_courant_d_entrelacage,INDEXATION_D_ENTRELACAGE_LINEAIRE(Xmax,Ymax))) \ Bblock \ INCR(index_initial_d_entrelacage,I); \ EGAL(index_courant_d_entrelacage,index_initial_d_entrelacage); \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Ientrelacage_lineaire_direct(imageR,imageA,pas_d_entrelacage)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat egale a l'image Argument entrelacee lineairement. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Int,pas_d_entrelacage)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Int,INIT(index_initial_d_entrelacage,INDEXATION_D_ENTRELACAGE_LINEAIRE(Xmin,Ymin))); DEFV(Int,INIT(index_courant_d_entrelacage,UNDEF)); /*..............................................................................................................................*/ EGAL(index_courant_d_entrelacage,index_initial_d_entrelacage); begin_image Bblock DEFV(genere_p,INIT(niveau_courant,NIVEAU_UNDEF)); DEFV(Int,INIT(X_entrelace,COXA(REST(index_courant_d_entrelacage,dimX)))); DEFV(Int,INIT(Y_entrelace,COYA(DIVI(index_courant_d_entrelacage,dimX)))); EGAL(niveau_courant,load_point(imageA,X_entrelace,Y_entrelace)); store_point(niveau_courant ,imageR ,X,Y ,FVARIABLE ); /* Ainsi, des points distants sont rapproches. */ PROGRESSION_DE_LINDEX_D_ENTRELACAGE_LINEAIRE; Eblock end_image RETI(imageR); Eblock EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* E N T R E L A C A G E L I N E A I R E I N V E R S E D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Ientrelacage_lineaire_inverse(imageR,imageA,pas_d_entrelacage)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat egale a l'image Argument desentrelacee lineairement. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Int,pas_d_entrelacage)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Int,INIT(index_initial_d_entrelacage,INDEXATION_D_ENTRELACAGE_LINEAIRE(Xmin,Ymin))); DEFV(Int,INIT(index_courant_d_entrelacage,UNDEF)); /*..............................................................................................................................*/ EGAL(index_courant_d_entrelacage,index_initial_d_entrelacage); begin_image Bblock DEFV(genere_p,INIT(niveau_courant,load_point(imageA,X,Y))); /* Niveau courant au point courant... */ DEFV(Int,INIT(X_entrelace,COXA(REST(index_courant_d_entrelacage,dimX)))); DEFV(Int,INIT(Y_entrelace,COYA(DIVI(index_courant_d_entrelacage,dimX)))); store_point(niveau_courant ,imageR ,X_entrelace,Y_entrelace ,FVARIABLE ); /* Ainsi, des points proches sont eloignes. */ PROGRESSION_DE_LINDEX_D_ENTRELACAGE_LINEAIRE; Eblock end_image RETI(imageR); Eblock EFonctionP #undef PROGRESSION_DE_LINDEX_D_ENTRELACAGE_LINEAIRE #undef INDEXATION_D_ENTRELACAGE_LINEAIRE _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* " S H U F F L I N G " D I R E C T D ' U N E I M A G E */ /* C O N S E R V A N T L E N O M B R E D E P O I N T S D E N I V E A U D O N N E : */ /* */ /*************************************************************************************************************************************/ /* 'Ishuffling_direct(...)' a ete deplace depuis 'v $xiii/aleat.1$FON' le 20081008120850 */ /* a cause de 'Iegalisation_d_histogrammme_plat(...)' qui l'utilise alors. Du coup, tous */ /* les '$K' qui referencent 'image_image_DI_IMAGE_EXT' (c'est-a-dire tous...) demandaient */ /* aussi 'image_image_ALEATOIRES_1_EXT'. Pour ne pas avoir a tout recompiler, la fonction */ /* 'Ishuffling_direct(...)' a donc ete deplacee... */ BFonctionP DEFV(Common,DEFV(Logical,SINT(Ishuffling_direct_____compatibilite_20040106,FAUX))); /* Permet de generer des images suivant la methode anterieure au 20040106093405 en */ /* ce qui concerne la modification de la graine en fonction des coordonnees {X,Y}. */ /* Anterieurement au 20040106093405 cette facon de modifier la graine faisait que pour */ /* les points de la droite Y=X la graine etait modifiee identiquement pour les deux */ /* coordonnees 'X' et 'Y'. A compter de cette date, la pertubation apportee a la graine */ /* passe donc de {+X,+Y} a {-X,+Y} ce qui, etant donne que les coordonnees sont positives, */ /* ne peut jamais donner la meme graine "effective" : 'graine-X' et 'graine+Y' ne peuvent */ /* etre egaux puisque l'on ne peut avoir Y=-X... */ DEFV(Common,DEFV(Logical,SINT(Ishuffling_direct_____faire_la_transformation_directe,VRAI))); /* Permet de faire au choix la transformation directe ('VRAI') ou inverse ('FAUX'). Ceci */ /* fut introduit le 20081008104956... */ #define POINTS_NON_MARQUES \ BLANC \ /* Points qui n'ont pas encore ete marques, */ #define POINTS_MARQUES \ NIVEAU_UNDEF \ /* Points qui ont ete marques ; on prend 'NIVEAU_UNDEF', afin de traiter */ \ /* d'une facon identique les points deja marques, et les points inexistants... */ DEFV(Common,DEFV(FonctionP,POINTERp(Ishuffling_direct(imageR ,imageA ,graine ,force_le_long_de_OX ,force_le_long_de_OY ,niveaux_a_traiter ) ) ) ) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X+rdn(X,Y)][Y+rdn(X,Y)]=imageA[X][Y]. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument a "shuffliser"... */ DEFV(Argument,DEFV(Int,graine)); /* Graine arbitraire dont depend la generation. */ DEFV(Argument,DEFV(Float,force_le_long_de_OX)); DEFV(Argument,DEFV(Float,force_le_long_de_OY)); /* Force de la "shufflisation" dans [0,1] le long des axes 'OX' et 'OY' respectivement ; les */ /* valeurs suivantes donnent : */ /* */ /* force{X,Y}=0 : (imageR)=(imageA) (pas de "shufflisation"), */ /* force{X,Y}=1 : la "shufflisation" est maximale... */ /* */ /* Evidemment, lorsque ces deux parametres sont egaux, la force est "isotrope"... */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_a_traiter,COULEURS))); /* Definit les niveaux sur lesquels on doit faire le "shuffling" direct... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(pointI_2D,point_courant); /* Point (entier) courant. */ BDEFV(image,points_marques); /* Image du type "masque" dans laquelle on memorise les points qui ont deja ete */ /* atteints ; en effet, on ne peut utiliser "imageR" et tester les points NOIRs */ /* puisque l'on ne peut distinguer les points non encore marques (donc mis ini- */ /* tialement a NOIR) et les points qui sont NOIRs dans 'imageA' et que l'on */ /* deplace... */ SPIRALE_DEFINITION /* Donnees de generation d'une spirale de parcours d'une image. */ BDEFV(imageI,transformation_directe_X); BDEFV(imageI,transformation_directe_Y); BDEFV(imageI,transformation_inverse_X); BDEFV(imageI,transformation_inverse_Y); /* Images definissant les transformations des coordonnees (introduite le 20081008104956). */ /*..............................................................................................................................*/ SPIRALE_VALIDATION; /* Validation des pas de parcours (pasX,pasY) des images. */ Test(IFEQ(NIVEAU_UNDEF,POINTS_NON_MARQUES)) Bblock PRINT_ERREUR("'NIVEAU_UNDEF' et 'POINTS_NON_MARQUES' ne peuvent etre egaux afin de traiter les 'hors-ecrans'"); Eblock ATes Bblock Eblock ETes Test(IFNE(NIVEAU_UNDEF,POINTS_MARQUES)) Bblock PRINT_ERREUR("'NIVEAU_UNDEF' et 'POINTS_MARQUES' doivent etre egaux afin de traiter les 'hors-ecrans'"); Eblock ATes Bblock Eblock ETes Test(IFEQ(POINTS_MARQUES,POINTS_NON_MARQUES)) Bblock PRINT_ERREUR("'POINTS_MARQUES' et 'POINTS_NON_MARQUES' ne peuvent etre egaux afin de traiter le 'NOIR'"); Eblock ATes Bblock Eblock ETes CALS(Inoir(imageR)); /* Initialisation du resultat. */ CALS(Iinitialisation(points_marques,POINTS_NON_MARQUES)); /* Initialisation de la "liste" des points deja marques. */ INITIALISATION_POINT_2D(point_courant,Xmin,Ymin); CALS(rdnI2D(ADRESSE(point_courant) ,UNDEF ,RDN_INIT ,FLOT(NEGA(PLUS_PETITE_IMAGE_CARREE_CIRCONSCRITE)) ,FLOT(PLUS_PETITE_IMAGE_CARREE_CIRCONSCRITE) ) ); /* Initialisation du generateur aleatoire. */ begin_image Bblock DEFV(genere_p,INIT(niveau_courant,load_point(imageA,X,Y))); /* Niveau courant au point courant... */ SPIRALE_REINITIALISATION_BRAS; /* Reinitialisation de la spirale en son centre, sans reinitialiser la direction */ /* et le sens du bras courant... */ Test(EST_VRAI(ITb1(niveaux_a_traiter,INDX(niveau_courant,NOIR)))) Bblock /* Traitement des points a "shuffler"... */ INITIALISATION_POINT_2D(point_courant ,ADD2(X ,INTE(MUL2(force_le_long_de_OX ,rdnI2D(ADRESSE(point_courant) ,COND(IL_FAUT(Ishuffling_direct_____compatibilite_20040106) ,ADD2(graine,X) ,ADD2(graine,NEGA(X)) ) ,RDN_GENERE ,FLOT__ARGUMENT_ABSENT ,FLOT__ARGUMENT_ABSENT ) ) ) ) ,ADD2(Y ,INTE(MUL2(force_le_long_de_OY ,rdnI2D(ADRESSE(point_courant) ,COND(IL_FAUT(Ishuffling_direct_____compatibilite_20040106) ,ADD2(graine,Y) ,ADD2(graine,NEUT(Y)) ) ,RDN_GENERE ,FLOT__ARGUMENT_ABSENT ,FLOT__ARGUMENT_ABSENT ) ) ) ) ); /* Ainsi, on deplace aleatoirement le point courant {X,Y} ; la modification */ /* de "graine" par 'X' puis 'Y' est destinee a produire deux valeurs aleatoires */ /* differentes pour les abscisses et les ordonnees. */ Tant(IFEQ(load_point_valide(points_marques,ASD1(point_courant,x),ASD1(point_courant,y)),POINTS_MARQUES)) Bblock /* Ainsi, on cherche "en spirale" le premier point non marques a partir du point */ /* courant {X,Y} deplace aleatoirement ; on notera, qu'etant donne la valeur */ /* donnee a 'POINTS_MARQUES', on traite simultanement les "hors-ecrans". */ SPIRALE_INITIALISATION; /* Initialisation dynamique de 'spirale_nombre_de_points_a_traiter'. */ SPIRALE_DEPLACEMENT(ASD1(point_courant,x),ASD1(point_courant,y)); /* Deplacement du point courant de la spirale... */ /* ATTENTION : on n'utilise pas 'SPIRALE_DEPLACEMENT_ET_PARCOURS(...)' afin de garantir la */ /* terminaison du processus 'Tant(...)'. */ SPIRALE_PARCOURS; /* Parcours de la spirale avec rotation eventuelle de PI/2 du bras courant... */ Eblock ETan storeI_point(ASD1(point_courant,x),transformation_directe_X,X,Y); storeI_point(ASD1(point_courant,y),transformation_directe_Y,X,Y); storeI_point(X,transformation_inverse_X,ASD1(point_courant,x),ASD1(point_courant,y)); storeI_point(Y,transformation_inverse_Y,ASD1(point_courant,x),ASD1(point_courant,y)); /* Ainsi, on memorise les transformations directe et inverse (introduit le 20081008104956). */ /* */ /* ATTENTION : en procedant ainsi, on notera qu'un seul point 'point_courant' est positionne */ /* a partir du point {X,Y} ; cela fait donc que le nombre de points de niveau donne est */ /* conserve en passant de 'imageA' a 'imageR'. C'est la la difference fondamentale avec la */ /* fonction 'Ishuffling_inverse(...)'. */ store_point(POINTS_MARQUES,points_marques,ASD1(point_courant,x),ASD1(point_courant,y),FVARIABLE); /* Puis on memorise le marquage. */ Eblock ATes Bblock /* Traitement des points a ne pas "shuffler"... */ INITIALISATION_POINT_2D(point_courant,X,Y); /* Ainsi, le point courant {X,Y} ne sera pas deplace. Ceci est a priori inutile, mais on */ /* ne sait jamais, pour plus tard... */ Eblock ETes Eblock end_image begin_image Bblock DEFV(genere_p,INIT(niveau_courant,load_point(imageA,X,Y))); /* Niveau courant au point courant... */ Test(IL_FAUT(Ishuffling_direct_____faire_la_transformation_directe)) Bblock store_point(niveau_courant ,imageR ,loadI_point(transformation_directe_X,X,Y) ,loadI_point(transformation_directe_Y,X,Y) ,FVARIABLE ); /* Ainsi, on deplace aleatoirement le point courant {X,Y} de facon directe. */ Eblock ATes Bblock store_point(niveau_courant ,imageR ,loadI_point(transformation_inverse_X,X,Y) ,loadI_point(transformation_inverse_Y,X,Y) ,FVARIABLE ); /* Ainsi, on deplace aleatoirement le point courant {X,Y} de facon inverse. Ceci fut */ /* introduit le 20081008104956 pour 'v $xiii/di_image$FON Ishuffling_direct'. */ Eblock ETes Eblock end_image EDEFV(imageI,transformation_inverse_Y); EDEFV(imageI,transformation_inverse_X); EDEFV(imageI,transformation_directe_Y); EDEFV(imageI,transformation_directe_X); /* Images definissant les transformations des coordonnees (introduite le 20081008104956). */ EDEFV(image,points_marques); /* Image du type "masque" dans laquelle on memorise les points qui ont deja ete */ /* atteints ; en effet, on ne peut utiliser "imageR" et tester les points NOIRs */ /* puisque l'on ne peut distinguer les points non encore marques (donc mis ini- */ /* tialement a NOIR) et les points qui sont NOIRs dans 'imageA' et que l'on */ /* deplace... */ RETI(imageR); Eblock #undef POINTS_MARQUES #undef POINTS_NON_MARQUES EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* E G A L I S A T I O N D ' H I S T O G R A M M E D ' U N E I M A G E " S T A N D A R D " */ /* P A R U T I L I S A T I O N D E S O N H I S T O G R A M M E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(Logical,SINT(Iegalisation_d_histogrammme_effectif_____faire_l_egalisation,VRAI))); /* Indicateur introduit le 20081005181647 afin de permettre de recuperer la version */ /* de 'imageA' substituee par son histogramme (donc sans faire l'ehalisation...). */ DEFV(Common,DEFV(Logical,SINT(Iegalisation_d_histogrammme_effectif_____editer_la_transformation_d_egalisation,FAUX))); /* Indicateur introduit le 20081006160742 afin de permettre d'editer la table de */ /* transformation assurant l'egalisation. */ DEFV(Common,DEFV(Logical,SINT(Iegalisation_d_histogrammme_effectif_____substituer_suivant_l_histogrammme_avant_egalisation,FAUX))); DEFV(Common,DEFV(Logical,SINT(Iegalisation_d_histogrammme_effectif_____substituer_suivant_l_histogrammme_apres_egalisation,FAUX))); /* Indicateur introduit le 20081005104547 afin de permettre des "experiences" sur le tri */ /* eventuel de l'histogramme... */ /* On notera que les valeurs : */ /* */ /* faire_l_egalisation=FAUX */ /* substituer_suivant_l_histogrammme_avant_egalisation=VRAI */ /* substituer_suivant_l_histogrammme_apres_egalisation=FAUX */ /* */ /* donne dans 'imageR' une version de 'imageA' ou les niveaux codent l'histogramme des */ /* niveaux de 'imageA' ; ainsi le 'NOIR' montre les points possedant le niveau le moins */ /* utilise alors que le 'BLANC' montre les points possedant le niveau le plus utilise... */ DEFV(Common,DEFV(FonctionP,POINTERp(Iegalisation_d_histogrammme_effectif(imageR,imageA)))) /* Cette fonction a ete introduite le 20081001140118... */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] avec un histogramme egalise... */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock BDEFV(image,imageA_eventuellement_substituee); BDEFV(image,imageR_eventuellement_substituee); /* Images correspondant a priori respectivement a 'imageA' et a 'imageR', mais pouvant */ /* etre triee via l'histogramme de 'imageA'... */ /*..............................................................................................................................*/ CALS(Ihistogramme(imageA)); /* Calcul de l'histogramme de 'imageA'. */ Test(IL_FAUT(Iegalisation_d_histogrammme_effectif_____substituer_suivant_l_histogrammme_avant_egalisation)) /* Test introduit le 20081005104547... */ Bblock BSaveModifyVariable(Logical,Nsubstitution_____utiliser_effectivement_la_substitution_directe,FAUX); /* Afin d'utiliser la liste inverse de 'L_SUBSTITUTION_HISTOGRAMME'... */ /* */ /* Mis sous cette forme le 20101115152408... */ PUSH_FILTRAGE; /* Sauvegarde de l'etat courant de filtrage des niveaux. */ SET_FILTRAGE(ACTIF); /* On autorise tous les filtrages afin d'avoir la 'SUBSTITUTION'. */ PUSH_SUBSTITUTION; /* Sauvegarde de la substitution courante. */ SUBSTITUTION(L_SUBSTITUTION_HISTOGRAMME); /* Afin de trier l'histogramme. */ iMOVE(imageA_eventuellement_substituee,imageA); /* 'imageA' substituee via son histogramme : ainsi, le niveau 'N' sera remplace par */ /* leur classement (suivant le nombre de points possedant le niveau 'N'). Ainsi, les */ /* points 'NOIR' correspondront aux points dont le niveau est le moins represente, alors */ /* que les points 'BLANC' correspondront aux points dont le niveau est le plus represente... */ PULL_SUBSTITUTION; PULL_FILTRAGE; ESaveModifyVariable(Logical,Nsubstitution_____utiliser_effectivement_la_substitution_directe); /* Et restauration des conditions initiales... */ /* */ /* Mis sous cette forme le 20101115152408... */ CALS(Ihistogramme(imageA_eventuellement_substituee)); /* Calcul de l'histogramme de 'imageA' substituee... */ Eblock ATes Bblock iMOVE(imageA_eventuellement_substituee,imageA); /* 'imageA' non traitee... */ Eblock ETes Test(IL_FAUT(Iegalisation_d_histogrammme_effectif_____faire_l_egalisation)) /* Test introduit le 20081005181647... */ Bblock Test(IL_FAUT(Iegalisation_d_histogrammme_effectif_____editer_la_transformation_d_egalisation)) /* Test introduit le 20081006160742... */ Bblock CALS(FPrme0("Edition de la table d'egalisation :")); CALS(Fsauts_de_lignes(UN)); CALS(Fsauts_de_lignes(UN)); BoIn(niveau,NOIR,BLANC,PAS_COULEURS) Bblock CAL3(Prme5("%0*d --> %0*d (%.^^^)\n" ,NOMBRE_DE_CHIFFRES_DECIMAUX_D_EDITION_DES_NIVEAUX ,niveau ,NOMBRE_DE_CHIFFRES_DECIMAUX_D_EDITION_DES_NIVEAUX ,INTE(__DENORMALISE_NIVEAU(ACCES_HISTOGRAMME_CUMULE___NORMALISE(niveau))) ,F___DENORMALISE_NIVEAU(ACCES_HISTOGRAMME_CUMULE___NORMALISE(niveau)) ) ); /* C'est grace a cela que l'on voit que deux niveaux 'niveau' successifs peuvent tomber */ /* sur le meme niveau a partir de deux valeurs differentes obtenues grace a l'histogramme */ /* cumule normalise et ce en passant des flottants aux entiers. Ainsi, par exemple : */ /* */ /* Pal */ /* */ /* $xci/trefle$X \ */ /* $formatI | \ */ /* $xci/egaliseH.01$X \ */ /* R=$xTV/TREFLE \ */ /* lister=VRAI \ */ /* $formatI */ /* */ /* donne en particulier : */ /* */ /* 185 --> 197 (197.294949832775927) */ /* === === */ /* */ /* 186 --> 197 (197.969832775919713) */ /* === === */ /* */ /* Il y a assez peu de moyens d'eviter cela, d'autant plus que ces "COLLISIONS" permettent */ /* justement d'egaliser, comme cela se voit, dans le cas precedent, avec les premiers */ /* niveaux : */ /* */ /* 016 --> 001 (1.01943143812709036) */ /* 017 --> 001 (1.08424749163879608) */ /* 018 --> 001 (1.15190635451505008) */ /* 019 --> 001 (1.20421404682274247) */ /* 020 --> 001 (1.26561872909699002) */ /* 021 --> 001 (1.33384615384615390) */ /* 022 --> 001 (1.38785953177257526) */ /* 023 --> 001 (1.45608695652173914) */ /* 024 --> 001 (1.50612040133779268) */ /* 025 --> 001 (1.57719063545150506) */ /* 026 --> 001 (1.63063545150501654) */ /* 027 --> 001 (1.69090301003344479) */ /* 028 --> 001 (1.76026755852842798) */ /* 029 --> 001 (1.81541806020066887) */ /* 030 --> 001 (1.90297658862876240) */ /* */ /* par exemple... */ /* */ /* Au passage, cela explique aussi les "TROUS" ; ainsi par exemple : */ /* */ /* 041 --> 017 (17.5492307692307712) */ /* ### ## */ /* */ /* 042 --> 019 (19.9315050167224079) */ /* ### ## */ /* */ /* ou il manque 18 entre 17 et 19... */ /* */ /* Le 20091123122720, le format "^^g" est passe a "^^^" pour plus de souplesse... */ /* */ /* Pour 'v $xig/fonct$vv$FON chain_Acopie_avec_gestion_des_formats_des_editions_entieres' */ /* il a fallu introduire un 'INTE(...)'s par prudence au cas ou l'expression ne serait */ /* pas du type 'Int' (introduit le 20131206165911). */ Eblock EBoI Eblock ATes Bblock Eblock ETes begin_image Bblock store_point(__DENORMALISE_NIVEAU(ACCES_HISTOGRAMME_CUMULE___NORMALISE(load_point(imageA_eventuellement_substituee,X,Y))) ,imageR_eventuellement_substituee ,X,Y ,FVARIABLE ); /* Ce calcul repose sur le raisonnement suivant : */ /* */ /* Soit : */ /* */ /* H(n) : l'histogramme du niveau 'n', */ /* HC(n) : l'histogramme du niveau cumule du niveau 'n', c'est-a-dire : */ /* */ /* p=n */ /* ________ */ /* \ */ /* \ */ /* HC(n) = / H(p) */ /* / */ /* -------- */ /* p=NOIR */ /* */ /* ou l'indice 'n' (et donc aussi l'indice 'p') varie dans [NOIR,BLANC]. */ /* */ /* P(n) : la probabilite que le niveau d'un point vaille 'n', c'est-a-dire : */ /* */ /* */ /* 1 */ /* P(n) = ---.H(n) */ /* N */ /* */ /* ou 'N' est le nombre de points de l'image (soit 'dimXY'). */ /* */ /* A : l'image Argument (dont on veut egaliser l'histogramme), */ /* R : l'image Resultat (apres egalisation de l'histogramme). */ /* */ /* PA : la densite de probabilite de 'A', */ /* PR : la densite de probabilite de 'R', c'est-a-dire : */ /* */ /* PA(a)da : probalilite de trouver un niveau compris dans [a,a+da]. */ /* PR(r)dr : probalilite de trouver un niveau compris dans [r,r+dr]. */ /* */ /* On veut alors : */ /* */ /* PR(r)dr = PA(a)da */ /* */ /* avec : */ /* */ /* PR(r) = K = constante (puisque l'histogramme de 'R' doit etre "plat"). */ /* */ /* On a donc : */ /* */ /* BLANC BLANC */ /* / / */ /* | | */ /* | PR(r)dr = | PA(a)da = 1 (puisqu'il y a conservation du nombre de */ /* | | points en allant de 'A' vers 'R'). */ /* / / */ /* NOIR NOIR */ /* */ /* d'ou : */ /* */ /* BLANC BLANC */ /* / / */ /* | | */ /* | K.dr = K. | dr = K.(BLANC-NOIR) = 1 */ /* | | */ /* / / */ /* NOIR NOIR */ /* */ /* 1 */ /* K = ------------ */ /* BLANC-NOIR */ /* */ /* d'ou : */ /* */ /* 1 1 */ /* PA(a)da = PR(r)dr = ------------.dr = ------------.T(da) */ /* BLANC-NOIR BLANC-NOIR */ /* */ /* ou 'T' designe la transformation passant des niveaux de 'A' a ceux de 'R' : */ /* */ /* dr = T(da) */ /* */ /* D'ou : */ /* */ /* T(da) = (BLANC-NOIR).PA(a)da */ /* */ /* d'ou en integrant : */ /* */ /* n n n */ /* / / / */ /* | | | */ /* T(n) = | T(da) = | (BLANC-NOIR).PA(a)da = (BLANC-NOIR). | PA(a)da */ /* | | | */ /* / / / */ /* NOIR NOIR NOIR */ /* */ /* d'ou : */ /* */ /* T(n) = (BLANC-NOIR).HC(n) */ /* */ /* ce qui signifie que l'on remplace le niveau 'n' par '(BLANC-NOIR).HC(n)'... */ /* */ /* Evidemment, cette methode produit des "regroupements" de niveaux et donc introduit des */ /* "trous" dans l'histogramme de l'image Resultat (c'est-a-dire des niveaux vides, sans */ /* aucun point le possedant...). */ Eblock end_image Eblock ATes Bblock iMOVE(imageR_eventuellement_substituee,imageA_eventuellement_substituee); /* Pas d'egalisation pour 'imageA'... */ Eblock ETes Test(IL_FAUT(Iegalisation_d_histogrammme_effectif_____substituer_suivant_l_histogrammme_apres_egalisation)) /* Test introduit le 20081005104547... */ Bblock CALS(Ihistogramme(imageA)); /* Recalcul de l'histogramme de 'imageA' afin de pouvoir utiliser la la liste */ /* 'L_SUBSTITUTION_HISTOGRAMME'... */ PUSH_FILTRAGE; /* Sauvegarde de l'etat courant de filtrage des niveaux. */ SET_FILTRAGE(ACTIF); /* On autorise tous les filtrages afin d'avoir la 'SUBSTITUTION'. */ PUSH_SUBSTITUTION; /* Sauvegarde de la substitution courante. */ SUBSTITUTION(L_SUBSTITUTION_HISTOGRAMME); /* Afin de trier l'histogramme. */ iMOVE(imageR,imageR_eventuellement_substituee); /* 'imageR' substituee via l'histogramme de 'imageA'... . */ PULL_SUBSTITUTION; PULL_FILTRAGE; /* Et restauration des conditions initiales... */ Eblock ATes Bblock iMOVE(imageR,imageR_eventuellement_substituee); /* 'imageR' non traitee... */ Eblock ETes EDEFV(image,imageR_eventuellement_substituee); EDEFV(image,imageA_eventuellement_substituee); /* Images correspondant a priori respectivement a 'imageA' et a 'imageR', mais pouvant */ /* etre triee via l'histogramme de 'imageA'... */ RETI(imageR); Eblock EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* E G A L I S A T I O N D ' H I S T O G R A M M E D ' U N E I M A G E " S T A N D A R D " */ /* P A R U T I L I S A T I O N D ' U N P S E U D O - H I S T O G R A M M E " P L A T " P A R D E F A U T : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(Logical,SINT(Iegalisation_d_histogrammme_plat_____etat_de_l_histogramme_plat,INVALIDE))); /* Indicateur introduit le 20081008091439 afin de pouvoir garder l'histogramme "plat" et */ /* surtout pouvoir le generer autrement (non "plat"...) ou le modifier a l'exterieur... */ DEFV(Common,DEFV(Int,DTb1(histogramme_plat,COULEURS))); /* Histogramme "plat" permanent (si besoin est) introduit le 20081008091811... */ DEFV(Common,DEFV(Logical,SINT(Iegalisation_d_histogrammme_plat_____shuffler,FAUX))); DEFV(Common,DEFV(Int,SINT(Iegalisation_d_histogrammme_plat_____graine_du_shuffling,MAGIK))); DEFV(Common,DEFV(Float,SINT(Iegalisation_d_histogrammme_plat_____force_le_long_de_OX_du_shuffling,INVE(FLOT(DOUB(DOUB(SEIZE))))))); DEFV(Common,DEFV(Float,SINT(Iegalisation_d_histogrammme_plat_____force_le_long_de_OY_du_shuffling,INVE(FLOT(DOUB(DOUB(SEIZE))))))); /* Parametres de "shuffling" introduits le 20081008111950. Un eventuel "shuffling" permet */ /* de "decorreler" l'egalisation car, en effet, en son absence, les points sont traites */ /* sequentiellement (via 'begin_image') ce qui fait que cela peut introduire des artefacts */ /* visibles. Le "shuffling" eloigne donc les uns des autres les points voisins... */ DEFV(Common,DEFV(FonctionP,POINTERp(Iegalisation_d_histogrammme_plat(imageR,imageA)))) /* Cette fonction a ete introduite le 20081007154849... */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] avec un histogramme plat... */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Logical,DTb1(niveaux_a_traiter,COULEURS)); BDEFV(image,imageA_shufflee); BDEFV(image,imageR_shufflee); /* Donnees necessaires au "shuffling"... */ DEFV(Int,DTb1(histogramme_plat_temporaire,COULEURS)); /* Histogramme "plat" temporaire (et destructible...). */ DEFV(Int,INIT(niveau_courant_de_imageR,NOIR)); /* Niveau d'egalisation... */ /* */ /* Le 20081008094432 'genere_p' a ete change en 'Int' a cause du test de validation final. */ /*..............................................................................................................................*/ Test(IL_FAUT(Iegalisation_d_histogrammme_plat_____shuffler)) /* Test introduit le 20081008111950... */ Bblock BoIn(niveau,NOIR,BLANC,PAS_COULEURS) Bblock EGAL(ITb1(niveaux_a_traiter,INDX(niveau,NOIR)),VRAI); /* Initialisation telle que tous les niveaux puissent subir a priori le "shuffling"... */ Eblock EBoI BSaveModifyVariable(Logical,Ishuffling_direct_____faire_la_transformation_directe,VRAI); /* Mis sous cette forme le 20101115152408... */ CALS(Ishuffling_direct(imageA_shufflee ,imageA ,Iegalisation_d_histogrammme_plat_____graine_du_shuffling ,Iegalisation_d_histogrammme_plat_____force_le_long_de_OX_du_shuffling ,Iegalisation_d_histogrammme_plat_____force_le_long_de_OY_du_shuffling ,niveaux_a_traiter ) ); /* 'imageA' shufflee de facon "directe" et dont les points voisins sont donc eloignes */ /* les uns des autres... */ ESaveModifyVariable(Logical,Ishuffling_direct_____faire_la_transformation_directe); /* Mis sous cette forme le 20101115152408... */ Eblock ATes Bblock iMOVE(imageA_shufflee,imageA); /* 'imageA' non shufflee... */ Eblock ETes GENERATION_D_UN_PSEUDO_HISTOGRAMME_PLAT(histogramme_plat); /* Si besoin est, l'histogramme "plat" est genere. On notera qu'en fait il a pu etre genere */ /* a l'exterieur de 'Iegalisation_d_histogrammme_plat(...)' et donc en fait ne pas etre */ /* "plat" (il peut meme a voir des trous : voir le 'Tant(...)' qui est utilise dans la */ /* procedure 'v $xiii/di_image$DEF GENERATION_D_UN_PSEUDO_HISTOGRAMME_PLAT'). Ceci fut */ /* introduit sous cette forme le 20081008091811... */ BoIn(niveau,NOIR,BLANC,PAS_COULEURS) Bblock EGAL(ITb1(histogramme_plat_temporaire,INDX(niveau,NOIR)),ITb1(histogramme_plat,INDX(niveau,NOIR))); /* Mise en place de histogramme "plat" temporaire... */ Eblock EBoI BoIn(niveau_de_balayage_de_imageA,NOIR,BLANC,PAS_COULEURS) Bblock begin_image Bblock Test(IFEQ(niveau_de_balayage_de_imageA,load_point(imageA_shufflee,X,Y))) Bblock Tant(IFET(IZEQ(ITb1(histogramme_plat_temporaire,INDX(niveau_courant_de_imageR,NOIR))) ,IFLT(niveau_courant_de_imageR,BLANC) ) ) /* Ce 'Tant(...)' permet d'envisager le cas ou 'histogramme_plat' possede lui-meme des */ /* trous, ce qui peut arriver via 'v $xci/egaliseH.01$K substitution=' qui permet de */ /* generer un histogramme arbitraire ; si par exemple on utilise dans '$xci/egaliseH.01$X' : */ /* */ /* substitution=L_SUBSTITUTION_BLEUE */ /* paletteA=$xiP/cercle.35 */ /* */ /* l'histogramme sera constitue de quatre creneaux separes par trois "trous"... */ Bblock INCR(niveau_courant_de_imageR,PAS_COULEURS); Eblock ETan store_point(niveau_courant_de_imageR ,imageR_shufflee ,X,Y ,FVARIABLE ); /* Substitution d'egalisation... */ DECR(ITb1(histogramme_plat_temporaire,INDX(niveau_courant_de_imageR,NOIR)),I); /* Decompte des points utilises... */ Eblock ATes Bblock Eblock ETes Eblock end_image Eblock EBoI Test(IFGT(niveau_courant_de_imageR,BLANC)) /* Test introduit le 20081008091811... */ Bblock PRINT_ERREUR("probleme de generation d'egalisation a partir d'un histogramme 'plat' -1-"); CAL1(Prer1("(NiveauCourantImageR=%d)\n",niveau_courant_de_imageR)); Eblock ATes Bblock Eblock ETes BoIn(niveau,NOIR,BLANC,PAS_COULEURS) Bblock Test(IZNE(ITb1(histogramme_plat_temporaire,INDX(niveau,NOIR)))) Bblock PRINT_ERREUR("probleme de generation d'egalisation a partir d'un histogramme 'plat' -2-"); CAL1(Prer2("(HistogrammePlat(%d)=%d)\n",niveau,ITb1(histogramme_plat_temporaire,INDX(niveau,NOIR)))); Eblock ATes Bblock Eblock ETes Eblock EBoI Test(IL_FAUT(Iegalisation_d_histogrammme_plat_____shuffler)) /* Test introduit le 20081008111950... */ Bblock BSaveModifyVariable(Logical,Ishuffling_direct_____faire_la_transformation_directe,FAUX); /* Mis sous cette forme le 20101115152408... */ CALS(Ishuffling_direct(imageR ,imageR_shufflee ,Iegalisation_d_histogrammme_plat_____graine_du_shuffling ,Iegalisation_d_histogrammme_plat_____force_le_long_de_OX_du_shuffling ,Iegalisation_d_histogrammme_plat_____force_le_long_de_OY_du_shuffling ,niveaux_a_traiter ) ); /* 'imageR' shufflee de facon "inverse" et dont les points voisins sont donc rapproches */ /* les uns des autres... */ ESaveModifyVariable(Logical,Ishuffling_direct_____faire_la_transformation_directe); /* Mis sous cette forme le 20101115152408... */ Eblock ATes Bblock iMOVE(imageR,imageR_shufflee); /* 'imageR' non shufflee... */ Eblock ETes EDEFV(image,imageR_shufflee); EDEFV(image,imageA_shufflee); /* Donnees necessaires au "shuffling"... */ RETI(imageR); Eblock EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* E G A L I S A T I O N D ' H I S T O G R A M M E D ' U N E I M A G E " S T A N D A R D " : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(Logical,SINT(Iegalisation_d_histogrammme_____utiliser_l_histogramme_effectif_de_l_imageA,VRAI))); /* Indicateur permettant de choisir entre 'Iegalisation_d_histogrammme_effectif(...)' */ /* ('VRAI') et 'Iegalisation_d_histogrammme_plat(....)' ('FAUX'). */ DEFV(Common,DEFV(FonctionP,POINTERp(Iegalisation_d_histogrammme(imageR,imageA)))) /* Cette fonction a ete introduite le 20081007185101 sous cette forme... */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] avec un histogramme egalise... */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ Test(IL_FAUT(Iegalisation_d_histogrammme_____utiliser_l_histogramme_effectif_de_l_imageA)) Bblock CALS(Iegalisation_d_histogrammme_effectif(imageR,imageA)); /* On notera le 20081009154327 que cette methode applatit grossierement l'histogramme tout */ /* en y introduisant des trous et des pics. Malgre tout, elle possede la qualite suivante : */ /* */ /* NiveauAvant(P1)=NiveauAvant(P2) ==> NiveauApres(P1)=NiveauApres(P2) */ /* */ /* ou 'P1' et 'P2' designent deux points quelconques possedant le meme niveau avant */ /* et l'egalisation, propriete qu'ils retrouvent apres... */ Eblock ATes Bblock CALS(Iegalisation_d_histogrammme_plat(imageR,imageA)); /* On notera le 20081009154327 une difference avec la methode precedente ; si l'on a */ /* avant : */ /* */ /* NiveauAvant(P1)=NiveauAvant(P2) */ /* */ /* on peut tres bien avoir apres : */ /* */ /* NiveauApres(P1)#NiveauApres(P2) */ /* */ /* mais, par contre l'histogramme n'a ni trous ni pics... */ Eblock ETes RETI(imageR); Eblock EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* E G A L I S A T I O N D ' H I S T O G R A M M E D ' U N E I M A G E F L O T T A N T E : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFegalisation_d_histogrammme(imageR,imageA)))) /* Cette fonction a ete introduite le 20081001163608... */ DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] avec un histogramme egalise... */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock BDEFV(image,imageA_standard); BDEFV(image,imageA_standard_egalisee); /* Image "standard" equivalente a 'imageA', mais evidemment avec moins de niveaux et sa */ /* version a histogramme egalise... */ DEFV(genere_Float,INIT(nivo_minimum,FLOT__NIVEAU_UNDEF)); DEFV(genere_Float,INIT(nivo_maximum,FLOT__NIVEAU_UNDEF)); /* Extrema de 'imageA' afin de "renormaliser" la translation d'egalisation ci-apres... */ /*..............................................................................................................................*/ CALS(Ifloat_std_avec_renormalisation(imageA_standard,imageA)); CALS(Iegalisation_d_histogrammme(imageA_standard_egalisee,imageA_standard)); /* Calcul de l'histogramme de 'imageA', mais en version "standard", donc "appauvries"... */ CALS(IFnivo_extrema(imageA ,ADRESSE(nivo_minimum) ,ADRESSE(nivo_maximum) ) ); begin_image Bblock DEFV(genere_p,INIT(niveau_avant,load_point(imageA_standard,X,Y))); DEFV(genere_p,INIT(niveau_apres,load_point(imageA_standard_egalisee,X,Y))); storeF_point(ADD2(loadF_point(imageA,X,Y) ,SCAL(FLOT(SOUS(niveau_apres,niveau_avant)) ,FLOT(SOUS(BLANC,NOIR)) ,SOUS(nivo_maximum,nivo_minimum) ) ) ,imageR ,X,Y ); /* Et enfin, reequilibrage des niveaux de 'imageA' en fonction de ce qui s'est fait dans */ /* sa version "standard". On notera le 20081001190628 qu'evidemment cette methode fait */ /* perdre la "continuite" eventuelle de 'imageA', puisque deux niveaux tres proches de */ /* 'imageA' peuvent etre differents dans 'imageA_standard' (par exemple separes d'un */ /* niveau de quantification) et donc encore plus differents dans 'imageA_standard_egalisee' */ /* (par exemple separes de plusieurs niveaux de quantification) et ce a cause des "trous"... */ Eblock end_image EDEFV(image,imageA_standard_egalisee); EDEFV(image,imageA_standard); /* Image "standard" equivalente a 'imageA', mais evidemment avec moins de niveaux et sa */ /* version a histogramme egalise... */ RETIF(imageR); Eblock EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* B I N A R I S A T I O N G E N E R A L E D ' U N E I M A G E P O U R E N F A I R E U N M A S Q U E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Ibinarisation_generale(imageR,imageA,seuil,niveau_inferieur,niveau_superieur)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=niveau_inferieur si imageA[X][Y] <= seuil, */ /* et : =niveau_superieur si imageA[X][Y] > seuil. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(genere_p,seuil)); /* Seuil de binarisation : donne le dernier niveau a mettre a 'NOIR', et par exemple */ /* 'NOIR' (dans ce cas les points 'NOIR's restent 'NOIR's, et tous les autres */ /* deviennent 'BLANC's...). */ DEFV(Argument,DEFV(genere_p,niveau_inferieur)); DEFV(Argument,DEFV(genere_p,niveau_superieur)); /* Niveaux jouant le role du 'NOIR' et du 'BLANC' respectivement... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(genere_p,INIT(valeur,NIVEAU_UNDEF)); /* Valeur a donner au point courant de l'image resultat... */ /*..............................................................................................................................*/ PUSH_FILTRAGE; /* Sauvegarde de l'etat courant de filtrage des niveaux. */ SET_FILTRAGE(ACTIF); /* On autorise tous les filtrages afin d'avoir la 'SUBSTITUTION'. */ PUSH_SUBSTITUTION; /* Sauvegarde de la substitution courante. */ SUBSTITUTION(L_SUBSTITUTION_NEUTRE); /* Afin de generer un vrai masque ne contenant que 'NOIR' et 'BLANC'. */ begin_image Bblock Test(IFLE(load_point(imageA,X,Y),seuil)) Bblock EGAL(valeur,niveau_inferieur); /* Lorsque l'image Argument est inferieure ou egale au seuil, on la met a niveau_inferieur. */ Eblock ATes Bblock EGAL(valeur,niveau_superieur); /* Dans le cas contraire, on force le niveau_superieur, ce qui donne un masque binaire... */ Eblock ETes store_point(valeur,imageR,X,Y,FVARIABLE); Eblock end_image PULL_SUBSTITUTION; PULL_FILTRAGE; /* Et restauration des conditions initiales... */ RETI(imageR); Eblock EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* B I N A R I S A T I O N D ' U N E I M A G E P O U R E N F A I R E U N M A S Q U E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Ibinarisation(imageR,imageA,seuil)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=NOIR si imageA[X][Y] <= seuil, */ /* et : =BLANC si imageA[X][Y] > seuil. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(genere_p,seuil)); /* Seuil de binarisation : donne le dernier niveau a mettre a noir, et par exemple */ /* 'NOIR' (dans ce cas les points 'NOIR's restent 'NOIR's, et tous les autres */ /* deviennent 'BLANC's...). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ CALS(Ibinarisation_generale(imageR,imageA,seuil,NOIR,BLANC)); /* Binarisation... */ RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* B I N A R I S A T I O N F L O U E D ' U N E I M A G E P O U R E N F A I R E U N M A S Q U E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Ibinarisation_floue(imageR,imageA,graine,seuil_inferieur,seuil_superieur)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=NOIR si imageA[X][Y] <= seuil, */ /* et : =BLANC si imageA[X][Y] > seuil, */ /* ou 'seuil' est un niveau aleatoire appartenant au segment */ /* [GENP(seuil_inferieur),GENP(seuil_superieur)] ; ce seuil de binarisation */ /* donne le dernier niveau a mettre a noir. */ /* deviennent 'BLANC's...). */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Int,graine)); /* Graine arbitraire dont depend la generation. */ DEFV(Argument,DEFV(Float,seuil_inferieur)); /* Seuil inferieur du generateur ; 'NOIR' est une valeur possible. */ DEFV(Argument,DEFV(Float,seuil_superieur)); /* Seuil superieur du generateur ; 'BLANC' est une valeur possible. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(pointI_2D,point_courant); /* Point (entier) courant. */ DEFV(genere_p,INIT(valeur,NIVEAU_UNDEF)); /* Valeur a donner au point courant de l'image resultat... */ /*..............................................................................................................................*/ PUSH_FILTRAGE; /* Sauvegarde de l'etat courant de filtrage des niveaux. */ SET_FILTRAGE(ACTIF); /* On autorise tous les filtrages afin d'avoir la 'SUBSTITUTION'. */ PUSH_SUBSTITUTION; /* Sauvegarde de la substitution courante. */ SUBSTITUTION(L_SUBSTITUTION_NEUTRE); /* Afin de generer un vrai masque ne contenant que 'NOIR' et 'BLANC'. */ INITIALISATION_POINT_2D(point_courant,Xmin,Ymin); CALS(rdnI2D(ADRESSE(point_courant),UNDEF,RDN_INIT,seuil_inferieur,seuil_superieur)); /* Initialisation du generateur aleatoire. */ begin_image Bblock INITIALISATION_POINT_2D(point_courant,X,Y); Test(IFLE(load_point(imageA,X,Y) ,GENP(rdnI2D(ADRESSE(point_courant),graine,RDN_GENERE,FLOT__ARGUMENT_ABSENT,FLOT__ARGUMENT_ABSENT)) ) ) /* Generation d'une valeur aleatoire fonction du point courant {X,Y}, */ /* de la graine argument comprise entre les seuils inferieur et */ /* superieur. */ Bblock EGAL(valeur,NOIR); /* Lorsque l'image Argument est inferieure ou egale au seuil, on la met a NOIR. */ Eblock ATes Bblock EGAL(valeur,BLANC); /* Dans le cas contraire, on force le BLANC, ce qui donne bien un masque binaire... */ Eblock ETes store_point(valeur,imageR,X,Y,FVARIABLE); Eblock end_image PULL_SUBSTITUTION; PULL_FILTRAGE; /* Et restauration des conditions initiales... */ RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* B I N A R I S A T I O N G E N E R A L E D ' U N E I M A G E F L O T T A N T E : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFbinarisation_generale(imageR,imageA,seuil,niveau_inferieur,niveau_superieur)))) /* Fonction introduite le 20040908163901. */ DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=niveau_inferieur si imageA[X][Y] <= seuil, */ /* et : =niveau_superieur si imageA[X][Y] > seuil. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(genere_Float,seuil)); /* Seuil de binarisation : donne le dernier niveau a mettre a noir, et par exemple */ /* 'NOIR' (dans ce cas les points 'NOIR's restent 'NOIR's, et tous les autres */ /* deviennent 'BLANC's...). */ DEFV(Argument,DEFV(genere_Float,niveau_inferieur)); DEFV(Argument,DEFV(genere_Float,niveau_superieur)); /* Niveaux jouant le role du 'NOIR' et du 'BLANC' respectivement... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(genere_Float,INIT(valeur,FLOT__NIVEAU_UNDEF)); /* Valeur a donner au point courant de l'image resultat... */ /*..............................................................................................................................*/ begin_image Bblock Test(IFLE(loadF_point(imageA,X,Y),seuil)) Bblock EGAL(valeur,niveau_inferieur); /* Lorsque l'image Argument est inferieure ou egale au seuil, on la met a niveau_inferieur. */ Eblock ATes Bblock EGAL(valeur,niveau_superieur); /* Dans le cas contraire, on force le niveau_superieur, ce qui donne un masque binaire... */ Eblock ETes storeF_point(valeur,imageR,X,Y); Eblock end_image RETIF(imageR); Eblock EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* Q U A N T I F I C A T I O N R E G U L I E R E D E S N I V E A U X D ' U N E I M A G E " S T A N D A R D " : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Iquantification_reguliere(imageR,imageA,quantificateur)))) /* Fonction introduite le 20130909104806... */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] avec tous les niveaux quantifies. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Int,quantificateur)); /* Quantificateur. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock store_point(NIVA(MULD(NIVR(load_point(imageA,X,Y)),quantificateur)) ,imageR ,X,Y ,FVARIABLE ); Eblock end_image RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ #if ((Format_p==Format_char)||(Format_p==Format_int)) /* Common,DEFV(Fonction,) : la generation depend des conditions... */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* I N V E R S I O N D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Iinversion(imageR,imageA)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR=.NOT.imageA. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock PINVERT(X,Y,imageA,imageR); Eblock end_image RETI(imageR); Eblock EFonctionP #Aif ((Format_p==Format_char)||(Format_p==Format_int)) /* Common,DEFV(Fonction,) : la generation depend des conditions... */ #Eif ((Format_p==Format_char)||(Format_p==Format_int)) /* Common,DEFV(Fonction,) : la generation depend des conditions... */ _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* T R A N S P O S I T I O N D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Itransposition(imageR,imageA)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[Y][X]. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ Test(IFOU(IFID(imageA,imageR),IFNE(dimX,dimY))) Bblock PRINT_ERREUR("les images Argument et Resultat sont identiques, ou les dimensions en 'X' et 'Y' sont inegales"); Eblock ATes Bblock begin_image Bblock store_point(load_point(imageA,COXA(COYR(Y)),COYA(COXR(X))) ,imageR ,X,Y ,FVARIABLE ); Eblock end_image Eblock ETes RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* T R A N S P O S I T I O N D ' U N E I M A G E F L O T T A N T E : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFtransposition(imageR,imageA)))) DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[Y][X]. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ Test(IFOU(IFID(imageA,imageR),IFNE(dimX,dimY))) Bblock PRINT_ERREUR("les images Argument et Resultat sont identiques, ou les dimensions en 'X' et 'Y' sont inegales"); Eblock ATes Bblock begin_image Bblock storeF_point(loadF_point(imageA,COXA(COYR(Y)),COYA(COXR(X))) ,imageR ,X,Y ); Eblock end_image Eblock ETes RETIF(imageR); Eblock EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* L I S S A G E D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(Logical,SINT(Ilissage_____interpolation_cubique,VRAI))); /* Choix de la methode d'interpolation introduit le 20131230124640... */ #define NIVEAU_INFERIEUR_DE_L_IMAGE_A_LISSER \ FLOT__NOIR \ /* Niveau minimum, */ #define NIVEAU_SUPERIEUR_DE_L_IMAGE_A_LISSER \ FLOT__BLANC \ /* Niveau minimum. */ #define NIVEAU_INITIAL_DE_L_IMAGE_LISSEE \ NIVEAU_INFERIEUR_DE_L_IMAGE_A_LISSER \ /* Valeur de nettoyage de la futur image Resultat. */ DEFV(Common,DEFV(FonctionP,POINTERp(Ilissage(imageR ,imageA ,pas_horizontal ,pas_vertical ) ) ) ) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] */ /* lissee, c'est-a-dire interpolee a partir d'un reseau regulier de points defini */ /* par (pas_horizontal,pas_vertical) dans l'image Argument. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Positive,pas_horizontal)); /* Pas horizontal du reseau de lissage (futur 'pasX'), */ DEFV(Argument,DEFV(Positive,pas_vertical)); /* Pas vertical du reseau de lissage (futur 'pasY'). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Float,INIT(Xf,FLOT__UNDEF)); DEFV(Float,INIT(Yf,FLOT__UNDEF)); /* Coordonnees flottantes 'X' et 'Y'. */ DEFV(genere_Float,INIT(niveau_courant,FLOT__NIVEAU_UNDEF)); /* Donne le niveau flottant courant apres l'interpolation de lissage. */ BDEFV(imageF,imageR_flottante); /* Image flottante Resultat apres l'interpolation. */ BDEFV(imageF,imageA_flottante); /* Image flottante Argument que l'on cherche a faire lisser. */ /*..............................................................................................................................*/ CALS(Istd_float(imageA_flottante,NIVEAU_INFERIEUR_DE_L_IMAGE_A_LISSER,NIVEAU_SUPERIEUR_DE_L_IMAGE_A_LISSER,imageA)); /* Conversion de l'image Argument en flottant (afin de pouvoir utiliser la fabuleuse */ /* macro-procedure 'loadF_point_continu'). */ CALS(IFinitialisation(imageR_flottante,NIVEAU_INITIAL_DE_L_IMAGE_LISSEE)); /* Et on nettoie la matrice Resultat (flottante) ; on prend pour cela le plus petit niveau */ /* possible. */ begin_image Bblock EGAL(Xf,FLOT(X)); EGAL(Yf,FLOT(Y)); /* Conversion des coordonnees en flottant. */ PUSH_ECHANTILLONNAGE; /* Sauvegarde du sous-echantillonnage courant... */ SET_ECHANTILLONNAGE(pas_horizontal,pas_vertical); /* Et mise en place d'un sous-echantillonnage qui va definir le reseau de lissage. */ loadF_point_continu(niveau_courant,imageA_flottante,Xf,Yf,Ilissage_____interpolation_cubique); /* Il faut interpoler, et la c'est beaucoup moins simple... */ PULL_ECHANTILLONNAGE; /* Restauration du sous-echantillonnage courant... */ storeF_point(niveau_courant ,imageR_flottante ,X,Y ); /* Et on met a jour l'image Resultat flottante. */ Eblock end_image CALS(Ifloat_std_avec_renormalisation(imageR,imageR_flottante)); /* Conversion de l'image Resultat en une image standard... */ EDEFV(imageF,imageA_flottante); /* Image flottante Argument que l'on cherche a faire lisser. */ EDEFV(imageF,imageR_flottante); /* Image flottante Resultat apres l'interpolation. */ RETI(imageR); Eblock #undef NIVEAU_INFERIEUR_DE_L_IMAGE_A_LISSER #undef NIVEAU_SUPERIEUR_DE_L_IMAGE_A_LISSER #undef NIVEAU_INITIAL_DE_L_IMAGE_LISSEE EFonctionP /* Le 20051128161248, les fonctions suivantes : */ /* */ /* IFdynamique_de_Verhulst_delocalisee(...) */ /* IFdynamique_de_Verhulst_localisee(...) */ /* IFdynamique_de_Verhulst_localisee_generalisee(...) */ /* */ /* ont ete implementees dans 'v $xiii/GooF_image$FON' et ce afin d'alleger le processus */ /* 'v $xcc/cpp$Z' dans le mode '$xcp/substitue.01$X' (au lieu de '$SE')... */ _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* M O D I F I C A T I O N D ' U N E I M A G E P A R U N E F O N C T I O N : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFmodification_champ(imageR ,amplificateur_de_la_fonction ,ARGUMENT_FONCTION(Fxy) ,translateur_de_la_fonction ,ARGUMENT_POINTERs(translation_du_champ) ,ARGUMENT_POINTERs(echelle) ,imageA ) ) ) ) DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat de la modification de 'imageA' par la fonction definie ci-apres : */ DEFV(Argument,DEFV(Float,amplificateur_de_la_fonction)); /* Amplificateur de la fonction. */ DEFV(Argument,DEFV(Float,afPOINTEUR(Fxy))); /* Fonction de modification du niveau normalise du point courant {X,Y}. */ DEFV(Argument,DEFV(Float,translateur_de_la_fonction)); /* Translateur de la fonction. */ DEFV(Argument,DEFV(deltaF_2D,POINTERs(translation_du_champ))); /* Translation bi-dimensionnelle du champ a modifier. */ DEFV(Argument,DEFV(coeffF_2D,POINTERs(echelle))); /* Echelle bi-dimensionnelle du champ a modifier. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument a modifier. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock DEFV(Float,INIT(niveau_du_champ_avant,loadF_point(imageA,X,Y))); /* Niveau flottant avant modification, */ DEFV(Float,INIT(niveau_du_champ_apres,FLOT__UNDEF)); /* Niveau flottant modifie par la fonction ; on procede ainsi, parce que la */ /* procedure '__DENORMALISE_NIVEAU' n'est pas tres rapide. ATTENTION, on utilise pour les */ /* deux niveaux le type 'Float' car c'est celui de la fonction d'initialsation 'Fxy'... */ EGAL(niveau_du_champ_apres ,MODIFICATION_D_UN_CHAMP(amplificateur_de_la_fonction ,fPOINTEUR,Fxy ,translateur_de_la_fonction ,niveau_du_champ_avant ,X,Y ,ASI1,translation_du_champ ,echelle ) ); storeF_point(niveau_du_champ_apres ,imageR ,X,Y ); /* Modification element par element. */ Eblock end_image RETIF(imageR); Eblock EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* M O D I F I C A T I O N P O L Y N O M I A L E D E T Y P E " F E R M A T " : */ /* */ /* */ /* Definition : */ /* */ /* Une modification polynomiale de type */ /* "Fermat" est definie par l'equation : */ /* */ /* a b c */ /* F(niveau,X,Y) = cx.X + cy.Y + cn.niveau */ /* */ /* */ /* les parametres etant initialises de facon que : */ /* */ /* 2 2 */ /* F(niveau,X,Y) = X + Y */ /* */ /* */ /* Bien sur on devra faire ATTENTION lors de */ /* l'utilisation de 'Fpolynomial_Fermat(...)' */ /* au cas ou des exposants non entiers seraient */ /* utilises, et ce a cause de la fonction 'PUIX(...)'. */ /* */ /* */ /* ATTENTION : */ /* */ /* Ne pas oublier que si des 'niveau'x negatifs */ /* sont presents, il convient alors d'utiliser la */ /* fonction 'ABSO(...)' ('v $xci/Fermat$K valeur_absolue=')... */ /* */ /* */ /*************************************************************************************************************************************/ BFonctionF #define ABSO_Fpolynomial_Fermat(a) \ COND(EST_VRAI(Fpolynomial_Fermat_____prendre_la_valeur_absolue) \ ,ABSO(a) \ ,NEUT(a) \ ) \ /* Fonction introduite le 20150123115510 pour simplifier ce qui suit... */ #define PUIX_Fpolynomial_Fermat(a,b) \ COND(EST_FAUX(Fpolynomial_Fermat_____utiliser_SPUIX) \ ,PUIX(ABSO_Fpolynomial_Fermat(a),b) \ ,SPUIX(ABSO_Fpolynomial_Fermat(a),b) \ ) \ /* Fonction 'PUIX(...)' speciale Fermat (introduite le 20081001113436...). */ /* */ /* Je rappelle le 20210114134836 (pour 'v $xiaf/COT2.B4$HauteDef$R16 p=$xiP/cotes.11 ') */ /* que 'ABSO(...)' a ete introduite afin de prendre en compte le cas ou des 'niveau'x */ /* negatifs apparaitraient ('v $xiirf/.COT2.B1.0.2.$u .xci.Fermat.X' par exemple...). */ DEFV(Common,DEFV(Logical,SINT(Fpolynomial_Fermat_____prendre_la_valeur_absolue,FAUX))); /* Indicateur de controle de 'ABSO(...)' introduit le 20150123115510... */ DEFV(Common,DEFV(Logical,SINT(Fpolynomial_Fermat_____utiliser_SPUIX,FAUX))); /* Indicateur de choix entre 'PUIX(...)' et 'SPUIX(...)' introduit le 20030510185451 en */ /* garantissant la compatibilite anterieure... */ DEFV(Common,DEFV(Float,SINT(Fpolynomial_Fermat_____coefficient_polynomial_X,FU))); /* Coefficient d'"importance" de la coordonnee 'X'. */ DEFV(Common,DEFV(Float,SINT(Fpolynomial_Fermat_____exposant_polynomial_X,FDEUX))); /* Exposant de la coordonnee 'X'. */ DEFV(Common,DEFV(Float,SINT(Fpolynomial_Fermat_____coefficient_polynomial_Y,FU))); /* Coefficient d'"importance" de la coordonnee 'Y'. */ DEFV(Common,DEFV(Float,SINT(Fpolynomial_Fermat_____exposant_polynomial_Y,FDEUX))); /* Exposant de la coordonnee 'Y'. */ DEFV(Common,DEFV(Float,SINT(Fpolynomial_Fermat_____coefficient_polynomial_niveau,FZERO))); /* Coefficient d'"importance" du niveau. */ DEFV(Common,DEFV(Float,SINT(Fpolynomial_Fermat_____exposant_polynomial_niveau,FU))); /* Exposant du niveau. */ DEFV(Common,DEFV(FonctionF,Fpolynomial_Fermat(niveau,Xf,Yf))) DEFV(Argument,DEFV(Float,niveau)); /* Niveau flottant dont l'echelle importe peu... */ DEFV(Argument,DEFV(Float,Xf)); DEFV(Argument,DEFV(Float,Yf)); /* Coordonnees flottantes 'Xf' et 'Yf' dans [0,1[. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Float,INIT(fxy,FLOT__UNDEF)); /* Valeur de la fonction 'Fxy' pour une modification polynomiale de type "Fermat". */ /*..............................................................................................................................*/ EGAL(fxy ,LIZ3(Fpolynomial_Fermat_____coefficient_polynomial_X ,PUIX_Fpolynomial_Fermat(Xf,Fpolynomial_Fermat_____exposant_polynomial_X) ,Fpolynomial_Fermat_____coefficient_polynomial_Y ,PUIX_Fpolynomial_Fermat(Yf,Fpolynomial_Fermat_____exposant_polynomial_Y) ,Fpolynomial_Fermat_____coefficient_polynomial_niveau ,PUIX_Fpolynomial_Fermat(niveau,Fpolynomial_Fermat_____exposant_polynomial_niveau) ) ); /* ATTENTION au cas ou des exposants non entiers seraient utilises avec la fonction */ /* 'PUIX(...)'. */ RETU(fxy); Eblock #undef PUIX_Fpolynomial_Fermat #undef ABSO_Fpolynomial_Fermat EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* M O D I F I C A T I O N E X P O N E N T I A T I O N : */ /* */ /* */ /* Definition : */ /* */ /* Une modification exponentiation est */ /* definie par l'equation : */ /* */ /* d */ /* ( a b c) */ /* F(niveau,X,Y) = (cx.X + cy.Y + cn.niveau ) */ /* */ /* */ /* les parametres etant initialises de facon que : */ /* */ /* 2 2 */ /* F(niveau,X,Y) = (X + Y ) */ /* */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Logical,SINT(Fexponentiation_____utiliser_SPUIX,FAUX))); /* Indicateur de choix entre 'PUIX(...)' et 'SPUIX(...)' introduit le 20030510191000 en */ /* garantissant la compatibilite anterieure... */ DEFV(Common,DEFV(Float,SINT(Fexponentiation_____coefficient_exposant,FU))); /* Exposant 'd' de l'exponentiation. */ DEFV(Common,DEFV(FonctionF,Fexponentiation(niveau,Xf,Yf))) /* ATTENTION, les parametres implicites de 'Fexponentiation(...)' contiennent ceux de */ /* de la fonction 'Fpolynomial_Fermat(...)'. */ DEFV(Argument,DEFV(Float,niveau)); /* Niveau flottant dont l'echelle importe peu... */ DEFV(Argument,DEFV(Float,Xf)); DEFV(Argument,DEFV(Float,Yf)); /* Coordonnees flottantes 'Xf' et 'Yf' dans [0,1[. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Float,INIT(fxy,FLOT__UNDEF)); /* Valeur de la fonction 'Fxy' pour une modification exponentiation. */ /*..............................................................................................................................*/ EGAL(fxy ,Fpolynomial_Fermat(niveau,Xf,Yf) ); /* Calcul du polynome de type "Fermat". */ Test(IZGE(fxy)) Bblock EGAL(fxy ,COND(EST_FAUX(Fexponentiation_____utiliser_SPUIX) ,PUIX(fxy,Fexponentiation_____coefficient_exposant) ,SPUIX(fxy,Fexponentiation_____coefficient_exposant) ) ); /* Calcul d'une puissance du polynome de type "Fermat" lorsque cela est possible... */ Eblock ATes Bblock PRINT_ERREUR("un nombre negatif ou nul est apparu, 'FLOT__UNDEF' est renvoye"); /* On notera que c'est alors 'FLOT__UNDEF' qui est renvoye... */ Eblock ETes RETU(fxy); Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* M O D I F I C A T I O N E X P O N E N T I E L L E : */ /* */ /* */ /* Definition : */ /* */ /* Une modification exponentielle est */ /* definie par l'equation : */ /* */ /* */ /* a b c */ /* (cx.X + cy.Y + cn.niveau ) */ /* F(niveau,X,Y) = e */ /* */ /* */ /* les parametres etant initialises de facon que : */ /* */ /* 2 2 */ /* (X + Y ) */ /* F(niveau,X,Y) = e */ /* */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,Fexponentielle(niveau,Xf,Yf))) /* ATTENTION, les parametres implicites de 'Fexponentielle(...)' contiennent ceux de */ /* de la fonction 'Fpolynomial_Fermat(...)'. */ DEFV(Argument,DEFV(Float,niveau)); /* Niveau flottant dont l'echelle importe peu... */ DEFV(Argument,DEFV(Float,Xf)); DEFV(Argument,DEFV(Float,Yf)); /* Coordonnees flottantes 'Xf' et 'Yf' dans [0,1[. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Float,INIT(fxy,FLOT__UNDEF)); /* Valeur de la fonction 'Fxy' pour une modification exponentiation. */ /*..............................................................................................................................*/ EGAL(fxy,EXPX(Fpolynomial_Fermat(niveau,Xf,Yf))); /* Calcul d'une exponentiele du polynome de type "Fermat" lorsque cela est possible... */ RETU(fxy); Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* M O D I F I C A T I O N L O G A R I T H M E N E P E R I E N : */ /* */ /* */ /* Definition : */ /* */ /* Une modification logarithme neperien est */ /* definie par l'equation : */ /* */ /* a b c */ /* F(niveau,X,Y) = log(cx.X + cy.Y + cn.niveau ) */ /* */ /* */ /* les parametres etant initialises de facon que : */ /* */ /* 2 2 */ /* F(niveau,X,Y) = log(X + Y ) */ /* */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Logical,SINT(Flogarithme_neperien_____utiliser_SLOGX,FAUX))); /* Indicateur de choix entre 'LOGX(...)' et 'SLOGX(...)' introduit le 20150407104335 en */ /* garantissant la compatibilite anterieure... */ DEFV(Common,DEFV(FonctionF,Flogarithme_neperien(niveau,Xf,Yf))) /* ATTENTION, les parametres implicites de 'Flogarithme_neperien(...)' sont en fait ceux de */ /* de la fonction 'Fpolynomial_Fermat(...)'. */ DEFV(Argument,DEFV(Float,niveau)); /* Niveau flottant dont l'echelle importe peu... */ DEFV(Argument,DEFV(Float,Xf)); DEFV(Argument,DEFV(Float,Yf)); /* Coordonnees flottantes 'Xf' et 'Yf' dans [0,1[. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Float,INIT(fxy,FLOT__UNDEF)); /* Valeur de la fonction 'Fxy' pour une modification logarithme neperien. */ /*..............................................................................................................................*/ EGAL(fxy ,Fpolynomial_Fermat(niveau,Xf,Yf) ); /* Calcul du polynome de type "Fermat". */ Test(IL_FAUT(Flogarithme_neperien_____utiliser_SLOGX)) /* Test introduit le 20150407104335... */ Bblock EGAL(fxy,SLOGX(fxy)); /* Calcul du logarithme neperien "etendu" du polynome de type "Fermat"... */ Eblock ATes Bblock Test(IZGT(fxy)) Bblock EGAL(fxy,LOGX(fxy)); /* Calcul du logarithme neperien du polynome de type "Fermat" lorsque cela est possible... */ Eblock ATes Bblock PRINT_ERREUR("un nombre negatif ou nul est apparu, 'FLOT__UNDEF' est renvoye"); /* On notera que c'est alors 'FLOT__UNDEF' qui est renvoye... */ Eblock ETes Eblock ETes RETU(fxy); Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* M O D I F I C A T I O N R A C I N E C A R R E E : */ /* */ /* */ /* Definition : */ /* */ /* Une modification racine carree est */ /* definie par l'equation : */ /* ___________________________ */ /* / a b c */ /* F(niveau,X,Y) = \/ cx.X + cy.Y + cn.niveau */ /* */ /* */ /* les parametres etant initialises de facon que : */ /* ________ */ /* / 2 2 */ /* F(niveau,X,Y) = \/ X + Y */ /* */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Logical,SINT(Fracine_carree_____utiliser_SRACX,FAUX))); /* Indicateur de choix entre 'RACX(...)' et 'SRACX(...)' introduit le 20150407104335 en */ /* garantissant la compatibilite anterieure... */ DEFV(Common,DEFV(FonctionF,Fracine_carree(niveau,Xf,Yf))) /* ATTENTION, les parametres implicites de 'Fracine_carree(...)' sont en fait ceux de */ /* de la fonction 'Fpolynomial_Fermat(...)'. */ DEFV(Argument,DEFV(Float,niveau)); /* Niveau flottant dont l'echelle importe peu... */ DEFV(Argument,DEFV(Float,Xf)); DEFV(Argument,DEFV(Float,Yf)); /* Coordonnees flottantes 'Xf' et 'Yf' dans [0,1[. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Float,INIT(fxy,FLOT__UNDEF)); /* Valeur de la fonction 'Fxy' pour une modification racine carree. */ /*..............................................................................................................................*/ EGAL(fxy ,Fpolynomial_Fermat(niveau,Xf,Yf) ); /* Calcul du polynome de type "Fermat". */ Test(IL_FAUT(Fracine_carree_____utiliser_SRACX)) /* Test introduit le 20150407104335... */ Bblock EGAL(fxy,SRACX(fxy)); /* Calcul de la racine carree "etemdue" du polynome de type "Fermat"... */ Eblock ATes Bblock Test(IZGE(fxy)) Bblock EGAL(fxy,RACX(fxy)); /* Calcul de la racine carree du polynome de type "Fermat" lorsque cela est possible... */ Eblock ATes Bblock PRINT_ERREUR("un nombre negatif est apparu"); /* On notera que c'est alors 'FLOT__UNDEF' qui est renvoye... */ Eblock ETes Eblock ETes RETU(fxy); Eblock EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* M O D I F I C A T I O N C O S I N U S O I D A L E : */ /* */ /* */ /* Definition : */ /* */ /* Une modification cosinusoidale est */ /* definie par l'equation : */ /* */ /* F(niveau,X,Y) = cos(cx.X + cy.Y + ct.T + cn.niveau + phase) */ /* */ /* */ /* les parametres etant initialises de facon que : */ /* */ /* F(niveau,X,Y) = cos(niveau) */ /* */ /* */ /* Enfin, on n'oubliera pas que : */ /* */ /* sin(angle) = cos((pi/2)-angle) */ /* */ /* ce qui permet de definir implicitement 'Fsinusoidal(...)' */ /* (mais voir la modification 'v $xiii/di_image$FON 20080915162032). */ /* */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Float,SINT(Fcosinusoidal_____coefficient_X,FZERO))); /* Coefficient d'"importance" de la coordonnee 'X'. */ DEFV(Common,DEFV(Float,SINT(Fcosinusoidal_____coefficient_Y,FZERO))); /* Coefficient d'"importance" de la coordonnee 'Y'. */ DEFV(Common,DEFV(Float,SINT(Fcosinusoidal_____coefficient_T,CERCLE_TRIGONOMETRIQUE))); /* Coefficient d'"importance" de la coordonnee 'T' (ou "pulsation"). */ DEFV(Common,DEFV(Float,SINT(Fcosinusoidal_____parametre_T,FZERO))); /* Parametre 'T' (ou "temps"). */ DEFV(Common,DEFV(Float,SINT(Fcosinusoidal_____coefficient_niveau,FU))); /* Coefficient d'"importance" du niveau. */ DEFV(Common,DEFV(Float,SINT(Fcosinusoidal_____parametre_phase,FZERO))); /* Parametre "phase". */ DEFV(Common,DEFV(Logical,SINT(Fcosinusoidal_____calculer_le_sinus_au_lieu_du_cosinus,FAUX))); /* Pour permettre de calculer un sinus, le calcul du cosinus etant le calcul par defaut */ /* afin de garantir la compatibilite anterieure (introduit le 20080915162032)... */ DEFV(Common,DEFV(FonctionF,Fcosinusoidal(niveau,Xf,Yf))) DEFV(Argument,DEFV(Float,niveau)); /* Niveau flottant dont l'echelle importe peu... */ DEFV(Argument,DEFV(Float,Xf)); DEFV(Argument,DEFV(Float,Yf)); /* Coordonnees flottantes 'Xf' et 'Yf' dans [0,1[. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Float,INIT(angle,FLOT__UNDEF)); /* Angle dont on veut le cosinus (ou le sinus...). */ DEFV(Float,INIT(fxy,FLOT__UNDEF)); /* Valeur de la fonction 'Fxy' pour une modification cosinusoidale. */ /*..............................................................................................................................*/ EGAL(angle ,LIN4(Fcosinusoidal_____coefficient_X,Xf ,Fcosinusoidal_____coefficient_Y,Yf ,Fcosinusoidal_____coefficient_T,Fcosinusoidal_____parametre_T ,Fcosinusoidal_____coefficient_niveau,niveau ,Fcosinusoidal_____parametre_phase ) ); EGAL(fxy ,COND(EST_FAUX(Fcosinusoidal_____calculer_le_sinus_au_lieu_du_cosinus) ,COSX(angle) ,SINX(angle) ) ); /* Le calcul eventuel du 'SINX(...)' a la place du 'COSX(...)' a ete introduit le */ /* 20080915162032. On notera au passage que l'on aurait aussi pu ecrire : */ /* */ /* COSX(COND(EST_FAUX(Fcosinusoidal_____calculer_le_sinus_au_lieu_du_cosinus) */ /* ,NEUT(angle) */ /* ,SOUS(PI_SUR_2,angle) */ /* ) */ /* ) */ /* */ /* mais la solution utilisee est quand meme plus simple... */ RETU(fxy); Eblock EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* M O D I F I C A T I O N T A N G E N T E H Y P E R B O L I Q U E : */ /* */ /* */ /* Definition : */ /* */ /* Une modification tangente hyperbolique est */ /* definie par l'equation : */ /* */ /* F(niveau,X,Y) = th(cx.X + cy.Y + ct.T + cn.niveau + phase) */ /* */ /* */ /* les parametres etant initialises de facon que : */ /* */ /* F(niveau,X,Y) = th(niveau) */ /* */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Float,SINT(Ftangente_hyperbolique_____coefficient_X,FZERO))); /* Coefficient d'"importance" de la coordonnee 'X'. */ DEFV(Common,DEFV(Float,SINT(Ftangente_hyperbolique_____coefficient_Y,FZERO))); /* Coefficient d'"importance" de la coordonnee 'Y'. */ DEFV(Common,DEFV(Float,SINT(Ftangente_hyperbolique_____coefficient_T,CERCLE_TRIGONOMETRIQUE))); /* Coefficient d'"importance" de la coordonnee 'T' (ou "pulsation"). */ DEFV(Common,DEFV(Float,SINT(Ftangente_hyperbolique_____parametre_T,FZERO))); /* Parametre 'T' (ou "temps"). */ DEFV(Common,DEFV(Float,SINT(Ftangente_hyperbolique_____coefficient_niveau,FU))); /* Coefficient d'"importance" du niveau. */ DEFV(Common,DEFV(Float,SINT(Ftangente_hyperbolique_____parametre_phase,FZERO))); /* Parametre "phase". */ DEFV(Common,DEFV(FonctionF,Ftangente_hyperbolique(niveau,Xf,Yf))) /* Fonction introduite le 20140818105825... */ DEFV(Argument,DEFV(Float,niveau)); /* Niveau flottant dont l'echelle importe peu... */ DEFV(Argument,DEFV(Float,Xf)); DEFV(Argument,DEFV(Float,Yf)); /* Coordonnees flottantes 'Xf' et 'Yf' dans [0,1[. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Float,INIT(angle,FLOT__UNDEF)); /* Angle dont on veut la tangente hyperbolique. */ DEFV(Float,INIT(fxy,FLOT__UNDEF)); /* Valeur de la fonction 'Fxy' pour une modification tangente hyperbolique. */ /*..............................................................................................................................*/ EGAL(angle ,LIN4(Ftangente_hyperbolique_____coefficient_X,Xf ,Ftangente_hyperbolique_____coefficient_Y,Yf ,Ftangente_hyperbolique_____coefficient_T,Ftangente_hyperbolique_____parametre_T ,Ftangente_hyperbolique_____coefficient_niveau,niveau ,Ftangente_hyperbolique_____parametre_phase ) ); EGAL(fxy,TAHX(angle)); RETU(fxy); Eblock EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* P A S S A G E A U N E D Y N A M I Q U E L O G A R I T H M I Q U E D E C I M A L */ /* P O U R U N E I M A G E F L O T T A N T E A V E C S E U I L L A G E E T T R A N S L A T I O N : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Logical,SINT(IFdynamique_logarithmique_decimal_avec_seuillage_et_translation_____LO1X,VRAI))); /* Indique si l'on va utiliser 'LO1X(...)' ci-apres ('VRAI') ou bien 'LOGX(...)' ('FAUX'). */ DEFV(Common,DEFV(FonctionF,POINTERF(IFdynamique_logarithmique_decimal_avec_seuillage_et_translation(imageR ,imageA ,seuil_des_valeurs ,translation_des_logarithmes ) ) ) ) DEFV(Argument,DEFV(imageF,imageR)); /* Image flottante Resultat, telle que : imageR[X][Y]=Log10(imageA[X][Y] seuille). */ DEFV(Argument,DEFV(imageF,imageA)); /* Image flottante Argument. */ DEFV(Argument,DEFV(Float,seuil_des_valeurs)); /* Seuil des valeurs. */ DEFV(Argument,DEFV(Float,translation_des_logarithmes)); /* Translation des logarithmes. Une valeur particulierement interessante est : */ /* */ /* translation_des_logarithmes = -LO1X(seuil_des_valeurs) */ /* */ /* qui ramene donc tout a 0... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock DEFV(genere_Float,INIT(valeur_courante,loadF_point(imageA,X,Y))); /* Valeur courante dont on veut prendre le logarithme. */ DEFV(genere_Float,INIT(valeur_courante_seuillee,FLOT__NIVEAU_UNDEF)); /* Valeur courante apres seuillage. */ EGAL(valeur_courante_seuillee,MAX2(valeur_courante,seuil_des_valeurs)); /* Seuillage. */ Test(IZGT(valeur_courante_seuillee)) Bblock storeF_point(ADD2(COND(EST_VRAI(IFdynamique_logarithmique_decimal_avec_seuillage_et_translation_____LO1X) ,LO1X(valeur_courante_seuillee) ,LOGX(valeur_courante_seuillee) ) ,translation_des_logarithmes ) ,imageR ,X,Y ); /* Application de la dynamique logarithmique decimal a chaque point de l'image 'imageA'... */ Eblock ATes Bblock PRINT_ERREUR("le logarithme d'une valeur negative est demande"); Eblock ETes Eblock end_image RETIF(imageR); Eblock EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E P L A C E M E N T D ' U N E I M A G E " F L O T T A N T E " A V E C */ /* R E M P L A C E M E N T D ' U N N I V E A U P A R T I C U L I E R : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFmove_avec_remplacement_d_un_niveau(imageR,imageA,niveau_a_remplacer,niveau_de_remplacement)))) /* Fonction introduite le 20101121105645 principalement pour le 'Z-Buffer' afin de */ /* remplacer 'Z_Buffer_____valeur_initiale' par la valeur minimale du 'Z' rencontree, par */ /* exemple, apres generation ('v $xiii/di_album$FON IFmove_avec_remplacement_d_un_niveau'). */ /* */ /* Voir la fonction 'v $xiii/conversion$FON Ifloat_std_du_Z_Buffer' qui a une vocation */ /* assez similaire, mais specifiquement pour le 'Z-Buffer'... */ DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] avec remplacement eventuel... */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(genere_Float,niveau_a_remplacer)); /* Niveau a remplacer. */ DEFV(Argument,DEFV(genere_Float,niveau_de_remplacement)); /* Niveau de remplacement. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock DEFV(genere_Float,INIT(niveau_courant,loadF_point(imageA,X,Y))); Test(IFEQ(niveau_courant,niveau_a_remplacer)) Bblock EGAL(niveau_courant,niveau_de_remplacement); Eblock ATes Bblock Eblock ETes storeF_point(niveau_courant,imageR,X,Y); Eblock end_image TRAITEMENT_SPECIFIQUE_DES_IMAGES_DE_TYPE_Z_Buffer(imageR); RETIF(imageR); Eblock EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E P L A C E M E N T D ' U N E I M A G E " F L O T T A N T E " : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFmove(imageR,imageA)))) /* Mise ici le 20170228140222 a cause de 'IFnormalisation(...)' qui l'utilise a compter */ /* du 20170228131623... */ DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y]. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock storeF_point(loadF_point(imageA,X,Y),imageR,X,Y); Eblock end_image TRAITEMENT_SPECIFIQUE_DES_IMAGES_DE_TYPE_Z_Buffer(imageR); /* Introduit le 20050418102230 pour 'v $xci/acces.02$I Z_Buffer'... */ RETIF(imageR); Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* M I S E A L ' E C H E L L E D ' U N E I M A G E F L O T T A N T E : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFscale(imageR,facteur_d_echelle,imageA,facteur_de_translation)))) /* Mise ici le 20170228172717 a cause de 'IFnormalisation(...)' qui l'utilise a compter */ /* du 20170228131623... */ DEFV(Argument,DEFV(imageF,imageR)); /* Image flottante Resultat, telle que : imageR[X][Y]=echelle*imageA[X][Y] + translation. */ DEFV(Argument,DEFV(Float,facteur_d_echelle)); /* Facteur d'echelle... */ DEFV(Argument,DEFV(imageF,imageA)); /* Image flottante Argument. */ DEFV(Argument,DEFV(Float,facteur_de_translation)); /* Facteur de translation... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock storeF_point(AXPB(facteur_d_echelle ,loadF_point(imageA,X,Y) ,facteur_de_translation ) ,imageR ,X,Y ); Eblock end_image RETIF(imageR); Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* N O R M A L I S A T I O N D ' U N E I M A G E F L O T T A N T E : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Logical,SINT(IFnormalisation_____compatibilite_20120705,FAUX))); /* Permet de generer des images suivant la methode anterieure au 20120705120135 dans le */ /* cas ou 'niveau_origine___effectif' et 'niveau_extremite_effectif' sont egaux... */ DEFV(Common,DEFV(Float,SINT(IFnormalisation_____epsilon_de_seuillage_inferieur_par_rapport_au_niveau_origine ,EPSILON_DE_SEUILLAGE_INFERIEUR_PAR_RAPPORT_AU_NIVEAU_ORIGINE_POUR_IFnormalisation ) ) ); /* En augmentant ce seuil, il est possible d'eliminer des "underflows" de normalisation... */ DEFV(Common,DEFV(genere_Float,SINT(IFnormalisation_____niveau_origine___de_normalisation,COORDONNEE_BARYCENTRIQUE_MINIMALE))); DEFV(Common,DEFV(genere_Float,SINT(IFnormalisation_____niveau_extremite_de_normalisation,COORDONNEE_BARYCENTRIQUE_MAXIMALE))); /* Definition du segment de normalisation introduit le 20030508101047... */ DEFV(Common,DEFV(Logical,SINT(IFnormalisation_____conserver_le_zero,FAUX))); /* Introduit le 20050905104340 afin de pouvoir conserver le zero de l'image a normaliser. */ DEFV(Common,DEFV(Float,SINT(IFnormalisation_____amplitude_des_extrema_en_deca_de_laquelle_il_y_a_nullite,FZERO))); /* Introduit le 20081228101851 lors du calcul de 'v $xiirs/$xiirs/PROJ.a3' pour laquelle */ /* la composante '$COORD_Y' du produit matriciel etait dans [-5.12e-12,+5.12e-12], donc */ /* quasiment nulle. Ce nouveau parametre permet de la mettre a zero a priori. La valeur */ /* par defaut est evidemment choisie de facon a assurer la compatibilite anterieure... */ DEFV(Common,DEFV(Logical,SINT(IFnormalisation_____prendre_la_partie_entiere,FAUX))); /* Introduit le 20150305210711 afin de pouvoir renvoyer les parties entieres... */ DEFV(Common,DEFV(Logical,SINT(IFnormalisation_____equilibrer_la_partie_entiere,VRAI))); /* Introduit le 20150307082748 afin de pouvoir exploiter effectivement 'niveau_extremite' */ /* si 'IL_FAUT(IFnormalisation_____prendre_la_partie_entiere)'... */ DEFV(Common,DEFV(Logical,SINT(IFnormalisation_____utiliser_la_moyenne_en_cas_d_uniformite,VRAI))); DEFV(Common,DEFV(genere_Float,SINT(IFnormalisation_____niveau_a_forcer_en_cas_d_uniformite,COORDONNEE_BARYCENTRIQUE_CENTRALE))); /* Introduit le 20130626082754 afin de pouvoir forcer la valeur de l'image 'imageR' dans */ /* le cas ou 'imageA' est uniforme (ses extrema sont alors egaux...). */ DEFV(Common,DEFV(Logical,SINT(IFnormalisation_____localiser_le_zero_en_un_point_donne,FAUX))); DEFV(Common,DEFV(Float,SINT(IFnormalisation_____coordonnee_X_du_point_definissant_le_zero ,______NORMALISE_AXES(k___Xmin,k___dimX,k___Xmin,NEUT) ) ) ); DEFV(Common,DEFV(Float,SINT(IFnormalisation_____coordonnee_Y_du_point_definissant_le_zero ,______NORMALISE_AXES(k___Ymin,k___dimY,k___Ymin,NEUT) ) ) ); /* Introduit le 20170228131623 afin de prendre comme niveau zero de 'imageR' un point */ /* de coordonnees donnees (et ce pour 'v $xiirs/$Fnota translater_zero'). */ /* */ /* On ne peut utiliser ici '_____cNORMALISE_OX(...)' et '_____cNORMALISE_OY(...)' car, */ /* en effet, ces dexu procedures font reference a des donnees ('Xmin' par exemple) qui ne */ /* sont pas connues a la compilation. */ /* */ /* De meme, on ne peut utiliser ici '_____cNORMALISE_AXES(...)' car, en effet, cette */ /* procedure reference 'AXES_COORDONNEES_FERMES_OUVERTS' qui n'est pas connue a la */ /* compilation... */ DEFV(Common,DEFV(FonctionF,POINTERF(IFnormalisation(imageR,imageA,niveau_origine,niveau_extremite)))) DEFV(Argument,DEFV(imageF,imageR)); /* Image flottante Resultat, telle que : imageR[X][Y]=imageA[X][Y] dans [0,1]. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image flottante Argument. */ DEFV(Argument,DEFV(genere_Float,niveau_origine)); DEFV(Argument,DEFV(genere_Float,niveau_extremite)); /* Extrema supposes des niveaux de 'imageA'. On notera qu'ils peuvent etre differents */ /* des extrema reels... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(genere_Float,INIT(niveau_origine___effectif,niveau_origine)); DEFV(genere_Float,INIT(niveau_extremite_effectif,niveau_extremite)); /* Afin de conserver la position du zero si besoin est... */ /*..............................................................................................................................*/ Test(IFGE(SOUA(niveau_extremite,niveau_origine),IFnormalisation_____amplitude_des_extrema_en_deca_de_laquelle_il_y_a_nullite)) Bblock /* Cas ou l'amplitude des extrema ne laisse pas supposer qu'il y a nullite approximative : */ Test(IL_FAUT(IFnormalisation_____conserver_le_zero)) Bblock EGAL(niveau_extremite_effectif ,MAX2(ABSO(niveau_origine) ,ABSO(niveau_extremite) ) ); EGAL(niveau_origine___effectif,NEGA(niveau_extremite_effectif)); /* Et ce afin de conserver le zero (introduit le 20050905104340...). */ Eblock ATes Bblock Eblock ETes begin_image Bblock DEFV(genere_Float,INIT(niveau_courant,loadF_point(imageA,X,Y))); DEFV(genere_Float,INIT(niveau_courant_renormalise,FLOT__UNDEF)); /* Niveau du point courant {X,Y} et le niveau renormalise (introduit le 20120705120135). */ Test(IFLE(niveau_courant ,ADD2(niveau_origine,IFnormalisation_____epsilon_de_seuillage_inferieur_par_rapport_au_niveau_origine) ) ) Bblock EGAL(niveau_courant,niveau_origine); /* Pour eviter des "underflows" dans 'HOMO(...)' (introduit le 20001003175237 en */ /* s'inspirant du probleme 'v $xiii/conversion$FON 20000929102058'). */ Eblock ATes Bblock Eblock ETes Test(IFOU(IL_FAUT(IFnormalisation_____compatibilite_20120705) ,IFET(IL_NE_FAUT_PAS(IFnormalisation_____compatibilite_20120705) ,IFNE(niveau_origine___effectif,niveau_extremite_effectif) ) ) ) /* Test introduit le 20120705120135... */ Bblock EGAL(niveau_courant_renormalise ,HOMO(niveau_courant ,niveau_origine___effectif ,niveau_extremite_effectif ,IFnormalisation_____niveau_origine___de_normalisation ,COND(IFET(IL_FAUT(IFnormalisation_____prendre_la_partie_entiere) ,IL_FAUT(IFnormalisation_____equilibrer_la_partie_entiere) ) ,ADD2(IFnormalisation_____niveau_extremite_de_normalisation,UN_MOINS_mgEPSILON) ,IFnormalisation_____niveau_extremite_de_normalisation ) ) ); /* Le 20150307082748 un dispositif a ete introduit qui permet, lorsque l'on ne prend en */ /* compte que les parties entieres, de faire que 'niveau_extremite' soit bien represente... */ Eblock ATes Bblock Test(IL_FAUT(IFnormalisation_____utiliser_la_moyenne_en_cas_d_uniformite)) Bblock EGAL(niveau_courant_renormalise ,MOYE(IFnormalisation_____niveau_origine___de_normalisation ,IFnormalisation_____niveau_extremite_de_normalisation ) ); /* Dans le cas ou les extrema sont egaux, c'est la valeur moyenne de l'intervalle de */ /* renormalisation qui est utilisee (introduit le 20120705120135)... */ Eblock ATes Bblock EGAL(niveau_courant_renormalise,IFnormalisation_____niveau_a_forcer_en_cas_d_uniformite); /* Introduit le 20130626082754... */ Eblock ETes Eblock ETes Test(IL_FAUT(IFnormalisation_____prendre_la_partie_entiere)) Bblock EGAL(niveau_courant_renormalise,AINT(niveau_courant_renormalise)); /* Possibilite introduite le 20150305210711... */ Eblock ATes Bblock Eblock ETes storeF_point(niveau_courant_renormalise ,imageR ,X,Y ); Eblock end_image Eblock ATes Bblock /* Cas ou l'amplitude des extrema laisse supposer qu'il y a nullite approximative : */ Test(IL_FAUT(IFnormalisation_____compatibilite_20120705)) Bblock CALS(IFinitialisation(imageR,COORDONNEE_BARYCENTRIQUE_MINIMALE)); /* Ainsi, si l'amplitude [niveau_origine,niveau_extremite] est trop petite, on "unifie" a */ /* zero arbitrairement (introduit le 20081228101851)... */ Eblock ATes Bblock CALS(IFinitialisation(imageR ,MOYE(IFnormalisation_____niveau_origine___de_normalisation ,IFnormalisation_____niveau_extremite_de_normalisation ) ) ); /* Ainsi, si l'amplitude [niveau_origine,niveau_extremite] est trop petite, on "unifie" */ /* avec la valeur moyenne de l'intervalle de renormalisation qui est utilisee (introduit */ /* le 20120705120135). */ Eblock ETes Eblock ETes Test(IL_FAUT(IFnormalisation_____localiser_le_zero_en_un_point_donne)) Bblock DEFV(genere_Float,INIT(niveau_du_futur_zero ,loadF_point(imageR ,_cDENORMALISE_OX(IFnormalisation_____coordonnee_X_du_point_definissant_le_zero) ,_cDENORMALISE_OY(IFnormalisation_____coordonnee_Y_du_point_definissant_le_zero) ) ) ); BDEFV(imageF,imageR_translatee); CALS(IFscale(imageR_translatee,FU,imageR,NEGA(niveau_du_futur_zero))); CALS(IFmove(imageR,imageR_translatee)); EDEFV(imageF,imageR_translatee); Eblock ATes Bblock Eblock ETes RETIF(imageR); Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* N O R M A L I S A T I O N D ' U N E I M A G E F L O T T A N T E */ /* A V E C C A L C U L A U T O M A T I Q U E D E S E X T R E M A : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFnormalisation_automatique(imageR,imageA)))) /* Fonction introduite pour 'v $xiii/tri_image$FON IFproduit_generalise' le 20040127140039. */ DEFV(Argument,DEFV(imageF,imageR)); /* Image flottante Resultat, telle que : imageR[X][Y]=imageA[X][Y] dans [0,1]. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image flottante Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(genere_Float,INIT(nivo_minimum,FLOT__UNDEF)); DEFV(genere_Float,INIT(nivo_maximum,FLOT__UNDEF)); /* Extrema des niveaux pour normaliser... */ /*..............................................................................................................................*/ CALS(IFnivo_extrema(imageA,ADRESSE(nivo_minimum),ADRESSE(nivo_maximum))); /* Calcul des extrema pour normaliser... */ CALS(IFnormalisation(imageR ,imageA ,nivo_minimum ,nivo_maximum ) ); RETIF(imageR); Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* N O R M A L I S A T I O N D ' U N E I M A G E F L O T T A N T E */ /* E N C O N S E R V A N T L A P O S I T I O N D U V R A I Z E R O : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFnormalisation_avec_le_vrai_zero(imageR,imageA,niveau_origine,niveau_extremite)))) DEFV(Argument,DEFV(imageF,imageR)); /* Image flottante Resultat, telle que : imageR[X][Y]=imageA[X][Y] dans [0,1] et en */ /* placant le zero au milieu (en 0.5). */ DEFV(Argument,DEFV(imageF,imageA)); /* Image flottante Argument. */ DEFV(Argument,DEFV(genere_Float,niveau_origine)); DEFV(Argument,DEFV(genere_Float,niveau_extremite)); /* Extrema supposes des niveaux de 'imageA'. On notera qu'ils peuvent etre differents */ /* des extrema reels... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(genere_Float,INIT(vrai_niveau_minimum,niveau_origine)); DEFV(genere_Float,INIT(vrai_niveau_maximum,niveau_extremite)); DEFV(genere_Float,INIT(faux_niveau_minimum,FLOT__NIVEAU_UNDEF)); DEFV(genere_Float,INIT(faux_niveau_maximum,FLOT__NIVEAU_UNDEF)); /* Afin de conserver la position du zero... */ /*..............................................................................................................................*/ EGAL(faux_niveau_maximum,MAX2(ABSO(vrai_niveau_minimum),ABSO(vrai_niveau_maximum))); EGAL(faux_niveau_minimum,NEGA(faux_niveau_maximum)); /* Recherche des faux extrema de 'imageA' tel que le zero soit conserve... */ CALS(IFnormalisation(imageR ,imageA ,faux_niveau_minimum ,faux_niveau_maximum ) ); /* Et enfin, normalisation en placant le zero au milieu (en 0.5). */ RETIF(imageR); Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* N O R M A L I S A T I O N D ' U N E I M A G E C O M P L E X E */ /* A V E C C A L C U L A U T O M A T I Q U E D E S E X T R E M A : */ /* */ /*************************************************************************************************************************************/ BFonctionJ DEFV(Common,DEFV(FonctionJ,POINTERJ(IJnormalisation_automatique(imageR,imageA)))) /* Fonction introduite pour 'v $xiii/mono_image$FON IJgenere_champ' le 20121114130913. */ DEFV(Argument,DEFV(imageJ,imageR)); /* Image complexe Resultat, telle que : imageR[X][Y]=imageA[X][Y] dans [0,1]. */ DEFV(Argument,DEFV(imageJ,imageA)); /* Image complexe Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ BDEFV(imageF,partie_Reelle____); BDEFV(imageF,partie_Imaginaire); BDEFV(imageF,partie_Reelle_____renormalisee); BDEFV(imageF,partie_Imaginaire_renormalisee); /* Images donnant les parties Reelles et Imaginaires avant et apres renormalisation... */ Bblock /*..............................................................................................................................*/ CALS(Icomplexe_reelle(partie_Reelle____,imageA)); CALS(Icomplexe_imaginaire(partie_Imaginaire,imageA)); /* Extraction des parties Reelles et Imaginaires... */ CALS(IFnormalisation_automatique(partie_Reelle_____renormalisee,partie_Reelle____)); CALS(IFnormalisation_automatique(partie_Imaginaire_renormalisee,partie_Imaginaire)); /* Et renormalisation... */ CALS(Ireelle_complexe(imageR,partie_Reelle_____renormalisee)); CALS(Iimaginaire_complexe(imageR,partie_Imaginaire_renormalisee)); /* Construction de l'image complexe... */ EDEFV(imageF,partie_Imaginaire_renormalisee); EDEFV(imageF,partie_Reelle_____renormalisee); EDEFV(imageF,partie_Imaginaire); EDEFV(imageF,partie_Reelle____); /* Images donnant les parties Reelles et Imaginaires avant et apres renormalisation... */ RETIJ(imageR); Eblock EFonctionJ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E P L A C E M E N T D ' U N E I M A G E " F L O T T A N T E " */ /* A V E C M A R Q U A G E D ' U N P O I N T V A L I D E : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Logical,SINT(IFmove_avec_store_point_valide_____avertir_hors_image,FAUX))); /* Introduit le 20170918115250 par symetrie avec 'Imove_avec_store_point_valide(...)'. */ DEFV(Common,DEFV(FonctionF,POINTERp(IFmove_avec_store_point_valide(imageR ,imageA ,niveau_du_point ,abscisse_du_point ,ordonnee_du_point ) ) ) ) /* Cette fonction a ete introduite le 20050920123439 pour etre utilisee dans la */ /* commande 'v $xci/S_point$K IFmove_avec_store_point_valide'. */ DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y]. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(genere_Float,niveau_du_point)); /* Niveau du point a marquer. */ DEFV(Argument,DEFV(Int,abscisse_du_point)); DEFV(Argument,DEFV(Int,ordonnee_du_point)); /* Coordonnees du point a marquer. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ CALS(IFmove(imageR,imageA)); /* Deplacement de l'image, */ Test(IL_FAUT(IFmove_avec_store_point_valide_____avertir_hors_image)) Bblock Test(TEST_HORS_IMAGE(abscisse_du_point,ordonnee_du_point)) Bblock PRINT_ERREUR("le point est hors image"); CAL1(Prer2("(ses coordonnees sont {x,y} = {%d,%d})\n",abscisse_du_point,ordonnee_du_point)); /* Edition introduite le 20170918115250... */ Eblock ATes Bblock Eblock ETes Eblock ATes Bblock Eblock ETes storeF_point_valide(niveau_du_point ,imageR ,abscisse_du_point ,ordonnee_du_point ); /* Et on marque le point... */ RETIF(imageR); Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E P L A C E M E N T D ' U N E I M A G E " F L O T T A N T E " A V E C S U B S T I T U T I O N : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Logical,SINT(IFmove_avec_substitution_____editer_le_message_des_zones_plates,VRAI))); /* Afin de controler le message sur les "zones plates" (introduit le 20230419144942)... */ DEFV(Common,DEFV(Logical,SINT(IFmove_avec_substitution_____forcer_les_extrema,FAUX))); DEFV(Common,DEFV(genere_Float,SINT(IFmove_avec_substitution_____niveau_minimum,FLOT__NOIR))); DEFV(Common,DEFV(genere_Float,SINT(IFmove_avec_substitution_____niveau_maximum,FLOT__BLANC))); /* La possibilite de forcer les extrema a ete introduite le 20130114123017... */ /* courante lors de sa conversion... */ DEFV(Common,DEFV(Logical,SINT(IFmove_avec_substitution_____lissage,FAUX))); /* Afin de savoir s'il faut lisser ('VRAI') ou pas ('FAUX') la liste de SUBSTITUTION */ /* courante lors de sa conversion... */ DEFV(Common,DEFV(Int,SINT(IFmove_avec_substitution_____nombre_de_passes_de_lissage ,NOMBRE_DE_PASSES_DE_LISSAGE_DANS_IFmove_avec_substitution ) ) ); /* Indique alors le nombre de passes de lissage ("plus on lisse, plus c'est lisse...") */ /* de la liste de SUBSTITUTION courante (et non pas de l'image elle-meme !). */ DEFV(Common,DEFV(Int,SINT(IFmove_avec_substitution_____PAS_COULEURS_de_lissage,PAS_COULEURS))); /* Pas des couleurs pour les fonctions 'nPREK(...)' et 'nSUCK(...)' lors du lissage. */ DEFV(Common,DEFV(Int,SINT(IFmove_avec_substitution_____PAS_COULEURS_d_interpolation,PAS_COULEURS))); /* Pas des couleurs pour les fonctions 'nPREK(...)' et 'nSUCK(...)' lors de l'interpolation. */ #define Nsubstitution_FLOTTANTE(niveau_standard) \ ITb1(liste_flottante_approximee_de_substitution,INDX(niveau_standard,NOIR)) \ /* Substitution d'un niveau standard et mise dans [niveau_minimum,niveau_maximum]. */ DEFV(Common,DEFV(Float,SINT(IFmove_avec_substitution_____facteur_des_derivees_numeriques,FU))); /* En diminuant ce facteur on adoucit les transitions d'une maille a l'autre, alors qu'en */ /* l'augmentant, on les rend plus "cassantes"... */ #define DERIVATION_NUMERIQUE(fonction_origine,fonction_extremite,variable_origine,variable_extremite) \ MUL2(IFmove_avec_substitution_____facteur_des_derivees_numeriques \ ,DERIVATION_PARTIELLE(fonction_origine \ ,fonction_extremite \ ,FLOT(SOUS(variable_extremite,variable_origine)) \ ) \ ) \ /* Calcul de la derivee numerique d'une fonction lors de l'interpolation. */ DEFV(Common,DEFV(FonctionF,POINTERF(IFmove_avec_substitution(imageR,imageA,increment_des_niveaux)))) DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] substituee avec la substitution */ /* courante. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Float,increment_des_niveaux)); /* Increment du niveau courant dans [niveau_minimum,niveau_maximum]. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(genere_Float,INIT(niveau_minimum,FLOT__NIVEAU_UNDEF)); DEFV(genere_Float,INIT(niveau_maximum,FLOT__NIVEAU_UNDEF)); /* Afin de rechercher les niveaux minimal et maximal de 'imageA'. */ DEFV(genere_Float,DTb1(liste_flottante_approximee_de_substitution,COULEURS)); /* Cette table contient la liste de SUBSTITUTION courante convertie en 'genere_Float' et */ /* mise dans [niveau_minimum,niveau_maximum], puis eventuellement lissee par approximation. */ /*..............................................................................................................................*/ CALS(IFnivo_extrema(imageA ,ADRESSE(niveau_minimum) ,ADRESSE(niveau_maximum) ) ); /* Recherche des extrema de 'imageA' dans tous les cas... */ Test(IL_FAUT(IFmove_avec_substitution_____forcer_les_extrema)) Bblock /* Possibilite introduite le 20130114123017... */ Test(IFOU(IFEXff(IFmove_avec_substitution_____niveau_minimum,niveau_minimum,niveau_maximum) ,IFEXff(IFmove_avec_substitution_____niveau_maximum,niveau_minimum,niveau_maximum) ) ) Bblock PRINT_ATTENTION("les extrema forces sont incompatibles avec les extrema reels"); CAL1(Prer4("(ExtremaForces=(%f,%f), ExtremaReels=(%f,%f))\n" ,IFmove_avec_substitution_____niveau_minimum,IFmove_avec_substitution_____niveau_maximum ,niveau_minimum,niveau_maximum ) ); /* Les extrema reels de 'imageA' sont conserves... */ Eblock ATes Bblock EGAL(niveau_minimum,IFmove_avec_substitution_____niveau_minimum); EGAL(niveau_maximum,IFmove_avec_substitution_____niveau_maximum); /* Forcage des extrema lorsqu'ils sont acceptables... */ Eblock ETes Eblock ATes Bblock Eblock ETes CONVERSION_FLOTTANTE_D_UNE_LISTE_DE_SUBSTITUTION(liste_flottante_approximee_de_substitution ,niveau_minimum ,niveau_maximum ,IFmove_avec_substitution_____lissage ,IFmove_avec_substitution_____nombre_de_passes_de_lissage ,IFmove_avec_substitution_____PAS_COULEURS_de_lissage ); /* Conversion de la liste de SUBSTITUTION courante avec lissage eventuel... */ begin_image Bblock DEFV(genere_Float,INIT(niveau_flottant_courant ,MODS(ADD2(loadF_point(imageA,X,Y),increment_des_niveaux) ,niveau_minimum ,niveau_maximum ) ) ); DEFV(genere_Float,INIT(niveau_flottant_courant_dans_NOIR_BLANC,FLOT__NIVEAU_UNDEF)); DEFV(genere_p,INIT(niveau_standard_courant,NIVEAU_UNDEF)); /* Definition du niveau courant au point {X,Y} et de quelques valeurs "equivalentes"... */ DEFV(genere_Float,INIT(niveau_flottant_substitue,FLOT__NIVEAU_UNDEF)); /* Definition du niveau substitue au point {X,Y}. */ EGAL(niveau_flottant_courant_dans_NOIR_BLANC ,HOMO(niveau_flottant_courant ,niveau_minimum,niveau_maximum ,FLOT__NOIR,FLOT__BLANC ) ); EGAL(niveau_standard_courant,GENP(niveau_flottant_courant_dans_NOIR_BLANC)); /* Mise du niveau courant dans [NOIR,BLANC]. */ Test(IFEQ(niveau_standard_courant,BLANC)) Bblock EGAL(niveau_flottant_substitue ,Nsubstitution_FLOTTANTE(niveau_standard_courant) ); /* Dans le cas de la borne superieure 'BLANC', la substitution est triviale... */ Eblock ATes Bblock DEFV(Logical,INIT(iterer_la_substitution_PREK,VRAI)); DEFV(Logical,INIT(iterer_la_substitution_SUCK,VRAI)); /* Afin de pouvoir eliminer les "zones plates" dans les listes de SUBSTITUTION... */ /* Ceci s'est vu le 19970428153552 dans '$xiP/gris.03' ou il y a par exemple 10 codes */ /* '0xbf' a la suite les uns des autres. L'interpolation ne fait que restituer betement */ /* ces valeurs dupliquees... */ DEFV(genere_p,INIT(PREK_niveau_standard_courant ,niveau_standard_courant ) ); DEFV(genere_p,INIT(SUCK_niveau_standard_courant ,nSUCK_TRON(niveau_standard_courant,IFmove_avec_substitution_____PAS_COULEURS_d_interpolation) ) ); DEFV(genere_p,INIT(SUCK_SUCK_niveau_standard_courant ,NIVEAU_UNDEF ) ); DEFV(genere_Float,INIT(niveau_flottant_substitue_9,FLOT__NIVEAU_UNDEF)); DEFV(genere_Float,INIT(niveau_flottant_substitue_0,Nsubstitution_FLOTTANTE(NEUT(niveau_standard_courant)))); DEFV(genere_Float,INIT(niveau_flottant_substitue_1,FLOT__NIVEAU_UNDEF)); DEFV(genere_Float,INIT(niveau_flottant_substitue_2,FLOT__NIVEAU_UNDEF)); /* Encadrement de la substitutition... */ EGAL(SUCK_SUCK_niveau_standard_courant,SUCK_niveau_standard_courant); EGAL(niveau_flottant_substitue_1,Nsubstitution_FLOTTANTE(SUCK_niveau_standard_courant)); Tant(IFOU(IL_FAUT(iterer_la_substitution_PREK),IL_FAUT(iterer_la_substitution_SUCK))) Bblock Test(IL_FAUT(iterer_la_substitution_PREK)) Bblock EGAL(PREK_niveau_standard_courant ,nPREK_TRON(PREK_niveau_standard_courant,IFmove_avec_substitution_____PAS_COULEURS_d_interpolation) ); Eblock ATes Bblock Eblock ETes Test(IL_FAUT(iterer_la_substitution_SUCK)) Bblock EGAL(SUCK_SUCK_niveau_standard_courant ,nSUCK_TRON(SUCK_SUCK_niveau_standard_courant,IFmove_avec_substitution_____PAS_COULEURS_d_interpolation) ); Eblock ATes Bblock Eblock ETes EGAL(niveau_flottant_substitue_9,Nsubstitution_FLOTTANTE(PREK_niveau_standard_courant)); EGAL(niveau_flottant_substitue_2,Nsubstitution_FLOTTANTE(SUCK_SUCK_niveau_standard_courant)); /* Encadrement de la substitutition... */ Test(IFOU(IFNE(niveau_flottant_substitue_9,niveau_flottant_substitue_1) ,IFLT(PREK_niveau_standard_courant ,nSUCK(NOIR,IFmove_avec_substitution_____PAS_COULEURS_d_interpolation) ) ) ) Bblock EGAL(iterer_la_substitution_PREK,FAUX); /* On arrete d'iterer selon 'nPREK(...)' des que les niveaux '9' et '1' sont differents, ce */ /* donne une derivee partielle non nulle (on arrete aussi d'iterer lorsque l'on atteint le */ /* niveau 'NOIR'). */ Eblock ATes Bblock Eblock ETes Test(IFOU(IFNE(niveau_flottant_substitue_0,niveau_flottant_substitue_2) ,IFGT(SUCK_SUCK_niveau_standard_courant ,nPREK(BLANC,IFmove_avec_substitution_____PAS_COULEURS_d_interpolation) ) ) ) Bblock EGAL(iterer_la_substitution_SUCK,FAUX); /* On arrete d'iterer selon 'nSUCK(...)' des que les niveaux '0' et '2' sont differents, ce */ /* donne une derivee partielle non nulle (on arrete aussi d'iterer lorsque l'on atteint le */ /* niveau 'BLANC'). */ Eblock ATes Bblock Eblock ETes Eblock ETan Test(I3ET(IFEQ(niveau_flottant_substitue_9,niveau_flottant_substitue_0) ,IFEQ(niveau_flottant_substitue_0,niveau_flottant_substitue_1) ,IFEQ(niveau_flottant_substitue_1,niveau_flottant_substitue_2) ) ) Bblock Test(IL_FAUT(IFmove_avec_substitution_____editer_le_message_des_zones_plates)) /* Test introduit le 20230419144942... */ Bblock PRINT_ATTENTION("la substitution utilisee contient des zones plates 'inhibant' l'interpolation"); Eblock ATes Bblock Eblock ETes Eblock ATes Bblock Eblock ETes EGAL(niveau_flottant_substitue ,INTERPOLATION_CUBIQUE(niveau_flottant_substitue_0 ,DERIVATION_NUMERIQUE(niveau_flottant_substitue_9,niveau_flottant_substitue_1 ,PREK_niveau_standard_courant,SUCK_niveau_standard_courant ) ,niveau_flottant_substitue_1 ,DERIVATION_NUMERIQUE(niveau_flottant_substitue_0,niveau_flottant_substitue_2 ,niveau_standard_courant,SUCK_SUCK_niveau_standard_courant ) ,SOUS(niveau_flottant_courant_dans_NOIR_BLANC,FLOT(niveau_standard_courant)) ) ); /* Et enfin, interpolation... */ Eblock ETes storeF_point(niveau_flottant_substitue,imageR,X,Y); /* Enfin, rangement du niveau substitue... */ Eblock end_image RETIF(imageR); Eblock #undef DERIVATION_NUMERIQUE #undef Nsubstitution_FLOTTANTE EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* L I S S A G E P A R A P P R O X I M A T I O N P A R A B O L I Q U E */ /* D ' U N E I M A G E " F L O T T A N T E " : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Logical,SINT(IFlissage_parabolique_____compatibilite_20031025,FAUX))); /* Permet de generer des images suivant la methode anterieure au 20031025151647 en */ /* reintroduisant les effets de bord. Cela a ete introduit lors de la mise au point */ /* de 'v $xiirf/.PAYT.9.11.$U lissage.X' pour creer l'image 'v $xiirf/PAYT.91$M'... */ DEFV(Common,DEFV(Logical,SINT(IFlissage_parabolique_____renormaliser_avant_le_lissage,FAUX))); DEFV(Common,DEFV(Logical,SINT(IFlissage_parabolique_____renormaliser_apres_le_lissage,FAUX))); /* Introduit le 20150114173829 afin de pouvoir, si besoin est, renormaliser avant et */ /* et apres le lissage. Ceci fut introduit apres avoir remarque que bien souvent avant, */ /* puis apres un lissage, une normalisation est effectuee... */ DEFV(Common,DEFV(FonctionF,POINTERF(IFlissage_parabolique(imageR,imageA,nombre_de_passes,horizontal,vertical,pas_h,pas_v)))) DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] lissee. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Positive,nombre_de_passes)); /* Nombre de passes de lissage. */ DEFV(Argument,DEFV(Logical,horizontal)); DEFV(Argument,DEFV(Logical,vertical)); /* Controle des deux directions "horizontale" et "verticale" de lissage. */ DEFV(Argument,DEFV(Positive,pas_h)); DEFV(Argument,DEFV(Positive,pas_v)); /* Pas de lissage. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ Test(IL_FAUT(IFlissage_parabolique_____renormaliser_avant_le_lissage)) /* Introduit le 20150114173829... */ Bblock CALS(IFnormalisation_automatique(imageR,imageA)); /* Initialisation de 'imageR'. */ Eblock ATes Bblock CALS(IFmove(imageR,imageA)); /* Initialisation de 'imageR'. */ Eblock ETes Repe(nombre_de_passes) Bblock Test(IL_FAUT(horizontal)) Bblock CALS(IFmove(imageA,imageR)); /* Pour preparer l'iteration... */ begin_image Bblock Test(IFOU(IL_FAUT(IFlissage_parabolique_____compatibilite_20031025) ,IFET(IL_NE_FAUT_PAS(IFlissage_parabolique_____compatibilite_20031025) ,IFINff(X,nSUCX_TRON(nSUCX_TRON(Xmin,pas_h),pas_h),nPREX_TRON(nPREX_TRON(Xmax,pas_h),pas_h)) ) ) ) Bblock /* Ce test a ete introduit le 20031025151647 afin de supprimer les effets de bord... */ DEFV(genere_Float,INIT(point_n_m2 ,loadF_point(imageA ,nPREX_TRON(nPREX_TRON(X,pas_h),pas_h) ,Y ) ) ); DEFV(genere_Float,INIT(point_n_m1 ,loadF_point(imageA ,nPREX_TRON(X,pas_h) ,Y ) ) ); DEFV(genere_Float,INIT(point_n_0 ,loadF_point(imageA ,X ,Y ) ) ); DEFV(genere_Float,INIT(point_n_p1 ,loadF_point(imageA ,nSUCX_TRON(X,pas_h) ,Y ) ) ); DEFV(genere_Float,INIT(point_n_p2 ,loadF_point(imageA ,nSUCX_TRON(nSUCX_TRON(X,pas_h),pas_h) ,Y ) ) ); storeF_point(LISSAGE_PAR_APPROXIMATION_PARABOLIQUE(point_n_m2,point_n_m1,point_n_0,point_n_p1,point_n_p2) ,imageR ,X,Y ); Eblock ATes Bblock Eblock ETes Eblock end_image Eblock ATes Bblock Eblock ETes Test(IL_FAUT(vertical)) Bblock CALS(IFmove(imageA,imageR)); /* Pour preparer l'iteration... */ begin_image Bblock Test(IFOU(IL_FAUT(IFlissage_parabolique_____compatibilite_20031025) ,IFET(IL_NE_FAUT_PAS(IFlissage_parabolique_____compatibilite_20031025) ,IFINff(Y,nSUCY_TRON(nSUCY_TRON(Ymin,pas_h),pas_h),nPREY_TRON(nPREY_TRON(Ymax,pas_h),pas_h)) ) ) ) Bblock /* Ce test a ete introduit le 20031025151647 afin de supprimer les effets de bord... */ DEFV(genere_Float,INIT(point_n_m2 ,loadF_point(imageA ,X ,nPREY_TRON(nPREY_TRON(Y,pas_v),pas_v) ) ) ); DEFV(genere_Float,INIT(point_n_m1 ,loadF_point(imageA ,X ,nPREY_TRON(Y,pas_v) ) ) ); DEFV(genere_Float,INIT(point_n_0 ,loadF_point(imageA ,X ,Y ) ) ); DEFV(genere_Float,INIT(point_n_p1 ,loadF_point(imageA ,X ,nSUCY_TRON(Y,pas_v) ) ) ); DEFV(genere_Float,INIT(point_n_p2 ,loadF_point(imageA ,X ,nSUCY_TRON(nSUCY_TRON(Y,pas_v),pas_v) ) ) ); storeF_point(LISSAGE_PAR_APPROXIMATION_PARABOLIQUE(point_n_m2,point_n_m1,point_n_0,point_n_p1,point_n_p2) ,imageR ,X,Y ); Eblock ATes Bblock Eblock ETes Eblock end_image Eblock ATes Bblock Eblock ETes Eblock ERep Test(IL_FAUT(IFlissage_parabolique_____renormaliser_apres_le_lissage)) /* Introduit le 20150114173829... */ Bblock CALS(IFnormalisation_automatique(imageA,imageR)); CALS(IFmove(imageR,imageA)); /* Normalisation de 'imageR'. */ Eblock ATes Bblock Eblock ETes RETIF(imageR); Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* R E E C H A N T I L L O N N A G E D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ #if (dfd(GESTION_DU_FORMAT_DES_IMAGES_VERSION_01)) /* Common,DEFV(Fonction,) */ #Aif (dfd(GESTION_DU_FORMAT_DES_IMAGES_VERSION_01)) /* Common,DEFV(Fonction,) */ #Eif (dfd(GESTION_DU_FORMAT_DES_IMAGES_VERSION_01)) /* Common,DEFV(Fonction,) */ #if ((dfd(GESTION_DU_FORMAT_DES_IMAGES_VERSION_02)) || (dfd(GESTION_DU_FORMAT_DES_IMAGES_VERSION_03))) /* Common,DEFV(Fonction,) */ # ifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_01 /* Common,DEFV(Fonction,) : avec 'VERSION_01'. */ DEFV(Common,DEFV(Logical,_____ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_01)); # Aifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_01 /* Common,DEFV(Fonction,) : avec 'VERSION_01'. */ # Eifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_01 /* Common,DEFV(Fonction,) : avec 'VERSION_01'. */ # ifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_02 /* Common,DEFV(Fonction,) : avec 'VERSION_02'. */ DEFV(Common,DEFV(Logical,_____ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_02)); # Aifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_02 /* Common,DEFV(Fonction,) : avec 'VERSION_02'. */ # Eifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_02 /* Common,DEFV(Fonction,) : avec 'VERSION_02'. */ #Aif ((dfd(GESTION_DU_FORMAT_DES_IMAGES_VERSION_02)) || (dfd(GESTION_DU_FORMAT_DES_IMAGES_VERSION_03))) /* Common,DEFV(Fonction,) */ #Eif ((dfd(GESTION_DU_FORMAT_DES_IMAGES_VERSION_02)) || (dfd(GESTION_DU_FORMAT_DES_IMAGES_VERSION_03))) /* Common,DEFV(Fonction,) */ #if ( (defined(GESTION_DU_FORMAT_DES_IMAGES_VERSION_01)) \ ) #Aif ( (defined(GESTION_DU_FORMAT_DES_IMAGES_VERSION_01)) \ ) #Eif ( (defined(GESTION_DU_FORMAT_DES_IMAGES_VERSION_01)) \ ) #if ( (defined(GESTION_DU_FORMAT_DES_IMAGES_VERSION_02)) \ || (defined(GESTION_DU_FORMAT_DES_IMAGES_VERSION_03)) \ ) # ifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_01 # define ECHANTILLONNAGE_DENORMALISE_DE_L_IMAGE(x,y) \ NIVR(load_point_valide(imageA,x,y)) \ /* Fonction d'echantillonage "entier" de l'image dans [NOIR,BLANC]. */ # define ECHANTILLONNAGE_NORMALISE_DE_L_IMAGE(x,y) \ ______NORMALISE_NIVEAU(load_point_valide(imageA,x,y)) \ /* Fonction d'echantillonage "entier" de l'image dans [0,1]. ATTENTION, l'utilisation */ \ /* des niveaux denormalises (c'est-a-dire dans [0,1]) est absolument necessaire lors de */ \ /* l'utilisation de l'interpolation bicubique, car sinon, il a une tres forte disproportion */ \ /* entre les pas {pasX,pasY} utilises pour la derivation numerique (qui sont donc en general */ \ /* dans [0,1]) et l'amplitude de la fonction "niveau" (qui serait alors, en l'absence de */ \ /* denormalisation, dans [NOIR,BLANC]) ; les derivees seraient alors tres "pentues", et */ \ /* cela crerait alors des rebonds importants... */ # Aifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_01 # Eifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_01 # ifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_02 # define ECHANTILLONNAGE_DENORMALISE_DE_L_IMAGE(x,y) \ NIVR(Fload_point(imageA \ ,x,y \ ,Iredimensionnement_____periodiser_X \ ,Iredimensionnement_____periodiser_Y \ ,Iredimensionnement_____symetriser_X \ ,Iredimensionnement_____symetriser_Y \ ,Iredimensionnement_____prolonger_X \ ,Iredimensionnement_____prolonger_Y \ ,Iredimensionnement_____niveau_hors_image \ ) \ ) \ /* Fonction d'echantillonage "entier" de l'image dans [NOIR,BLANC]. */ # define ECHANTILLONNAGE_NORMALISE_DE_L_IMAGE(x,y) \ ______NORMALISE_NIVEAU(Fload_point(imageA \ ,x,y \ ,Iredimensionnement_____periodiser_X \ ,Iredimensionnement_____periodiser_Y \ ,Iredimensionnement_____symetriser_X \ ,Iredimensionnement_____symetriser_Y \ ,Iredimensionnement_____prolonger_X \ ,Iredimensionnement_____prolonger_Y \ ,Iredimensionnement_____niveau_hors_image \ ) \ ) \ /* Fonction d'echantillonage "entier" de l'image dans [0,1]. */ # Aifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_02 # Eifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_02 # define INITIALISATION_DES_INTERPOLATIONS_BILINEAIRE_ET_BICUBIQUE(Xf_apres_reechantillonnage,Yf_apres_reechantillonnage,tX,tY) \ /* ATTENTION, l'absence de 'Bblock' et de 'Eblock' est due au 'PUSH_ECHANTILLONNAGE' qui */ \ /* suit... */ \ \ gINITIALISATION_DES_INTERPOLATIONS_BILINEAIRE_ET_BICUBIQUE(Xf_apres_reechantillonnage \ ,Yf_apres_reechantillonnage \ ,tX \ ,tY \ ,Iredimensionnement_____utiliser_pasX_et_pasY \ ,Iredimensionnement_____pasX \ ,Iredimensionnement_____pasY \ ); \ \ /* ATTENTION, l'absence de 'Bblock' et de 'Eblock' est due au 'PUSH_ECHANTILLONNAGE' qui */ \ /* suit... */ \ \ /* Initialisation des operations et definition des donnees utiles... */ # define __DENORMALISE_DU_NIVEAU_INTERPOLE(niveau_interpole) \ __DENORMALISE_NIVEAU(niveau_interpole) \ /* Denormalisation du niveau interpole. */ # define RANGEMENT_DU_NIVEAU_INTERPOLE(niveau_interpole,imageR,X_apres_reechantillonnage,Y_apres_reechantillonnage) \ Bblock \ store_point(niveau_interpole \ ,imageR \ ,X_apres_reechantillonnage,Y_apres_reechantillonnage \ ,FVARIABLE \ ); \ /* On n'oubliera pas que {X_apres_reechantillonnage,Y_apres_reechantillonnage} sont des */ \ /* synonymes de {X,Y}... */ \ Eblock \ /* Renvoi du niveau interpole... */ # define REECHANTILLONNAGE_SIMPLISTE(FXf_apres_reechantillonnage,FYf_apres_reechantillonnage,SeqAvant,SeqApres,Tn,Ni) \ Bblock \ begin_image \ Bblock \ DEFV(Int,INIT(X_avant_reechantillonnage,UNDEF)); \ DEFV(Int,INIT(Y_avant_reechantillonnage,UNDEF)); \ /* Coordonnees {X,Y} avant le reechantillonnage, */ \ DEFV(Tn,INIT(niveau_avant_le_reechantillonnage,Ni)); \ /* Et le niveau en ce point {X,Y}... */ \ \ DEFV(Float,INIT(Xf_apres_reechantillonnage,_____cNORMALISE_OX(X_apres_reechantillonnage))); \ DEFV(Float,INIT(Yf_apres_reechantillonnage,_____cNORMALISE_OY(Y_apres_reechantillonnage))); \ /* Coordonnees {X,Y} apres le reechantillonnage et dans [0,1]... */ \ \ BLOC(SeqAvant); \ /* Mise en place du dimensionnement de l'image Argument, */ \ \ EGAL(X_avant_reechantillonnage,_cDENORMALISE_OX(FXf_apres_reechantillonnage)); \ EGAL(Y_avant_reechantillonnage,_cDENORMALISE_OY(FYf_apres_reechantillonnage)); \ /* Afin d'evaluer les coordonnees {X,Y} avant le reechantillonnage, */ \ EGAL(niveau_avant_le_reechantillonnage \ ,ECHANTILLONNAGE_DENORMALISE_DE_L_IMAGE(X_avant_reechantillonnage \ ,Y_avant_reechantillonnage \ ) \ ); \ /* Et le niveau en ce point. Dans l'etat actuel des choses, il n'y a ici aucune */ \ /* interpolation "sophistiquee", mais uniquement une bete replication (ou suppression, */ \ /* suivant le rapport des images Argument et Resultat) des points... */ \ /* */ \ /* On notera le 20140310105657 que si les dimensions des deux images (Argument et Resultat) */ \ /* ne se divisent pas exactement l'une l'autre, l'espacement entre les points ne sera pas */ \ /* constant. Cela s'est vu a cette date avec 'v $xrCD/Transfere.01$vv$Y 4000x3000' en */ \ /* passant d'une image 3000x3000 (extraite d'une image 4000x3000 en utilisant le mode */ \ /* 'REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_MISE_AU_CENTRE') a une image 'Sdu'. */ \ /* Le parcours de l'un des axes ('OX' par exemple) de l'image 3000x3000 se fait de la facon */ \ /* suivante (1024 ne divisant pas 3000) : */ \ /* */ \ /* x=0 */ \ /* x=2 2-0 = 2 (au lieu de 3...) */ \ /* x=5 */ \ /* x=8 */ \ /* x=11 */ \ /* x=14 */ \ /* x=17 */ \ /* x=20 */ \ /* x=23 */ \ /* x=26 */ \ /* x=29 */ \ /* x=32 */ \ /* x=35 */ \ /* x=38 */ \ /* x=41 */ \ /* x=43 43-41 = 2 (au lieu de 3...) */ \ /* x=46 */ \ /* x=49 */ \ /* (...) */ \ /* */ \ /* ce qui montre que le parcours n'est pas regulier (le "pas" n'est pas constant...). */ \ \ BLOC(SeqApres); \ /* Remise en place du dimensionnement de l'image Resultat. */ \ \ FIN_DES_INTERPOLATIONS_LINEAIRE_BILINEAIRE_ET_BICUBIQUE \ (niveau_avant_le_reechantillonnage \ ,TOUJOURS_MARQUER_A_LA_FIN_DES_INTERPOLATIONS_LINEAIRE_BILINEAIRE_ET_BICUBIQUE \ ); \ /* Fin des operations, avec rangement du niveau interpole en particulier... */ \ Eblock \ end_image \ Eblock \ /* Reechantillonnage "simpliste" introduit le 20090511003816 sous cette forme afin de */ \ /* l'utiliser dans 'IFredimensionnement(...)'... */ DEFV(Common,DEFV(Float,ZINT(REECHANTILLONNAGE_BILINEAIRE_____facteur__X_barycentrique,NE_PAS_BLOQUER_L_INTERPOLATION_X))); DEFV(Common,DEFV(Float,ZINT(REECHANTILLONNAGE_BILINEAIRE_____facteur__Y_barycentrique,NE_PAS_BLOQUER_L_INTERPOLATION_Y))); /* Introduit le 20220917123526, on ne sait jamais... */ /* */ /* Les tests effectues le 20220917184642 ne semblent pas en montrer l'utilite, sauf */ /* peut-etre pour creer des effets "artistiques"... */ # define REECHANTILLONNAGE_BILINEAIRE(FXf_apres_reechantillonnage,FYf_apres_reechantillonnage,SeqAvant,SeqApres,Tn,Ni,tX,tY,g) \ Bblock \ begin_image \ Bblock \ VOISINAGE_POINT_BILINEAIRE(FXf_apres_reechantillonnage \ ,FYf_apres_reechantillonnage \ ,BLOC(SeqAvant) \ ,BLOC(SeqApres) \ ,Tn \ ,Ni \ ,tX \ ,tY \ ,g \ ,REECHANTILLONNAGE_BILINEAIRE_____facteur__X_barycentrique \ ,REECHANTILLONNAGE_BILINEAIRE_____facteur__Y_barycentrique \ ); \ /* Fin des operations, avec rangement du niveau interpole en particulier... */ \ /* */ \ /* Le 20081001092100 furent introduits 'NE_PAS_BLOQUER_L_INTERPOLATION_?'... */ \ Eblock \ end_image \ Eblock \ /* Reechantillonnage bilineaire general introduit le 20090511003816 a cause de l'usage */ \ /* qui en est fait dans 'IFredimensionnement(...)' et dans laquelle il ne faut surtout */ \ /* pas utiliser 'gGENP(...)', d'ou le 'g(...)' qui permet donc d'utiliser 'NEUT(...)' si */ \ /* besoin est. Le 20050322105819 une nouvelle forme fut adoptee afin de permettre l'usage */ \ /* 'v $xiipf/fonction.2$FON VOISINAGE_POINT_BILINEAIRE'... */ DEFV(Common,DEFV(Float,ZINT(REECHANTILLONNAGE_BICUBIQUE_____facteur__X_barycentrique,NE_PAS_BLOQUER_L_INTERPOLATION_X))); DEFV(Common,DEFV(Float,ZINT(REECHANTILLONNAGE_BICUBIQUE_____facteur__Y_barycentrique,NE_PAS_BLOQUER_L_INTERPOLATION_Y))); /* Introduit le 20220917123526, on ne sait jamais... */ /* */ /* Les tests effectues le 20220917184642 ne semblent pas en montrer l'utilite, sauf */ /* peut-etre pour creer des effets "artistiques"... */ # define REECHANTILLONNAGE_BICUBIQUE(FXf_apres_reechantillonnage,FYf_apres_reechantillonnage,SeqAvant,SeqApres,Tn,Ni,tX,tY) \ /* Les arguments {tX,tY} ont ete introduits le 20030825110246. */ \ Bblock \ begin_image \ Bblock \ VOISINAGE_POINT_BICUBIQUE(FXf_apres_reechantillonnage \ ,FYf_apres_reechantillonnage \ ,BLOC(SeqAvant) \ ,BLOC(SeqApres) \ ,Tn \ ,Ni \ ,tX \ ,tY \ ,REECHANTILLONNAGE_BICUBIQUE_____facteur__X_barycentrique \ ,REECHANTILLONNAGE_BICUBIQUE_____facteur__Y_barycentrique \ ); \ /* Fin des operations, avec rangement du niveau interpole en particulier... */ \ /* */ \ /* Le 20080930163216 furent introduits 'NE_PAS_BLOQUER_L_INTERPOLATION_?'... */ \ Eblock \ end_image \ Eblock \ /* Reechantillonnage bicubique. On notera le 20050313175348 le changement des noms de deux */ \ /* parametres 'Ty,In' en 'Tn,Ni' plus logiques au niveau mnemonique ("Tn" pour "Type Niveau" */ \ /* et "Ni" pour "Niveau Indefini"...). */ # define REECHANTILLONNAGE_SANS_REECHANTILLONNAGE(tranX_apres,tranY_apres,tranX_avant,tranY_avant,SeqAvant,SeqApres,Tn,Ni) \ Bblock \ begin_image \ /* On n'oubliera pas que {X_apres_reechantillonnage,Y_apres_reechantillonnage} sont des */ \ /* synonymes de {X,Y}... */ \ Bblock \ DEFV(Int,INIT(Xa_avant_reechantillonnage,UNDEF)); \ DEFV(Int,INIT(Ya_avant_reechantillonnage,UNDEF)); \ /* Coordonnees {X,Y} avant le reechantillonnage et en Absolu. */ \ DEFV(Tn,INIT(niveau_avant_le_reechantillonnage,Ni)); \ /* Et le niveau en ce point {X,Y}... */ \ DEFV(Logical,INIT(c_est_un_niveau_manquant,FAUX)); \ /* A priori, le niveau 'niveau_avant_le_reechantillonnage' n'est pas manquant... */ \ \ DEFV(Int,INIT(Xr_apres_reechantillonnage,SOUS(COXR(X_apres_reechantillonnage),tranX_apres))); \ DEFV(Int,INIT(Yr_apres_reechantillonnage,SOUS(COYR(Y_apres_reechantillonnage),tranY_apres))); \ /* Coordonnees {X,Y} apres le reechantillonnage et en Relatif. */ \ \ BLOC(SeqAvant); \ /* Mise en place du dimensionnement de l'image Argument, */ \ \ EGAL(Xa_avant_reechantillonnage,COXA(ADD2(Xr_apres_reechantillonnage,tranX_avant))); \ EGAL(Ya_avant_reechantillonnage,COYA(ADD2(Yr_apres_reechantillonnage,tranY_avant))); \ /* Afin d'evaluer les coordonnees {X,Y} avant le reechantillonnage et en Absolu. */ \ \ Test(TEST_DANS_L_IMAGE(Xa_avant_reechantillonnage,Ya_avant_reechantillonnage)) \ Bblock \ EGAL(niveau_avant_le_reechantillonnage \ ,ECHANTILLONNAGE_DENORMALISE_DE_L_IMAGE(Xa_avant_reechantillonnage \ ,Ya_avant_reechantillonnage \ ) \ ); \ /* Lorsque le point avant reechantillonnage est dans l'image Argument, c'est sa valeur */ \ /* qui va etre utilisee pour l'image Resultat... */ \ Eblock \ ATes \ Bblock \ EGAL(niveau_avant_le_reechantillonnage,REECHANTILLONNAGE_GENERAL_____niveau_manquant); \ /* Lorsque le point avant reechantillonnage n'est pas dans l'image Argument, un niveau */ \ /* arbitraire est fixe... */ \ EGAL(c_est_un_niveau_manquant,VRAI); \ /* Et ce afin de ne pas tracer, eventuellement... */ \ Eblock \ ETes \ \ BLOC(SeqApres); \ /* Remise en place du dimensionnement de l'image Resultat. */ \ \ FIN_DES_INTERPOLATIONS_LINEAIRE_BILINEAIRE_ET_BICUBIQUE \ (niveau_avant_le_reechantillonnage \ ,IFOU(EST_FAUX(c_est_un_niveau_manquant) \ ,IFET(EST_VRAI(c_est_un_niveau_manquant) \ ,IL_FAUT(REECHANTILLONNAGE_GENERAL_____marquer_les_niveaux_manquants) \ ) \ ) \ ); \ /* Fin des operations, avec rangement du niveau interpole en particulier si cela est */ \ /* demande (dans le cas des 'REECHANTILLONNAGE_GENERAL_____niveau_manquant'). */ \ Eblock \ end_image \ Eblock \ /* Procedure de reechantillonnage sans reechantillonnage qui se contente de rajouter un */ \ /* niveau particulier ('REECHANTILLONNAGE_GENERAL_____niveau_manquant') lorsqu'il n'y a pas */ \ /* assez de point dans l'image Argument, et a l'inverse qui en supprime lorsqu'il y en a */ \ /* trop... */ DEFV(Common,DEFV(Logical,ZINT(REECHANTILLONNAGE_GENERAL_____compatibilite_20170316,FAUX))); /* Introduit le 20170316085025 afin de permettre de retablir le comportement anterieur */ /* de 'REECHANTILLONNAGE_GENERAL(...)'. */ # define REECHANTILLONNAGE_GENERAL(FXf_apres_reechantillonnage,FYf_apres_reechantillonnage,SeqAvant,SeqApres,Tn,Ni,RX,RY,AX,AY,g) \ /* Le 20090515091829 les arguments {Tn,Ni,RX,RY,AX,AY} ont ete ajoutes afin de pouvoir */ \ /* utiliser 'REECHANTILLONNAGE_GENERAL(...)' dans 'IFredimensionnement(...)'. */ \ Bblock \ Choi(methode) \ /* Validation effective de la methode demandee : */ \ Bblock \ Ca1e(REECHANTILLONNAGE_PAR_REPLICATION_ET_DESTRUCTION) \ Bblock \ /* Methode demandee reconnue. */ \ Eblock \ ECa1 \ \ Ca1e(REECHANTILLONNAGE_PAR_INTERPOLATION_BILINEAIRE) \ Bblock \ /* Methode demandee reconnue. */ \ Test(EST_VRAI(LE_FORMAT_RESULTAT_EST_DIFFERENT_DU_FORMAT_ARGUMENT(XminR,XmaxR,YminR,YmaxR \ ,XminA,XmaxA,YminA,YmaxA \ ) \ ) \ ) \ /* Test introduit le 20170315183858 afin que lorsque '$formatIR' est identique a '$formatI' */ \ /* le reechantillonnnage ne fait rien. Cela a ete deplace ici le 20170316075351... */ \ Bblock \ Eblock \ ATes \ Bblock \ Test(IL_FAUT(REECHANTILLONNAGE_GENERAL_____compatibilite_20170316)) \ /* Test introduit le 20170316085025... */ \ Bblock \ Eblock \ ATes \ Bblock \ EGAL(methode_de_reechantillonnage_utilisee \ ,REECHANTILLONNAGE_PAR_REPLICATION_ET_DESTRUCTION \ ); \ /* Afin de garantir alors que 'imageR' et 'imageA' seront bien identiques, mais il semble */ \ /* que pour 'REECHANTILLONNAGE_PAR_INTERPOLATION_BILINEAIRE', comme les tests l'ont montre */ \ /* aux environs du 20170315183858, cela ne soit pas utile sauf si "standard=FAUX" comme les */ \ /* experiences l'ont montrees environs du 20170316103138... */ \ Eblock \ ETes \ Eblock \ ETes \ Eblock \ ECa1 \ \ Ca1e(REECHANTILLONNAGE_PAR_INTERPOLATION_BICUBIQUE) \ Bblock \ /* Methode demandee reconnue. */ \ Test(EST_VRAI(LE_FORMAT_RESULTAT_EST_DIFFERENT_DU_FORMAT_ARGUMENT(XminR,XmaxR,YminR,YmaxR \ ,XminA,XmaxA,YminA,YmaxA \ ) \ ) \ ) \ /* Test introduit le 20170315183858 afin que lorsque '$formatIR' est identique a '$formatI' */ \ /* le reechantillonnnage ne fait rien. Cela a ete deplace ici le 20170316075351... */ \ Bblock \ Eblock \ ATes \ Bblock \ Test(IL_FAUT(REECHANTILLONNAGE_GENERAL_____compatibilite_20170316)) \ /* Test introduit le 20170316085025... */ \ Bblock \ Eblock \ ATes \ Bblock \ EGAL(methode_de_reechantillonnage_utilisee \ ,REECHANTILLONNAGE_PAR_REPLICATION_ET_DESTRUCTION \ ); \ /* Afin de garantir alors que 'imageR' et 'imageA' seront bien identiques... */ \ Eblock \ ETes \ Eblock \ ETes \ Eblock \ ECa1 \ \ Ca1e(REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_MISE_DANS_LE_COIN_BAS_GAUCHE) \ Bblock \ /* Methode demandee reconnue. */ \ Eblock \ ECa1 \ \ Ca1e(REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_MISE_DANS_LE_COIN_BAS_DROITE) \ Bblock \ /* Methode demandee reconnue. */ \ Eblock \ ECa1 \ \ Ca1e(REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_MISE_DANS_LE_COIN_HAUT_DROITE) \ Bblock \ /* Methode demandee reconnue. */ \ Eblock \ ECa1 \ \ Ca1e(REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_MISE_DANS_LE_COIN_HAUT_GAUCHE) \ Bblock \ /* Methode demandee reconnue. */ \ Eblock \ ECa1 \ \ Ca1e(REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_COINCIDENCE_DES_MILIEUX_INFERIEURS) \ Bblock \ /* Methode demandee reconnue. */ \ Eblock \ ECa1 \ \ Ca1e(REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_COINCIDENCE_DES_MILIEUX_DROITES) \ Bblock \ /* Methode demandee reconnue. */ \ Eblock \ ECa1 \ \ Ca1e(REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_COINCIDENCE_DES_MILIEUX_SUPERIEURS) \ Bblock \ /* Methode demandee reconnue. */ \ Eblock \ ECa1 \ \ Ca1e(REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_COINCIDENCE_DES_MILIEUX_GAUCHES) \ Bblock \ /* Methode demandee reconnue. */ \ Eblock \ ECa1 \ \ Ca1e(REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_MISE_AU_CENTRE) \ Bblock \ /* Methode demandee reconnue. */ \ Eblock \ ECa1 \ \ Ca1e(REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_POSITIONNEMENT_QUELCONQUE) \ Bblock \ /* Methode demandee reconnue. */ \ Eblock \ ECa1 \ \ Defo \ Bblock \ EGAL(methode_de_reechantillonnage_utilisee,METHODE_IMPLICITE_DE_REECHANTILLONNAGE); \ \ PRINT_ERREUR("la methode demandee n'existe pas, la methode implicite va etre utilisee"); \ CAL1(Prer2("(la methode implicite est la methode '%d' alors que la methode '%d' etait demandee)\n" \ ,methode_de_reechantillonnage_utilisee \ ,methode \ ) \ ); \ Eblock \ EDef \ Eblock \ ECho \ \ Choi(methode_de_reechantillonnage_utilisee) \ Bblock \ Ca1e(REECHANTILLONNAGE_PAR_REPLICATION_ET_DESTRUCTION) \ Bblock \ REECHANTILLONNAGE_SIMPLISTE(FXf_apres_reechantillonnage \ ,FYf_apres_reechantillonnage \ ,BLOC(SeqAvant) \ ,BLOC(SeqApres) \ ,Tn \ ,Ni \ ); \ Eblock \ ECa1 \ \ Ca1e(REECHANTILLONNAGE_PAR_INTERPOLATION_BILINEAIRE) \ Bblock \ REECHANTILLONNAGE_BILINEAIRE(FXf_apres_reechantillonnage \ ,FYf_apres_reechantillonnage \ ,BLOC(SeqAvant) \ ,BLOC(SeqApres) \ ,Tn \ ,Ni \ ,FZERO \ ,FZERO \ ,g \ ); \ Eblock \ ECa1 \ \ Ca1e(REECHANTILLONNAGE_PAR_INTERPOLATION_BICUBIQUE) \ Bblock \ REECHANTILLONNAGE_BICUBIQUE(FXf_apres_reechantillonnage \ ,FYf_apres_reechantillonnage \ ,BLOC(SeqAvant) \ ,BLOC(SeqApres) \ ,Tn \ ,Ni \ ,FZERO \ ,FZERO \ ); \ Eblock \ ECa1 \ \ Ca1e(REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_MISE_DANS_LE_COIN_BAS_GAUCHE) \ Bblock \ REECHANTILLONNAGE_SANS_REECHANTILLONNAGE(SOUS(XminR,XminR),SOUS(YminR,YminR) \ ,SOUS(XminA,XminA),SOUS(YminA,YminA) \ ,BLOC(SeqAvant) \ ,BLOC(SeqApres) \ ,Tn \ ,Ni \ ); \ /* Reechantillonnage sans reechantillonnage avec mise en coincidence des coins "bas-gauche" */ \ /* des images Argument et Resultat (c'est-a-dire que le point (XminA,YminA) et le point */ \ /* (XminR,YminR) coincident... */ \ Eblock \ ECa1 \ \ Ca1e(REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_MISE_DANS_LE_COIN_BAS_DROITE) \ Bblock \ REECHANTILLONNAGE_SANS_REECHANTILLONNAGE(DIMENSION(XminR,XmaxR),SOUS(YminR,YminR) \ ,DIMENSION(XminA,XmaxA),SOUS(YminA,YminA) \ ,BLOC(SeqAvant) \ ,BLOC(SeqApres) \ ,Tn \ ,Ni \ ); \ /* Reechantillonnage sans reechantillonnage avec mise en coincidence des coins "bas-droite" */ \ /* des images Argument et Resultat (c'est-a-dire que le point (XmaxA,YminA) et le point */ \ /* (XmaxR,YminR) coincident... */ \ Eblock \ ECa1 \ \ Ca1e(REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_MISE_DANS_LE_COIN_HAUT_DROITE) \ Bblock \ REECHANTILLONNAGE_SANS_REECHANTILLONNAGE(DIMENSION(XminR,XmaxR),DIMENSION(YminR,YmaxR) \ ,DIMENSION(XminA,XmaxA),DIMENSION(YminA,YmaxA) \ ,BLOC(SeqAvant) \ ,BLOC(SeqApres) \ ,Tn \ ,Ni \ ); \ /* Reechantillonnage sans reechantillonnage avec mise en coincidence des coins "haut-droite" */ \ /* des images Argument et Resultat (c'est-a-dire que le point (XmaxA,YmaxA) et le point */ \ /* (XmaxR,YmaxR) coincident... */ \ Eblock \ ECa1 \ \ Ca1e(REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_MISE_DANS_LE_COIN_HAUT_GAUCHE) \ Bblock \ REECHANTILLONNAGE_SANS_REECHANTILLONNAGE(SOUS(XminR,XminR),DIMENSION(YminR,YmaxR) \ ,SOUS(XminA,XminA),DIMENSION(YminA,YmaxA) \ ,BLOC(SeqAvant) \ ,BLOC(SeqApres) \ ,Tn \ ,Ni \ ); \ /* Reechantillonnage sans reechantillonnage avec mise en coincidence des coins "haut-gauche" */ \ /* des images Argument et Resultat (c'est-a-dire que le point (XminA,YmaxA) et le point */ \ /* (XminR,YmaxR) coincident). */ \ Eblock \ ECa1 \ \ Ca1e(REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_COINCIDENCE_DES_MILIEUX_INFERIEURS) \ Bblock \ REECHANTILLONNAGE_SANS_REECHANTILLONNAGE(MOIT(DIMENSION(XminR,XmaxR)),SOUS(YminR,YminR) \ ,MOIT(DIMENSION(XminA,XmaxA)),SOUS(YminA,YminA) \ ,BLOC(SeqAvant) \ ,BLOC(SeqApres) \ ,Tn \ ,Ni \ ); \ /* Reechantillonnage sans reechantillonnage avec mise en coincidence des milieux des cotes */ \ /* inferieurs images Argument et Resultat (introduit le 20240527145959). */ \ Eblock \ ECa1 \ \ Ca1e(REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_COINCIDENCE_DES_MILIEUX_DROITES) \ Bblock \ REECHANTILLONNAGE_SANS_REECHANTILLONNAGE(DIMENSION(XminR,XmaxR),MOIT(DIMENSION(YminR,YmaxR)) \ ,DIMENSION(XminA,XmaxA),MOIT(DIMENSION(YminA,YmaxA)) \ ,BLOC(SeqAvant) \ ,BLOC(SeqApres) \ ,Tn \ ,Ni \ ); \ /* Reechantillonnage sans reechantillonnage avec mise en coincidence des milieux des cotes */ \ /* droite images Argument et Resultat (introduit le 20240527145959). */ \ Eblock \ ECa1 \ \ Ca1e(REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_COINCIDENCE_DES_MILIEUX_SUPERIEURS) \ Bblock \ REECHANTILLONNAGE_SANS_REECHANTILLONNAGE(MOIT(DIMENSION(XminR,XmaxR)),DIMENSION(YminR,YmaxR) \ ,MOIT(DIMENSION(XminA,XmaxA)),DIMENSION(YminA,YmaxA) \ ,BLOC(SeqAvant) \ ,BLOC(SeqApres) \ ,Tn \ ,Ni \ ); \ /* Reechantillonnage sans reechantillonnage avec mise en coincidence des milieux des cotes */ \ /* superieurs images Argument et Resultat (introduit le 20240527145959). */ \ Eblock \ ECa1 \ \ Ca1e(REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_COINCIDENCE_DES_MILIEUX_GAUCHES) \ Bblock \ REECHANTILLONNAGE_SANS_REECHANTILLONNAGE(SOUS(XminR,XminR),MOIT(DIMENSION(YminR,YmaxR)) \ ,SOUS(XminA,XminA),MOIT(DIMENSION(YminA,YmaxA)) \ ,BLOC(SeqAvant) \ ,BLOC(SeqApres) \ ,Tn \ ,Ni \ ); \ /* Reechantillonnage sans reechantillonnage avec mise en coincidence des milieux des cotes */ \ /* gauches images Argument et Resultat (introduit le 20240527145959). */ \ Eblock \ ECa1 \ \ Ca1e(REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_MISE_AU_CENTRE) \ Bblock \ REECHANTILLONNAGE_SANS_REECHANTILLONNAGE(MOIT(DIMENSION(XminR,XmaxR)),MOIT(DIMENSION(YminR,YmaxR)) \ ,MOIT(DIMENSION(XminA,XmaxA)),MOIT(DIMENSION(YminA,YmaxA)) \ ,BLOC(SeqAvant) \ ,BLOC(SeqApres) \ ,Tn \ ,Ni \ ); \ /* Reechantillonnage sans reechantillonnage avec mise en coincidence des centres des images */ \ /* Argument et Resultat. */ \ Eblock \ ECa1 \ \ Ca1e(REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_POSITIONNEMENT_QUELCONQUE) \ Bblock \ REECHANTILLONNAGE_SANS_REECHANTILLONNAGE(_lDENORMALISE_OX(RX) \ ,_lDENORMALISE_OY(RY) \ ,AX \ ,AY \ ,BLOC(SeqAvant) \ ,BLOC(SeqApres) \ ,Tn \ ,Ni \ ); \ /* Reechantillonnage sans reechantillonnage avec positionnement quelconque de l'image */ \ /* Argument par rapport a l'image Resultat. */ \ Eblock \ ECa1 \ \ Defo \ Bblock \ PRINT_ERREUR("la methode implicite n'est pas disponible, le reechantillonnage n'a pas eu lieu"); \ /* On notera qu'a priori il est impossible que METHODE_IMPLICITE_DE_REECHANTILLONNAGE' */ \ /* n'existe pas ; on ne doit donc jamais passer par ici... */ \ Eblock \ EDef \ Eblock \ ECho \ Eblock \ /* Procedure generale de reechantillonnage... */ #Aif ( (defined(GESTION_DU_FORMAT_DES_IMAGES_VERSION_02)) \ || (defined(GESTION_DU_FORMAT_DES_IMAGES_VERSION_03)) \ ) #Eif ( (defined(GESTION_DU_FORMAT_DES_IMAGES_VERSION_02)) \ || (defined(GESTION_DU_FORMAT_DES_IMAGES_VERSION_03)) \ ) /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* R E D I M E N S I O N N E M E N T , D E F O R M A T I O N D ' U N E I M A G E E T */ /* T R A N S F O R M A T I O N D ' U N E I M A G E P A R D E P L A C E M E N T */ /* D E S C O O R D O N N E E S V I A D E U X A U T R E S I M A G E S : */ /* */ /*************************************************************************************************************************************/ #if (dfd(GESTION_DU_FORMAT_DES_IMAGES_VERSION_01)) /* Common,DEFV(Fonction,) */ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Idistorsion_par_un_champ(imageR ,imageA ,facteur_multiplicatif_X,imageX,anti_translation_des_niveaux_de_imageX ,facteur_multiplicatif_Y,imageY,anti_translation_des_niveaux_de_imageY ,methode ) ) ) ) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] "deformee" via ses coordonnees... */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Float,facteur_multiplicatif_X)); DEFV(Argument,DEFV(image,imageX)); DEFV(Argument,DEFV(genere_p,anti_translation_des_niveaux_de_imageX)); /* Image donnant apres "anti-translation", puis denormalisation et enfin multiplication */ /* par un facteur la translation des coordonnees 'X' de l'image Argument. */ DEFV(Argument,DEFV(Float,facteur_multiplicatif_Y)); DEFV(Argument,DEFV(image,imageY)); DEFV(Argument,DEFV(genere_p,anti_translation_des_niveaux_de_imageY)); /* Image donnant apres "anti-translation", puis denormalisation et enfin multiplication */ /* par un facteur la translation des coordonnees 'Y' de l'image Argument. */ DEFV(Argument,DEFV(Int,methode)); /* Methode de distorsion demandee. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ PRINT_ATTENTION("la distorsion des images par un champ n'est pas disponible, un simple 'move' est fait"); iMOVE(imageR,imageA); /* Renvoi du Resultat (voir les commentaires relatifs a la procedure */ /* 'iMOVE(...)' dans 'v $xiii/di_image$DEF' remplacant 'Imove(..)' ici le 20021003123449). */ RETI(imageR); Eblock EFonctionP BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFdistorsion_par_un_champ(imageR ,imageA ,facteur_multiplicatif_X,imageX,anti_translation_des_niveaux_de_imageX ,facteur_multiplicatif_Y,imageY,anti_translation_des_niveaux_de_imageY ,methode ) ) ) ) /* Fonction introduite le 20210603101332... */ DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] "deformee" via ses coordonnees... */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Float,facteur_multiplicatif_X)); DEFV(Argument,DEFV(imageF,imageX)); DEFV(Argument,DEFV(genere_Float,anti_translation_des_niveaux_de_imageX)); /* Image donnant apres "anti-translation", puis denormalisation et enfin multiplication */ /* par un facteur la translation des coordonnees 'X' de l'image Argument. */ DEFV(Argument,DEFV(Float,facteur_multiplicatif_Y)); DEFV(Argument,DEFV(imageF,imageY)); DEFV(Argument,DEFV(genere_Float,anti_translation_des_niveaux_de_imageY)); /* Image donnant apres "anti-translation", puis denormalisation et enfin multiplication */ /* par un facteur la translation des coordonnees 'Y' de l'image Argument. */ DEFV(Argument,DEFV(Int,methode)); /* Methode de distorsion demandee. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ PRINT_ATTENTION("la distorsion des images par un champ n'est pas disponible, un simple 'move' est fait"); CALS(IFmove(imageR,imageA)); /* Renvoi du Resultat (voir les commentaires relatifs a la procedure */ /* 'iMOVE(...)' dans 'v $xiii/di_image$DEF' remplacant 'Imove(..)' ici le 20021003123449). */ RETIF(imageR); Eblock EFonctionF BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Iredimensionnement(imageR,XminR,XmaxR,YminR,YmaxR,imageA,XminA,XmaxA,YminA,YmaxA,methode)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] non reechantillonnee. */ DEFV(Argument,DEFV(Int,XminR)); DEFV(Argument,DEFV(Int,XmaxR)); DEFV(Argument,DEFV(Int,YminR)); DEFV(Argument,DEFV(Int,YmaxR)); /* Dimensions de l'image Resultat. Ces definitions ne sont faites que pour permettre */ /* l'utilisation de la procedure 'REECHANTILLONNAGE_SANS_REECHANTILLONNAGE(...)'. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Int,XminA)); DEFV(Argument,DEFV(Int,XmaxA)); DEFV(Argument,DEFV(Int,YminA)); DEFV(Argument,DEFV(Int,YmaxA)); /* Dimensions de l'image Argument. Ces definitions ne sont faites que pour permettre */ /* l'utilisation de la procedure 'REECHANTILLONNAGE_SANS_REECHANTILLONNAGE(...)'. */ DEFV(Argument,DEFV(Int,methode)); /* Methode de redimensionnement demandee (mais inutilisee...). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ PRINT_ATTENTION("le redimensionnement des images n'est pas disponible, un simple 'move' est fait"); iMOVE(imageR,imageA); /* Renvoi du Resultat (voir les commentaires relatifs a la procedure */ /* 'iMOVE(...)' dans 'v $xiii/di_image$DEF' remplacant 'Imove(..)' ici le 20021003123449). */ RETI(imageR); Eblock EFonctionP BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFredimensionnement(imageR,XminR,XmaxR,YminR,YmaxR,imageA,XminA,XmaxA,YminA,YmaxA,methode)))) DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] non reechantillonnee. */ DEFV(Argument,DEFV(Int,XminR)); DEFV(Argument,DEFV(Int,XmaxR)); DEFV(Argument,DEFV(Int,YminR)); DEFV(Argument,DEFV(Int,YmaxR)); /* Dimensions de l'image Resultat. Ces definitions ne sont faites que pour permettre */ /* l'utilisation de la procedure 'REECHANTILLONNAGE_SANS_REECHANTILLONNAGE(...)'. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Int,XminA)); DEFV(Argument,DEFV(Int,XmaxA)); DEFV(Argument,DEFV(Int,YminA)); DEFV(Argument,DEFV(Int,YmaxA)); /* Dimensions de l'image Argument. Ces definitions ne sont faites que pour permettre */ /* l'utilisation de la procedure 'REECHANTILLONNAGE_SANS_REECHANTILLONNAGE(...)'. */ DEFV(Argument,DEFV(Int,methode)); /* Methode de redimensionnement demandee. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ PRINT_ATTENTION("le redimensionnement des images n'est pas disponible, un simple 'move' est fait"); CALS(IFmove(imageR,imageA)); RETIF(imageR); Eblock EFonctionF BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFdeformation(imageR,XminR,XmaxR,YminR,YmaxR,imageA,XminA,XmaxA,YminA,YmaxA,methode,tX,tY)))) DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] non reechantillonnee. */ DEFV(Argument,DEFV(Int,XminR)); DEFV(Argument,DEFV(Int,XmaxR)); DEFV(Argument,DEFV(Int,YminR)); DEFV(Argument,DEFV(Int,YmaxR)); /* Dimensions de l'image Resultat (mais inutilisees...). */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Int,XminA)); DEFV(Argument,DEFV(Int,XmaxA)); DEFV(Argument,DEFV(Int,YminA)); DEFV(Argument,DEFV(Int,YmaxA)); /* Dimensions de l'image Argument (mais inutilisees...). */ DEFV(Argument,DEFV(Int,methode)); /* Methode de redimensionnement demandee. */ DEFV(Argument,DEFV(imageF,tX)); DEFV(Argument,DEFV(imageF,tY)); /* Definition de la deformation {tX,tY}. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ PRINT_ATTENTION("la deformation des images n'est pas disponible, un simple 'move' est fait"); CALS(IFmove(imageR,imageA)); RETIF(imageR); Eblock EFonctionF #Aif (dfd(GESTION_DU_FORMAT_DES_IMAGES_VERSION_01)) /* Common,DEFV(Fonction,) */ #Eif (dfd(GESTION_DU_FORMAT_DES_IMAGES_VERSION_01)) /* Common,DEFV(Fonction,) */ #if ((dfd(GESTION_DU_FORMAT_DES_IMAGES_VERSION_02)) || (dfd(GESTION_DU_FORMAT_DES_IMAGES_VERSION_03))) /* Common,DEFV(Fonction,) */ # ifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_01 /* Common,DEFV(Fonction,) : avec 'VERSION_01'. */ # Aifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_01 /* Common,DEFV(Fonction,) : avec 'VERSION_01'. */ # Eifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_01 /* Common,DEFV(Fonction,) : avec 'VERSION_01'. */ # ifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_02 /* Common,DEFV(Fonction,) : avec 'VERSION_02'. */ DEFV(Common,DEFV(Logical,ZINT(Iredimensionnement_____periodiser_X,FAUX))); DEFV(Common,DEFV(Logical,ZINT(Iredimensionnement_____periodiser_Y,FAUX))); /* Options par defaut de periodisation des axes. */ DEFV(Common,DEFV(Logical,ZINT(Iredimensionnement_____symetriser_X,FAUX))); DEFV(Common,DEFV(Logical,ZINT(Iredimensionnement_____symetriser_Y,FAUX))); /* Options par defaut de symetrisation des axes (introduites le 20050721103950). */ DEFV(Common,DEFV(Logical,ZINT(Iredimensionnement_____prolonger_X,FAUX))); DEFV(Common,DEFV(Logical,ZINT(Iredimensionnement_____prolonger_Y,FAUX))); /* Options par defaut de prolongement des axes. */ # define NIVEAU_HORS_IMAGE_DANS_Iredimensionnement \ NIVEAU_HORS_ECRAN DEFV(Common,DEFV(genere_p,ZINT(Iredimensionnement_____niveau_hors_image,NIVEAU_HORS_IMAGE_DANS_Iredimensionnement))); /* Options par defaut du niveau "hors-image". On notera que cette valeur par defaut est */ /* choisie de facon a assurer la compatibilite avec 'load_point_valide(...)'... */ DEFV(Common,DEFV(Logical,ZINT(IFdeformation_____les_coordonnees_X_sont_denormalisees,VRAI))); DEFV(Common,DEFV(Logical,ZINT(IFdeformation_____les_coordonnees_Y_sont_denormalisees,VRAI))); /* Introduits le 20060601093407 pour plus de souplesse d'utilisation, tout en assurant */ /* evidemment la compatibilite anterieure... */ /* */ /* ATTENTION : avant le 20061017140630 les deux indicateurs precedents avaient pour nom : */ /* */ /* les_coordonnees_X_sont_denormalisees_dans_IFredimensionnement */ /* les_coordonnees_Y_sont_denormalisees_dans_IFredimensionnement */ /* */ /* pour une raison mysterieuse car en fait ils servent uniquement dans 'IFdeformation(...)' */ /* et pas dans 'IFredimensionnement(...)'. Cette anomalie doit venir d'un "cut and paste" */ /* d'un indicateur relatif a 'IFredimensionnement(...)'... */ DEFV(Common,DEFV(Logical,ZINT(IFredimensionnement__IFdeformation_____periodiser_X,FAUX))); DEFV(Common,DEFV(Logical,ZINT(IFredimensionnement__IFdeformation_____periodiser_Y,FAUX))); /* Options par defaut de periodisation des axes. */ DEFV(Common,DEFV(Logical,ZINT(IFredimensionnement__IFdeformation_____symetriser_X,FAUX))); DEFV(Common,DEFV(Logical,ZINT(IFredimensionnement__IFdeformation_____symetriser_Y,FAUX))); /* Options par defaut de symetrisation des axes (introduites le 20050721103950). */ DEFV(Common,DEFV(Logical,ZINT(IFredimensionnement__IFdeformation_____prolonger_X,FAUX))); DEFV(Common,DEFV(Logical,ZINT(IFredimensionnement__IFdeformation_____prolonger_Y,FAUX))); /* Options par defaut de prolongement des axes. */ # define NIVEAU_HORS_IMAGE_DANS_IFredimensionnement_ET_DANS_IFdeformation \ FLOT(NIVEAU_HORS_IMAGE_DANS_Iredimensionnement) DEFV(Common,DEFV(genere_Float,ZINT(IFredimensionnement__IFdeformation_____niveau_hors_image ,NIVEAU_HORS_IMAGE_DANS_IFredimensionnement_ET_DANS_IFdeformation ) ) ); /* Options par defaut du niveau "hors-image". On notera que cette valeur par defaut est */ /* choisie de facon a assurer la compatibilite avec 'loadF_point_valide(...)'... */ # Aifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_02 /* Common,DEFV(Fonction,) : avec 'VERSION_02'. */ # Eifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_02 /* Common,DEFV(Fonction,) : avec 'VERSION_02'. */ DEFV(Common,DEFV(Logical,ZINT(REECHANTILLONNAGE_GENERAL_____marquer_les_niveaux_manquants,VRAI))); /* Indique si les niveaux 'REECHANTILLONNAGE_GENERAL_____niveau_manquant' doivent etre */ /* marques dans 'imageR' ('VRAI') ou bien les laisser intacts ('FAUX') tels qu'ils etaient */ /* avant... */ DEFV(Common,DEFV(genere_p,ZINT(REECHANTILLONNAGE_GENERAL_____niveau_manquant,NIVEAU_MANQUANT_POUR_LE_REECHANTILLONNAGE))); /* Niveau utilise par 'REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_MISE_DANS_LE_COIN_...' */ /* et par 'REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_MISE_AU_CENTRE' lorsqu'il n'y a pas */ /* assez de point dans l'image Argument pour generer l'image Resultat. */ DEFV(Common,DEFV(Int,ZINT(Idistorsion_par_un_champ_____Atranslation_OX,ZERO))); DEFV(Common,DEFV(Int,ZINT(Idistorsion_par_un_champ_____Atranslation_OY,ZERO))); /* Translations horizontale et verticale pour l'imageA exprimees en nombre de points pour */ /* la fonction 'REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_POSITIONNEMENT_QUELCONQUE'. */ DEFV(Common,DEFV(Float,ZINT(Idistorsion_par_un_champ_____Rtranslation_OX,FZERO))); DEFV(Common,DEFV(Float,ZINT(Idistorsion_par_un_champ_____Rtranslation_OY,FZERO))); /* Translations horizontale et verticale pour l'imageR exprimees en unite [0,1] pour la */ /* la fonction 'REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_POSITIONNEMENT_QUELCONQUE'. */ DEFV(Common,DEFV(Int,ZINT(IFdistorsion_par_un_champ_____Atranslation_OX,ZERO))); DEFV(Common,DEFV(Int,ZINT(IFdistorsion_par_un_champ_____Atranslation_OY,ZERO))); /* Translations horizontale et verticale pour l'imageA exprimees en nombre de points pour */ /* la fonction 'REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_POSITIONNEMENT_QUELCONQUE'. */ DEFV(Common,DEFV(Float,ZINT(IFdistorsion_par_un_champ_____Rtranslation_OX,FZERO))); DEFV(Common,DEFV(Float,ZINT(IFdistorsion_par_un_champ_____Rtranslation_OY,FZERO))); /* Translations horizontale et verticale pour l'imageR exprimees en unite [0,1] pour la */ /* la fonction 'REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_POSITIONNEMENT_QUELCONQUE'. */ DEFV(Common,DEFV(Int,ZINT(Iredimensionnement_____Atranslation_OX,ZERO))); DEFV(Common,DEFV(Int,ZINT(Iredimensionnement_____Atranslation_OY,ZERO))); /* Translations horizontale et verticale pour l'imageA exprimees en nombre de points pour */ /* la fonction 'REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_POSITIONNEMENT_QUELCONQUE'. */ DEFV(Common,DEFV(Float,ZINT(Iredimensionnement_____Rtranslation_OX,FZERO))); DEFV(Common,DEFV(Float,ZINT(Iredimensionnement_____Rtranslation_OY,FZERO))); /* Translations horizontale et verticale pour l'imageR exprimees en unite [0,1] pour la */ /* la fonction 'REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_POSITIONNEMENT_QUELCONQUE'. */ DEFV(Common,DEFV(Logical,ZINT(Iredimensionnement_____utiliser_pasX_et_pasY,VRAI))); /* Indique l'on doit utiliser {pasX,pasY} pour l'interpolation ('VRAI') ou bien le couple */ /* de valeurs definies ci-apres ('FAUX'). ATTENTION, ce dispositif ne presente en realite */ /* que peu d'interet car, en effet : */ /* */ /* 1-si '__VERSION__INDEXATION_SIMPLIFIEE_A_PRIORI' n'est pas definie, lors des acces a */ /* l'image a reechantillonner via 'ECHANTILLONNAGE_NORMALISE_DE_L_IMAGE(...)' on utilise les */ /* coordonnees {x,y} modulo {pasX,pasY} ; on n'atteint donc pas cette image "en continu"... */ /* */ /* 2-des que les pas ne sont plus egaux a 1, il y a des phenomenes de rebond dans les zones */ /* de forts gradients (sur les contours par exemple), car, en effet, les segments de */ /* coordonnees dans lesquels on interpole les niveaux, au lieu d'etre disjoints, sont en */ /* recouvrement les uns des autres, ce qui provoque en quelque sorte des "echos" des bords, */ /* puisque l'on va reutiliser plusieurs fois (un nombre de fois egal au pas...) les memes */ /* niveaux au lieu de ne les utiliser qu'une seule fois... */ /* */ /* Je conserve ce dispositif malgre tout car il peut donner des effets artistiques... */ DEFV(Common,DEFV(Int,ZINT(Iredimensionnement_____pasX,PasX))); DEFV(Common,DEFV(Int,ZINT(Iredimensionnement_____pasY,PasY))); DEFV(Common,DEFV(Int,ZINT(IFredimensionnement_____Atranslation_OX,ZERO))); DEFV(Common,DEFV(Int,ZINT(IFredimensionnement_____Atranslation_OY,ZERO))); /* Translations horizontale et verticale pour l'imageA exprimees en nombre de points pour */ /* la fonction 'REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_POSITIONNEMENT_QUELCONQUE'. */ DEFV(Common,DEFV(Float,ZINT(IFredimensionnement_____Rtranslation_OX,FZERO))); DEFV(Common,DEFV(Float,ZINT(IFredimensionnement_____Rtranslation_OY,FZERO))); /* Translations horizontale et verticale pour l'imageR exprimees en unite [0,1] pour la */ /* la fonction 'REECHANTILLONNAGE_SANS_REECHANTILLONNAGE_AVEC_POSITIONNEMENT_QUELCONQUE'. */ DEFV(Common,DEFV(Logical,ZINT(IFredimensionnement__IFdeformation_____utiliser_pasX_et_pasY,VRAI))); /* Meme commentaire que 'Iredimensionnement_____utiliser_pasX_et_pasY' (introduit le */ /* 20041107175457 car manquait...). */ DEFV(Common,DEFV(Int,ZINT(IFredimensionnement__IFdeformation_____pasX,PasX))); DEFV(Common,DEFV(Int,ZINT(IFredimensionnement__IFdeformation_____pasY,PasY))); /* {pasX,pasY} a utiliser si 'IL_NE_FAUT_PAS(Iredimensionnement_____utiliser_pasX_et_pasY)'. */ DEFV(Common,DEFV(Float,ZINT(VOISINAGE_POINT_BICUBIQUE_____facteur_des_derivees_numeriques,FU))); /* En diminuant ce facteur ou adoucit les transitions d'une maille a l'autre, alors qu'en */ /* l'augmentant, on les rend plus "cassantes"... */ /* */ /* Le nom 'facteur_des_derivees_numeriques' a ete "enrichi" le 20050411102453 car, en */ /* effet, il entrait en collision avec un autre 'Common' de meme nom qui etait defini */ /* dans 'v $xiii/aleat.2$vv$FON 20050411102008'... */ /* ATTENTION, il serait certainement plus logique de placer 'Idistorsion_par_un_champ(...)' */ /* dans '$xiii/quad_image$FON' puisqu'elle possede quatre arguments de type 'image'. Malgre */ /* cela, elle est placee dans '$xiii/di_image$FON' car elle utilise la procedure generale */ /* 'REECHANTILLONNAGE_GENERAL(...)' qui est definie localement dans '$xiii/di_image$FON'... */ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Idistorsion_par_un_champ(imageR ,imageA ,facteur_multiplicatif_X,imageX,anti_translation_des_niveaux_de_imageX ,facteur_multiplicatif_Y,imageY,anti_translation_des_niveaux_de_imageY ,methode ) ) ) ) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] "deformee" via ses coordonnees... */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Float,facteur_multiplicatif_X)); DEFV(Argument,DEFV(image,imageX)); DEFV(Argument,DEFV(genere_p,anti_translation_des_niveaux_de_imageX)); /* Image donnant apres "anti-translation", puis denormalisation et enfin multiplication */ /* par un facteur la translation des coordonnees 'X' de l'image Argument. */ DEFV(Argument,DEFV(Float,facteur_multiplicatif_Y)); DEFV(Argument,DEFV(image,imageY)); DEFV(Argument,DEFV(genere_p,anti_translation_des_niveaux_de_imageY)); /* Image donnant apres "anti-translation", puis denormalisation et enfin multiplication */ /* par un facteur la translation des coordonnees 'Y' de l'image Argument. */ DEFV(Argument,DEFV(Int,methode)); /* Methode de distorsion demandee. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Int,INIT(methode_de_reechantillonnage_utilisee,methode)); /* Methode de distorsion reellement utilisee (a priori, on prend la methode qui a */ /* ete demandee...). */ DEFV(Int,INIT(XminR,Xmin)); DEFV(Int,INIT(XmaxR,Xmax)); DEFV(Int,INIT(YminR,Ymin)); DEFV(Int,INIT(YmaxR,Ymax)); /* Dimensions de l'image Resultat. Ces definitions ne sont faites que pour permettre */ /* l'utilisation de la procedure 'REECHANTILLONNAGE_SANS_REECHANTILLONNAGE(...)'. */ DEFV(Int,INIT(XminA,Xmin)); DEFV(Int,INIT(XmaxA,Xmax)); DEFV(Int,INIT(YminA,Ymin)); DEFV(Int,INIT(YmaxA,Ymax)); /* Dimensions de l'image Argument. Ces definitions ne sont faites que pour permettre */ /* l'utilisation de la procedure 'REECHANTILLONNAGE_SANS_REECHANTILLONNAGE(...)'. */ /*..............................................................................................................................*/ REECHANTILLONNAGE_GENERAL(SOUS(Xf_apres_reechantillonnage ,MUL2(facteur_multiplicatif_X ,______NORMALISE_NIVEAU(NIVA(SOUS(load_point(imageX ,X_apres_reechantillonnage ,Y_apres_reechantillonnage ) ,anti_translation_des_niveaux_de_imageX ) ) ) ) ) /* On notera la presence de : */ /* */ /* SOUS(Xf_apres_reechantillonnage,...) */ /* */ /* et non pas de : */ /* */ /* ADD2(Xf_apres_reechantillonnage,...) */ /* */ /* afin que les valeurs de 'imageX' superieures a 'anti_translation_des_niveaux_de_imageX' */ /* donnent un decalage "positif" (c'est-a-dire a droite)... */ ,SOUS(Yf_apres_reechantillonnage ,MUL2(facteur_multiplicatif_Y ,______NORMALISE_NIVEAU(NIVA(SOUS(load_point(imageY ,X_apres_reechantillonnage ,Y_apres_reechantillonnage ) ,anti_translation_des_niveaux_de_imageY ) ) ) ) ) /* On notera la presence de : */ /* */ /* SOUS(Yf_apres_reechantillonnage,...) */ /* */ /* et non pas de : */ /* */ /* ADD2(Yf_apres_reechantillonnage,...) */ /* */ /* afin que les valeurs de 'imageY' superieures a 'anti_translation_des_niveaux_de_imageY' */ /* donnent un decalage "positif" (c'est-a-dire ver le haut)... */ ,BLOC(VIDE;) ,BLOC(VIDE;) ,genere_p ,NIVEAU_UNDEF ,Idistorsion_par_un_champ_____Rtranslation_OX ,Idistorsion_par_un_champ_____Rtranslation_OY ,Idistorsion_par_un_champ_____Atranslation_OX ,Idistorsion_par_un_champ_____Atranslation_OY ,gGENP ); RETI(imageR); Eblock EFonctionP /* On notera le 20210603113333 que 'IFdistorsion_par_un_champ(...)' n'est pas definie */ /* ici mais plus loin (avant 'IFredimensionnement(...)') afin de pouvoir utiliser les */ /* redefinitions de : */ /* */ /* ECHANTILLONNAGE_DENORMALISE_DE_L_IMAGE(...) */ /* ECHANTILLONNAGE_NORMALISE_DE_L_IMAGE(...) */ /* INITIALISATION_DES_INTERPOLATIONS_BILINEAIRE_ET_BICUBIQUE(...) */ /* __DENORMALISE_DU_NIVEAU_INTERPOLE(...) */ /* RANGEMENT_DU_NIVEAU_INTERPOLE(...) */ /* */ /* qui lui sont necessaires... */ BFonctionP DEFV(Common,DEFV(Logical,SINT(Iredimensionnement_____messages_MdefRedim,VRAI))); /* Indique si les message 'PRINT_ATTENTION(...)' relatifs a 'MdefRedim' sont a editer */ /* ('VRAI') ou pas ('FAUX'). */ DEFV(Common,DEFV(FonctionP,POINTERp(Iredimensionnement(imageR,XminR,XmaxR,YminR,YmaxR,imageA,XminA,XmaxA,YminA,YmaxA,methode)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] reechantillonnee. */ DEFV(Argument,DEFV(Int,XminR)); DEFV(Argument,DEFV(Int,XmaxR)); DEFV(Argument,DEFV(Int,YminR)); DEFV(Argument,DEFV(Int,YmaxR)); /* Dimensions de l'image Resultat. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Int,XminA)); DEFV(Argument,DEFV(Int,XmaxA)); DEFV(Argument,DEFV(Int,YminA)); DEFV(Argument,DEFV(Int,YmaxA)); /* Dimensions de l'image Argument. */ DEFV(Argument,DEFV(Int,methode)); /* Methode de redimensionnement demandee. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Int,INIT(methode_de_reechantillonnage_utilisee,methode)); /* Methode de reechantillonnage reellement utilisee (a priori, on prend la methode qui a */ /* ete demandee...). */ /*..............................................................................................................................*/ Test(IFNE(GvalDefaut("MdefRedim",REECHANTILLONNAGE_PAR_INTERPOLATION_BICUBIQUE),REECHANTILLONNAGE_PAR_INTERPOLATION_BICUBIQUE)) /* Le 20041117132910, la procedure 'Gval(...)' a ete remplacee par 'GvalDefaut(...)' au */ /* cas ou '$MdefRedim' ne serait pas definie ('v $Fdivers MdefRedim'). */ Bblock Test(IL_FAUT(Iredimensionnement_____messages_MdefRedim)) Bblock PRINT_ATTENTION("la valeur de la variable d'environnement 'MdefRedim' ne correspond pas a la meilleure methode"); PRINT_ATTENTION("ou la variable d'environnement 'MdefRedim' n'est pas definie (voir 'v $Fdivers' et l'alias 'S')"); Eblock ATes Bblock Eblock ETes Eblock ATes Bblock Eblock ETes PUSH_DIMENSIONS_2D; /* Sauvegarde du dimensionnement initial... */ SET_DIMENSIONS_2D_SANS_VALIDATION(XminR,XmaxR,YminR,YmaxR); /* Mise en place du dimensionnement de l'image Resultat afin que la boucle de parcours */ /* des images soit conditionnees par cette derniere... */ REECHANTILLONNAGE_GENERAL(Xf_apres_reechantillonnage ,Yf_apres_reechantillonnage ,BLOC(SET_DIMENSIONS_2D_SANS_VALIDATION(XminA,XmaxA,YminA,YmaxA); /* Mise en place du dimensionnement de l'image Argument, */ ) ,BLOC(SET_DIMENSIONS_2D_SANS_VALIDATION(XminR,XmaxR,YminR,YmaxR); /* Remise en place du dimensionnement de l'image Resultat. */ ) ,genere_p ,NIVEAU_UNDEF ,Iredimensionnement_____Rtranslation_OX ,Iredimensionnement_____Rtranslation_OY ,Iredimensionnement_____Atranslation_OX ,Iredimensionnement_____Atranslation_OY ,gGENP ); PULL_DIMENSIONS_2D; /* Restauration du dimensionnement initial... */ RETI(imageR); Eblock EFonctionP # ifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_01 # undef ECHANTILLONNAGE_DENORMALISE_DE_L_IMAGE # define ECHANTILLONNAGE_DENORMALISE_DE_L_IMAGE(x,y) \ loadF_point_valide(imageA,x,y) \ /* Fonction d'echantillonage "entier" de l'image dans [0,1] (introduit le 20090510232929). */ # undef ECHANTILLONNAGE_NORMALISE_DE_L_IMAGE # define ECHANTILLONNAGE_NORMALISE_DE_L_IMAGE(x,y) \ loadF_point_valide(imageA,x,y) \ /* Fonction d'echantillonage "entier" de l'image dans [0,1]. */ # Aifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_01 # Eifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_01 # ifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_02 # undef ECHANTILLONNAGE_DENORMALISE_DE_L_IMAGE # define ECHANTILLONNAGE_DENORMALISE_DE_L_IMAGE(x,y) \ FFload_point(imageA \ ,x,y \ ,IFredimensionnement__IFdeformation_____periodiser_X \ ,IFredimensionnement__IFdeformation_____periodiser_Y \ ,IFredimensionnement__IFdeformation_____symetriser_X \ ,IFredimensionnement__IFdeformation_____symetriser_Y \ ,IFredimensionnement__IFdeformation_____prolonger_X \ ,IFredimensionnement__IFdeformation_____prolonger_Y \ ,IFredimensionnement__IFdeformation_____niveau_hors_image \ ) \ /* Fonction d'echantillonage "entier" de l'image dans [0,1] (introduit le 20090510232929). */ # undef ECHANTILLONNAGE_NORMALISE_DE_L_IMAGE # define ECHANTILLONNAGE_NORMALISE_DE_L_IMAGE(x,y) \ FFload_point(imageA \ ,x,y \ ,IFredimensionnement__IFdeformation_____periodiser_X \ ,IFredimensionnement__IFdeformation_____periodiser_Y \ ,IFredimensionnement__IFdeformation_____symetriser_X \ ,IFredimensionnement__IFdeformation_____symetriser_Y \ ,IFredimensionnement__IFdeformation_____prolonger_X \ ,IFredimensionnement__IFdeformation_____prolonger_Y \ ,IFredimensionnement__IFdeformation_____niveau_hors_image \ ) \ /* Fonction d'echantillonage "entier" de l'image dans [0,1]. */ \ /* */ \ /* Le 20030826112722, j'ai observee une petite anomalie inexplicable. Soit 'IMAGE.1' */ \ /* une image 'imageF' reechantillonnee de 'Std' en 'Pal' en 'VERSION_01' ; et soit */ \ /* 'IMAGE.2' obtenue de meme en 'VERSION_02'. Les deux images sont legerement differentes */ \ /* et si l'on calcule leur difference par '$xci/soustraction$K', puis les extrema de cette */ \ /* difference, on trouve alors {-2.842170943040401e-14,+2.842170943040401e-14}, sachant */ \ /* que l'image "standard=VRAI" de base etait 'v $xiio/FRAC2.090$N'. Peut-etre s'agit-il */ \ /* d'un probleme du au fait que l'addition et la multiplication flottante ne sont pas */ \ /* associatives ; les codes 'VERSION_01' et 'VERSION_02' sont donc certainement differents. */ # Aifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_02 # Eifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_02 # undef INITIALISATION_DES_INTERPOLATIONS_BILINEAIRE_ET_BICUBIQUE # define INITIALISATION_DES_INTERPOLATIONS_BILINEAIRE_ET_BICUBIQUE(Xf_apres_reechantillonnage,Yf_apres_reechantillonnage,tX,tY) \ /* ATTENTION, l'absence de 'Bblock' et de 'Eblock' est due au 'PUSH_ECHANTILLONNAGE' qui */ \ /* suit... */ \ \ gINITIALISATION_DES_INTERPOLATIONS_BILINEAIRE_ET_BICUBIQUE \ (Xf_apres_reechantillonnage \ ,Yf_apres_reechantillonnage \ ,tX \ ,tY \ ,IFredimensionnement__IFdeformation_____utiliser_pasX_et_pasY \ ,IFredimensionnement__IFdeformation_____pasX \ ,IFredimensionnement__IFdeformation_____pasY \ ); \ \ /* ATTENTION, l'absence de 'Bblock' et de 'Eblock' est due au 'PUSH_ECHANTILLONNAGE' qui */ \ /* suit... */ \ \ /* Initialisation des operations et definition des donnees utiles... */ # undef __DENORMALISE_DU_NIVEAU_INTERPOLE # define __DENORMALISE_DU_NIVEAU_INTERPOLE(niveau_interpole) \ NEUT(niveau_interpole) \ /* Denormalisation du niveau interpole. */ # undef RANGEMENT_DU_NIVEAU_INTERPOLE # define RANGEMENT_DU_NIVEAU_INTERPOLE(niveau_interpole,imageR,X_apres_reechantillonnage,Y_apres_reechantillonnage) \ Bblock \ storeF_point(niveau_interpole \ ,imageR \ ,X_apres_reechantillonnage,Y_apres_reechantillonnage \ ); \ Eblock \ /* Renvoi du niveau interpole... */ BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFdistorsion_par_un_champ(imageR ,imageA ,facteur_multiplicatif_X,imageX,anti_translation_des_niveaux_de_imageX ,facteur_multiplicatif_Y,imageY,anti_translation_des_niveaux_de_imageY ,methode ) ) ) ) /* Fonction introduite le 20210603101332... */ DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] "deformee" via ses coordonnees... */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Float,facteur_multiplicatif_X)); DEFV(Argument,DEFV(imageF,imageX)); DEFV(Argument,DEFV(genere_Float,anti_translation_des_niveaux_de_imageX)); /* Image donnant apres "anti-translation" puis multiplication par un facteur la translation */ /* des coordonnees 'X' de l'image Argument. */ DEFV(Argument,DEFV(Float,facteur_multiplicatif_Y)); DEFV(Argument,DEFV(imageF,imageY)); DEFV(Argument,DEFV(genere_Float,anti_translation_des_niveaux_de_imageY)); /* Image donnant apres "anti-translation" puis multiplication par un facteur la translation */ /* des coordonnees 'Y' de l'image Argument. */ DEFV(Argument,DEFV(Int,methode)); /* Methode de distorsion demandee. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Int,INIT(methode_de_reechantillonnage_utilisee,methode)); /* Methode de distorsion reellement utilisee (a priori, on prend la methode qui a */ /* ete demandee...). */ DEFV(Int,INIT(XminR,Xmin)); DEFV(Int,INIT(XmaxR,Xmax)); DEFV(Int,INIT(YminR,Ymin)); DEFV(Int,INIT(YmaxR,Ymax)); /* Dimensions de l'image Resultat. Ces definitions ne sont faites que pour permettre */ /* l'utilisation de la procedure 'REECHANTILLONNAGE_SANS_REECHANTILLONNAGE(...)'. */ /* */ /* Mais ATTENTION, voir 'v $xiii/di_image$FON compatibilite_20170316', option qui doit */ /* etre positionnee afin que le mode 'REECHANTILLONNAGE_PAR_REPLICATION_ET_DESTRUCTION' */ /* ne soit pas force dans 'REECHANTILLONNAGE_GENERAL(...)' dans le cas ou les formats */ /* {XminR,XmaxR,YminR,YmaxR} et {XminA,XmaxA,YminA,YmaxA} sont identiques... */ DEFV(Int,INIT(XminA,Xmin)); DEFV(Int,INIT(XmaxA,Xmax)); DEFV(Int,INIT(YminA,Ymin)); DEFV(Int,INIT(YmaxA,Ymax)); /* Dimensions de l'image Argument. Ces definitions ne sont faites que pour permettre */ /* l'utilisation de la procedure 'REECHANTILLONNAGE_SANS_REECHANTILLONNAGE(...)'. */ /* */ /* Mais ATTENTION, voir 'v $xiii/di_image$FON compatibilite_20170316', option qui doit */ /* etre positionnee afin que le mode 'REECHANTILLONNAGE_PAR_REPLICATION_ET_DESTRUCTION' */ /* ne soit pas force dans 'REECHANTILLONNAGE_GENERAL(...)' dans le cas ou les formats */ /* {XminR,XmaxR,YminR,YmaxR} et {XminA,XmaxA,YminA,YmaxA} sont identiques... */ /*..............................................................................................................................*/ BSaveModifyVariable(Logical,REECHANTILLONNAGE_GENERAL_____compatibilite_20170316,VRAI); /* Introduit le 20210603142802 afin que 'REECHANTILLONNAGE_PAR_REPLICATION_ET_DESTRUCTION' */ /* ne soit pas force dans 'v $xiii/di_image$FON compatibilite_20170316'... */ REECHANTILLONNAGE_GENERAL(SOUS(Xf_apres_reechantillonnage ,MUL2(facteur_multiplicatif_X ,SOUS(loadF_point(imageX ,X_apres_reechantillonnage ,Y_apres_reechantillonnage ) ,anti_translation_des_niveaux_de_imageX ) ) ) ,SOUS(Yf_apres_reechantillonnage ,MUL2(facteur_multiplicatif_Y ,SOUS(loadF_point(imageY ,X_apres_reechantillonnage ,Y_apres_reechantillonnage ) ,anti_translation_des_niveaux_de_imageY ) ) ) ,BLOC(VIDE;) ,BLOC(VIDE;) ,genere_Float ,FLOT__NIVEAU_UNDEF ,IFdistorsion_par_un_champ_____Rtranslation_OX ,IFdistorsion_par_un_champ_____Rtranslation_OY ,IFdistorsion_par_un_champ_____Atranslation_OX ,IFdistorsion_par_un_champ_____Atranslation_OY ,NEUT ); ESaveModifyVariable(Logical,REECHANTILLONNAGE_GENERAL_____compatibilite_20170316); RETIF(imageR); Eblock EFonctionF BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFredimensionnement(imageR,XminR,XmaxR,YminR,YmaxR,imageA,XminA,XmaxA,YminA,YmaxA,methode)))) DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] reechantillonnee. */ DEFV(Argument,DEFV(Int,XminR)); DEFV(Argument,DEFV(Int,XmaxR)); DEFV(Argument,DEFV(Int,YminR)); DEFV(Argument,DEFV(Int,YmaxR)); /* Dimensions de l'image Resultat. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Int,XminA)); DEFV(Argument,DEFV(Int,XmaxA)); DEFV(Argument,DEFV(Int,YminA)); DEFV(Argument,DEFV(Int,YmaxA)); /* Dimensions de l'image Argument. */ DEFV(Argument,DEFV(Int,methode)); /* Methode de redimensionnement demandee (mais inutilisee et introduite le 20030824111639 */ /* par symetrie avec 'Iredimensionnement(...)'). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Int,INIT(methode_de_reechantillonnage_utilisee,methode)); /* Methode de reechantillonnage reellement utilisee (a priori, on prend la methode qui a */ /* ete demandee...). */ /*..............................................................................................................................*/ PUSH_DIMENSIONS_2D; /* Sauvegarde du dimensionnement initial... */ SET_DIMENSIONS_2D_SANS_VALIDATION(XminR,XmaxR,YminR,YmaxR); /* Mise en place du dimensionnement de l'image Resultat afin que la boucle de parcours */ /* des images soit conditionnees par cette derniere... */ REECHANTILLONNAGE_GENERAL(Xf_apres_reechantillonnage ,Yf_apres_reechantillonnage ,BLOC(SET_DIMENSIONS_2D_SANS_VALIDATION(XminA,XmaxA,YminA,YmaxA); /* Mise en place du dimensionnement de l'image Argument, */ ) ,BLOC(SET_DIMENSIONS_2D_SANS_VALIDATION(XminR,XmaxR,YminR,YmaxR); /* Remise en place du dimensionnement de l'image Resultat. */ ) ,genere_Float ,FLOT__NIVEAU_UNDEF ,IFredimensionnement_____Rtranslation_OX ,IFredimensionnement_____Rtranslation_OY ,IFredimensionnement_____Atranslation_OX ,IFredimensionnement_____Atranslation_OY ,NEUT ); /* La procedure 'REECHANTILLONNAGE_GENERAL(...)' a ete introduite le 20090515091829. */ /* */ /* Rappelons qu'avant le 20090510232929 seule l'interpolation bicubique existait. Voici */ /* d'ailleurs l'historique des ameliorations : */ /* */ /* L'interpolation bilineaire a ete introduite le 20090510232929 (bien tardivement...). En */ /* effet, bien que moins "lisse" que l'interpolation bilineaire, elle presente par rapport */ /* a cette derniere le gros avantage de ne pas presenter de rebond. A titre d'exemple : */ /* */ /* Std */ /* $xci/lineaire$X A=1 B=1 C=0 \ */ /* standard=FAUX \ */ /* renormaliser=VRAI \ */ /* R=$xTG/MIRE \ */ /* $formatI */ /* */ /* Pal */ /* $xci/extrema$X A=$xTG/MIRE \ */ /* standard=FAUX \ */ /* redimensionnement_si_erreur_IloadF_image=VRAI \ */ /* mrseIlF=2 \ */ /* $formatI */ /* */ /* ("mrseIlF=2" : bicubique) donne les extrema [0,1.042671603630803] (soit [0,265] */ /* denormalise) et non pas [0,1] comme le donne "mrseIlF=1" (bilineaire)... */ /* */ /* Les interpolations sans reechantillonnage ont ete introduites le 20090514112746 (bien */ /* tardivement la-aussi...). */ PULL_DIMENSIONS_2D; /* Restauration du dimensionnement initial... */ RETIF(imageR); Eblock EFonctionF BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFdeformation(imageR,XminR,XmaxR,YminR,YmaxR,imageA,XminA,XmaxA,YminA,YmaxA,methode,tX,tY)))) /* Fonction introduite le 20030825112058. */ DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] non reechantillonnee. */ DEFV(Argument,DEFV(Int,XminR)); DEFV(Argument,DEFV(Int,XmaxR)); DEFV(Argument,DEFV(Int,YminR)); DEFV(Argument,DEFV(Int,YmaxR)); /* Dimensions de l'image Resultat (mais inutilisees...). */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Int,XminA)); DEFV(Argument,DEFV(Int,XmaxA)); DEFV(Argument,DEFV(Int,YminA)); DEFV(Argument,DEFV(Int,YmaxA)); /* Dimensions de l'image Argument (mais inutilisees...). */ DEFV(Argument,DEFV(Int,methode)); /* Methode de redimensionnement demandee (mais inutilisee et introduite le 20030824111639 */ /* par symetrie avec 'Iredimensionnement(...)'). */ DEFV(Argument,DEFV(imageF,tX)); DEFV(Argument,DEFV(imageF,tY)); /* Definition de la deformation {tX,tY} sous formes de deux matrices de translation. Ces */ /* translations sont denormalisees ; cela signifie donc qu'une translation egale a 1 */ /* provoque un deplacement d'un point... */ /* */ /* La possibilite de choix entre des translations denormalisees et normalisees a ete */ /* introduite le 20060601093407. Elles sont evidemment denormalisees par defaut afin */ /* d'assurer la compatibilite anterieure... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ Test(IFNE(methode,REECHANTILLONNAGE_PAR_INTERPOLATION_BICUBIQUE)) Bblock PRINT_ATTENTION("seule l'interpolation bicubique est disponible"); CAL1(Prer2("(l'interpolation bicubique est la methode '%d' alors que la methode '%d' etait demandee)\n" ,REECHANTILLONNAGE_PAR_INTERPOLATION_BICUBIQUE ,methode ) ); Eblock ATes Bblock Eblock ETes PUSH_DIMENSIONS_2D; /* Sauvegarde du dimensionnement initial... */ SET_DIMENSIONS_2D_SANS_VALIDATION(XminR,XmaxR,YminR,YmaxR); /* Mise en place du dimensionnement de l'image Resultat afin que la boucle de parcours */ /* des images soit conditionnees par cette derniere... */ REECHANTILLONNAGE_BICUBIQUE(Xf_apres_reechantillonnage ,Yf_apres_reechantillonnage ,BLOC(SET_DIMENSIONS_2D_SANS_VALIDATION(XminA,XmaxA,YminA,YmaxA); /* Mise en place du dimensionnement de l'image Argument, */ ) ,BLOC(SET_DIMENSIONS_2D_SANS_VALIDATION(XminR,XmaxR,YminR,YmaxR); /* Remise en place du dimensionnement de l'image Resultat. */ ) ,genere_Float ,FLOT__NIVEAU_UNDEF ,OPC1(EST_VRAI(IFdeformation_____les_coordonnees_X_sont_denormalisees) ,NEUT ,F__lDENORMALISE_OX ,loadF_point(tX,X,Y) ) ,OPC1(EST_VRAI(IFdeformation_____les_coordonnees_Y_sont_denormalisees) ,NEUT ,F__lDENORMALISE_OY ,loadF_point(tY,X,Y) ) /* La possibilite de choix entre des translations denormalisees et normalisees a ete */ /* introduit le 20060601093407 et les 'OPC1(...)' furent introduits le 20080527090556... */ ); PULL_DIMENSIONS_2D; /* Restauration du dimensionnement initial... */ RETIF(imageR); Eblock EFonctionF # undef RANGEMENT_DU_NIVEAU_INTERPOLE # undef __DENORMALISE_DU_NIVEAU_INTERPOLE # ifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_01 # undef ECHANTILLONNAGE_NORMALISE_DE_L_IMAGE # Aifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_01 # Eifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_01 # ifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_02 # undef ECHANTILLONNAGE_NORMALISE_DE_L_IMAGE # Aifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_02 # Eifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_02 # ifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_01 # Aifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_01 # Eifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_01 # ifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_02 # undef NIVEAU_HORS_IMAGE_DANS_IFredimensionnement_ET_DANS_IFdeformation # undef NIVEAU_HORS_IMAGE_DANS_Iredimensionnement # Aifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_02 # Eifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_02 #Aif ((dfd(GESTION_DU_FORMAT_DES_IMAGES_VERSION_02)) || (dfd(GESTION_DU_FORMAT_DES_IMAGES_VERSION_03))) /* Common,DEFV(Fonction,) */ #Eif ((dfd(GESTION_DU_FORMAT_DES_IMAGES_VERSION_02)) || (dfd(GESTION_DU_FORMAT_DES_IMAGES_VERSION_03))) /* Common,DEFV(Fonction,) */ #if (dfd(GESTION_DU_FORMAT_DES_IMAGES_VERSION_01)) /* Common,DEFV(Fonction,) */ #Aif (dfd(GESTION_DU_FORMAT_DES_IMAGES_VERSION_01)) /* Common,DEFV(Fonction,) */ #Eif (dfd(GESTION_DU_FORMAT_DES_IMAGES_VERSION_01)) /* Common,DEFV(Fonction,) */ #if ((dfd(GESTION_DU_FORMAT_DES_IMAGES_VERSION_02)) || (dfd(GESTION_DU_FORMAT_DES_IMAGES_VERSION_03))) /* Common,DEFV(Fonction,) */ # undef REECHANTILLONNAGE_SANS_REECHANTILLONNAGE # undef REECHANTILLONNAGE_GENERAL # undef REECHANTILLONNAGE_BICUBIQUE # undef REECHANTILLONNAGE_BILINEAIRE /* Les 'undef's relatifs au mode 'BILINEAIRE' ont ete introduits le 20090510232929 ; le */ /* premier manquait et le second correspondait a un nouveau 'define'... */ # undef REECHANTILLONNAGE_SIMPLISTE # undef INITIALISATION_DES_INTERPOLATIONS_BILINEAIRE_ET_BICUBIQUE # ifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_01 # undef ECHANTILLONNAGE_DENORMALISE_DE_L_IMAGE # Aifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_01 # Eifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_01 # ifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_02 # undef ECHANTILLONNAGE_DENORMALISE_DE_L_IMAGE # Aifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_02 # Eifdef ACCES_AUX_POINTS_LORS_D_UN_ECHANTILLONNAGE_DE_L_IMAGE_VERSION_02 #Aif ((dfd(GESTION_DU_FORMAT_DES_IMAGES_VERSION_02)) || (dfd(GESTION_DU_FORMAT_DES_IMAGES_VERSION_03))) /* Common,DEFV(Fonction,) */ #Eif ((dfd(GESTION_DU_FORMAT_DES_IMAGES_VERSION_02)) || (dfd(GESTION_DU_FORMAT_DES_IMAGES_VERSION_03))) /* Common,DEFV(Fonction,) */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* P A S S A G E A U N E D Y N A M I Q U E L O G A R I T H M I Q U E */ /* P O U R U N E I M A G E F L O T T A N T E S A N S T R A N S L A T I O N D Y N A M I Q U E : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Float,SINT(IFdynamique_logarithmique_sans_translation_dynamique_____moins_l_infini,F_MOINS_L_INFINI))); /* "Moins l'infini" utilise lors du calcul des logarithmes (introduit le 20020225155414). */ DEFV(Common,DEFV(FonctionF,POINTERF(IFdynamique_logarithmique_sans_translation_dynamique(imageR,imageA,anti_translation_des_valeurs)))) DEFV(Argument,DEFV(imageF,imageR)); /* Image flottante Resultat, telle que : imageR[X][Y]=Log(imageA[X][Y] - translation + 1). */ DEFV(Argument,DEFV(imageF,imageA)); /* Image flottante Argument. */ DEFV(Argument,DEFV(Float,anti_translation_des_valeurs)); /* Inverse (-) de la translation appliquee a toutes les valeurs de 'imageA'. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock DEFV(genere_Float,INIT(valeur_courante_translatee ,ADD2(SOUS(loadF_point(imageA,X,Y) ,anti_translation_des_valeurs ) ,POUR_OBTENIR_UN_LOGARITHME_POSITIF ) ) ); /* Valeur courante translatee dont on veut prendre le logarithme. On notera la relative */ /* complexite de l'ecriture, mais en fait, elle est traduit le fait que les fonctions */ /* 'LOGX(...)' et 'EXPX(...)' sont inverses l'une de l'autre. Ainsi, la translation de */ /* chaque valeur, lorsque l'on utilise '-min(imageA) + 1' garantit que le 'LOGX(...)' est */ /* positif. Je rappelle donc au passage que : */ /* */ /* Log(1) = 0 */ /* */ /* d'ou : */ /* */ /* 0 */ /* 1 = e */ /* */ /* CQFD... */ /* */ /* On notera que l'on utilise 'EXPB(...)' et non pas 'EXPX(...)' a cause du bug */ /* 'BUG_SYSTEME_SG_C_exp'... */ Test(IZGE(valeur_courante_translatee)) /* Le 20020223143049, je suis passe de 'IZGT'...)' a 'IZGE(...)' afin de permettre des */ /* valeurs nulles, et ce a cause de 'IFdimension_fractale_convolution(...)'. */ Bblock storeF_point(COND(IZGT(valeur_courante_translatee) ,TRON(LOGX(valeur_courante_translatee) ,IFdynamique_logarithmique_sans_translation_dynamique_____moins_l_infini ,F_INFINI ) ,IFdynamique_logarithmique_sans_translation_dynamique_____moins_l_infini ) ,imageR ,X,Y ); /* Application de la dynamique logarithmique a chaque point de l'image 'imageA'. Le cas */ /* particulier de 'log(0)' a ete introduit le 20020223143049, en meme temps que la */ /* modification du 'Test(...)' precedent... */ Eblock ATes Bblock PRINT_ERREUR("on cherche a prendre le logarithme d'une valeur negative"); Eblock ETes Eblock end_image RETIF(imageR); Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* P A S S A G E A U N E D Y N A M I Q U E L O G A R I T H M I Q U E */ /* P O U R U N E I M A G E F L O T T A N T E A V E C T R A N S L A T I O N D Y N A M I Q U E : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFdynamique_logarithmique_avec_translation_dynamique(imageR,imageA)))) DEFV(Argument,DEFV(imageF,imageR)); /* Image flottante Resultat, telle que : imageR[X][Y]=Log(imageA[X][Y] - min(imageA) + 1). */ DEFV(Argument,DEFV(imageF,imageA)); /* Image flottante Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ CALS(IFdynamique_logarithmique_sans_translation_dynamique(imageR,imageA,IFnivo_minimum(imageA))); /* Puis application de la dynamique logarithmique avec comme anti-translation des valeurs */ /* le minimum des valeurs de 'imageA'... */ RETIF(imageR); Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D O N N E E S G E N E R A L E S D E C O N T R O L E D E L A */ /* C O N V O L U T I O N D ' U N P O I N T P A R U N N O Y A U : */ /* */ /*************************************************************************************************************************************/ DEFV(Common,DEFV(Logical,ZINT(Pconvolution_____compatibilite_2014082110,FAUX))); /* Introduit le 20140821102151 afin de permettre de retablir le comportement anterieur */ /* de 'NOMBRE_DE_POINTS_EFFECTIF_D_UN_NOYAU_DE_CONVOLUTION_PARCOURU_CIRCULAIREMENT(...)'. */ DEFV(Common,DEFV(Logical,ZINT(Pconvolution_____compatibilite_20141124,FAUX))); /* Introduit le 20141124102151 afin de permettre de retablir le comportement anterieur */ /* pour determiner le dernier point d'une spirale circulaire... */ DEFV(Common,DEFV(Logical,ZINT(Pconvolution_____editer_le_noyau_de_convolution,FAUX))); DEFV(Common,DEFV(Int,ZINT(Pconvolution_____coordonnee_X_d_edition_du_noyau_de_convolution,k___Xmin))); DEFV(Common,DEFV(Int,ZINT(Pconvolution_____coordonnee_Y_d_edition_du_noyau_de_convolution,k___Ymin))); /* Introduit le 20191205112713 alors que j'avais des problemes de comprehension du */ /* fonctionnement du programme 'v $xci/dilate.01$K' en mode "dilater=VRAI"... */ DEFV(Common,DEFV(Logical,ZINT(Pconvolution_____parcourir_circulairement_les_spirales_carrees,FAUX))); /* Indique si les spirales carres doivent etre parcourues circulairement ('VRAI') ou selon */ /* la methode naturelle ('FAUX'). */ /* */ /* ATTENTION : le 20060606125544 je note (donc bien tardivement...) que parcourir */ /* circulairement une spirale carre fait que les points utilises ne le sont pas dans */ /* l'ordre habituel, mais suivant des cercles concentriques de taille de plus en plus */ /* grande. Cela n'equivaut donc pas a utiliser un noyau circulaire de convolution, sauf */ /* si le nombre de points (lors du parcours circulaire) est egal au carre d'un nombre */ /* impair multiplie par pi/4 (ce facteur etant donc le rapport entre l'aire d'un carre */ /* de cote 2 a celui d'un cercle de diametre 2)... */ DEFV(Common,DEFV(Logical,ZINT(Pconvolution_____adapter_le_nombre_de_points_lors_du_parcours_circulaire_des_spirales_carrees,VRAI))); /* Indique si, lorsque les spirales carres doivent etre parcourues circulairement (voir */ /* 'Pconvolution_____parcourir_circulairement_les_spirales_carrees' ci-dessus), s'il faut */ /* alors adapter automatiquement le nombre de points afin de respecter la consigne ci-dessus */ /* (etre egal au carre d'un nombre impair multiplie par pi/4). Ceci fut introduit le */ /* 20061224110500... */ /* */ /* La modification du 20190208144946 est justifiee dans 'v $xci/convol.01$K 20190208144516'. */ DEFV(Common,DEFV(Logical,ZINT(Pconvolution_____placer_l_image_sur_un_tore,FAUX))); /* Indique si l'image est consideree comme placee sur un tore ('VRAI'), ou bien si elle */ /* est dans un plan infini ('FAUX'), auquel cas, son exterieur est consideree comme de */ /* niveau 'NOIR'. */ #define PasX_DE_LA_MOSAIQUE_DE_CONVOLUTION \ PasX #define PasY_DE_LA_MOSAIQUE_DE_CONVOLUTION \ PasY /* Definition par defaut de la dimension d'un element de la mosaique de convolution. */ DEFV(Common,DEFV(Int,ZINT(Pconvolution_____pasX_de_la_mosaique_de_convolution,PasX_DE_LA_MOSAIQUE_DE_CONVOLUTION))); DEFV(Common,DEFV(Int,ZINT(Pconvolution_____pasY_de_la_mosaique_de_convolution,PasY_DE_LA_MOSAIQUE_DE_CONVOLUTION))); /* Definition courante de la dimension d'un element de la mosaique de convolution. */ #define TraX_DE_LA_MOSAIQUE_DE_CONVOLUTION \ MOIT(PasX_DE_LA_MOSAIQUE_DE_CONVOLUTION) #define TraY_DE_LA_MOSAIQUE_DE_CONVOLUTION \ MOIT(PasY_DE_LA_MOSAIQUE_DE_CONVOLUTION) /* Definition par defaut du centre d'un element de la mosaique de convolution. */ DEFV(Common,DEFV(Int,ZINT(Pconvolution_____translationX_de_la_mosaique_de_convolution,TraX_DE_LA_MOSAIQUE_DE_CONVOLUTION))); DEFV(Common,DEFV(Int,ZINT(Pconvolution_____translationY_de_la_mosaique_de_convolution,TraY_DE_LA_MOSAIQUE_DE_CONVOLUTION))); /* Definition courante du centre d'un element de la mosaique de convolution. */ /* La notion de mosaique de convolution est introduite afin de pouvoir donner la meme */ /* valeur de convolution a des groupes rectangulaires de points de l'image Resultat ; un */ /* tel groupe de points est appele un element de la mosaique. A titre d'exemple : */ /* */ /* pas = (3,3) */ /* translation = (1,1) */ /* */ /* definissent une mosaique dont chaque element fait 3x3 points et dont l'element situe en */ /* bas et a gauche a comme coordonnees (Xmin,Ymin). */ /* */ /* Ainsi, tous les points appartenant au meme element de mosaique auront la meme valeur */ /* apres convolution, celle-ci etant calculee au point central de l'element courant de la */ /* mosaique ; on notera que dans le cas ou la mosaique courante est definie avec des blocs */ /* plus grands que 1x1 (c'est-a-dire l'etat par defaut), le calcul pourrait etre optimise */ /* et n'etre fait qu'une seule fois a l'interieur de l'element courant, mais ce n'est pas */ /* le cas, pour simplifier... */ DEFV(Common,DEFV(Logical,ZINT(Pconvolution_____normaliser_le_cumul_pondere,VRAI))); /* Afin de savoir si le cumul pondere genere par 'Pconvolution(...)' doit etre normalise */ /* avec la somme des valeurs du noyau de convolution. Cet indicateur a ete introduit afin */ /* de permettre l'utilisation de noyau dont la somme des elements est nulle ; par exemple */ /* le noyau (0,0,0,+1,0,0,0,-1,0) ou encore (0,+1,0,0,0,-1,0,0,0)... */ DEFV(Common,DEFV(Logical,ZINT(Pconvolution_____normaliser_uniquement_avec_les_ponderations_utilisees,VRAI))); /* Lorsque la normalisation a lieu (voir 'Pconvolution_____normaliser_le_cumul_pondere'), */ /* utilise-t-on uniquement les ponderations correspondant aux points traites sur la spirale */ /* ('VRAI') ou bien tous les points et meme ceux qui sont, par exemple, hors de l'ecran */ /* ('FAUX'). */ #define AUCUN_POINT_TRAITE_DANS_LE_NOYAU \ FZERO \ /* Valeur renvoyee par 'Pconvolution' lorsqu'aucun point n'a ete traite (parce */ \ /* qu'hors-image ou 'INACTIF') dans le noyau courant. */ DEFV(Common,DEFV(Positive,ZINT(Pconvolution_____nombre_de_points_sautes,NOMBRE_DE_POINTS_SAUTES_SUR_LA_SPIRALE))); /* Afin de pouvoir sauter des points sur la spirale utilisee par 'Pconvolution(...)' ; */ /* mais a l'etat initial, tous les points seront pris en compte... */ DEFV(Common,DEFV(Float,ZINT(Pconvolution_____exposant_de_la_fonction_de_transfert ,EXPOSANT_DE_LA_FONCTION_DE_TRANSFERT_UNITE_APRES_CONVOLUTION ) ) ); /* Lorsque le cumul est normalise apres calcul, une fonction de transfert lui est applique ; */ /* une exponentiation dont 'Pconvolution_____exposant_de_la_fonction_de_transfert' est */ /* l'exposant. Il s'agit de la fonction de transfert "unite" a priori... */ DEFV(Common,DEFV(Float,ZINT(Pconvolution_____ponderation_de_cumul_courant_normalise_apres_transfert,FU))); DEFV(Common,DEFV(Float,ZINT(Pconvolution_____ponderation_de_Pconvolution_____minimum_sur_la_spirale,FZERO))); DEFV(Common,DEFV(Float,ZINT(Pconvolution_____ponderation_de_Pconvolution_____maximum_sur_la_spirale,FZERO))); DEFV(Common,DEFV(Float,ZINT(Pconvolution_____ponderation_de_Pconvolution_____moyenne_sur_la_spirale,FZERO))); /* Ponderations introduite le 20070205133747. Les valeurs par defaut garantissent la */ /* compatibilite anterieure. Cela fut introduit pour pouvoir renvoyer essentiellement */ /* le maximum... */ /* */ /* La moyenne fut introduite le 20161117133025, meme si cela ne sert pas a grand chose, */ /* la moyenne ressemblant beaucoup au cumul si ce n'est que ce dernier est pondere... */ DEFV(Common,DEFV(Logical,ZINT(Pconvolution_____conserver_le_niveau_du_centre_de_la_spirale_s_il_est_le_minimum,FAUX))); DEFV(Common,DEFV(Logical,ZINT(Pconvolution_____conserver_le_niveau_du_centre_de_la_spirale_s_il_est_le_maximum,FAUX))); /* La possibilite de conserver le niveau courant (celui du point courant {X,Y}) s'il */ /* est egal a un extremum rencontre sur la spirale a ete introduite le 20130630183754... */ #define UTILISER_LE_PREMIER_POINT_POUR_LA_RECHERCHE_DES_EXTREMA_DANS_Pconvolution_ET_DANS_PFconvolution \ Bblock \ BSaveModifyVariable(Logical,Pconvolution_____utiliser_le_premier_point_pour_la_recherche_des_extrema,VRAI); \ /* Mis sous cette forme le 20101115152408... */ \ /* */ \ /* Afin d'utiliser le premier point. ATTENTION : le 'Eblock' manquant est dans */ \ /* 'COMMENT_UTILISER_LE_PREMIER_POINT_POUR_LA_RECHERCHE_DES_EXTREMA_DANS_Pconvolution_...'. */ #define NE_PAS_UTILISER_LE_PREMIER_POINT_POUR_LA_RECHERCHE_DES_EXTREMA_DANS_Pconvolution_ET_DANS_PFconvolution \ Bblock \ BSaveModifyVariable(Logical,Pconvolution_____utiliser_le_premier_point_pour_la_recherche_des_extrema,FAUX); \ /* Mis sous cette forme le 20101115152408... */ \ /* */ \ /* Afin de ne pas utiliser le premier point. ATTENTION : le 'Eblock' manquant est dans */ \ /* 'COMMENT_UTILISER_LE_PREMIER_POINT_POUR_LA_RECHERCHE_DES_EXTREMA_DANS_Pconvolution_...'. */ #define COMMENT_UTILISER_LE_PREMIER_POINT_POUR_LA_RECHERCHE_DES_EXTREMA_DANS_Pconvolution_ET_DANS_PFconvolution \ ESaveModifyVariable(Logical,Pconvolution_____utiliser_le_premier_point_pour_la_recherche_des_extrema); \ /* Mis sous cette forme le 20101115152408... */ \ /* */ \ Eblock \ /* Restauration du mode gestion du premier point. ATTENTION : l'absence de 'Bblock' est */ \ /* logique et correspond a l'usage qui doit etre fait de ces trois procedures... */ DEFV(Common,DEFV(Logical,ZINT(Pconvolution_____utiliser_le_premier_point_pour_la_recherche_des_extrema,VRAI))); /* Afin de savoir si le premier point de la spirale doit etre pris en compte pour la */ /* recherche de {minimum,moyenne,maximum} dans 'Pconvolution(...)'. Ce dispositif a ete */ /* introduit le 20020629232932 et sa valeur par defaut ('VRAI') permet de garantir la */ /* compatibilite avec les versions anterieures. Ce dispositif fut rendu necessaire par */ /* la fonction 'Ifiltrage_des_points_isoles(...)' introduite a cette date-la... */ /* On notera au passage que ce premier point de la spirale n'est pas obligatoirement */ /* le centre de cette spirale, et ce a cause des differentes possibilites d'inhibition, */ /* mais on fait comme si... */ DEFV(Common,DEFV(Int,ZINT(Pconvolution_____tester_le_niveau_du_centre_de_la_spirale,VRAI))); /* Lors de la recherche d'un point de meme niveau que le centre de la spirale, cet */ /* indicateur indique si l'on peut tester ('VRAI') le centre de la spirale, ou si l'on */ /* doit le sauter ('FAUX')... On notera qu'a l'etat 'VRAI' cet indicateur est plus utile */ /* pour assurer la continuite des champs de distance (euclidienne par exemple) que l'on */ /* calcule dans 'IFdistance_aux_niveaux_identiques(...)'. */ /* ATTENTION : si 'IL_FAUT(Pconvolution_____remplacer__meme_niveau__par__niveau_different)' */ /* il faudrait en toute logique remplacer ci-dessous dans les noms de variable */ /* "de_meme_niveau" par "de_niveau_different", mais cela est evidemment impossible */ /* puisqu'il s'agit encore une fois de noms de variables... */ #define PCONVOLUTION_RANG_DU_N_IEME_POINT_DE_MEME_NIVEAU \ PREMIER_POINT DEFV(Common,DEFV(Int,ZINT(Pconvolution_____rang_du_n_ieme_point_de_meme_niveau,PCONVOLUTION_RANG_DU_N_IEME_POINT_DE_MEME_NIVEAU))); /* Lors de la recherche d'un point de meme niveau que le centre de la spirale, cette */ /* variable permet de selecter le rang de celui-ci ; on peut ainsi selectionner le premier */ /* (etat par defaut), le second,... */ #define PCONVOLUTION_NUMERO_DU_N_IEME_POINT_DE_MEME_NIVEAU \ SUCC(LSTX(PREMIER_POINT,npn_effectif)) \ /* Pour initialiser dynamiquement 'Pconvolution_____numero_du_n_ieme_point_de_meme_niveau'. */ DEFV(Common,DEFV(Int,ZINT(Pconvolution_____numero_du_n_ieme_point_de_meme_niveau,ZERO))); /* Permet de savoir le numero du premier point rencontre sur la spirale de 'imageA2' qui */ /* possede le meme niveau que le centre de cette meme spirale sur 'imageA1'. La valeur */ /* implicite 'ZERO' est choisie en faisant que 'imageA1' et 'imageA2' soient identiques... */ DEFV(Common,DEFV(Int,INIT(Pconvolution_____X_du_n_ieme_point_de_meme_niveau,UNDEF))); DEFV(Common,DEFV(Int,INIT(Pconvolution_____Y_du_n_ieme_point_de_meme_niveau,UNDEF))); /* Et memorisation des coordonnees {X,Y} de ce point... */ DEFV(Common,DEFV(genere_Float,INIT(Pconvolution_____niveau_du_n_ieme_point_de_meme_niveau,FLOT__NIVEAU_UNDEF))); /* Et memorisation du niveau de ce point (introduit le 20060125102933). */ /* */ /* ATTENTION : on utilise 'genere_Float' car, en effet, cette variable est indifferemment */ /* utilisee par 'Pconvolution(...)' et 'PFconvolution(...)' ; donc, de 'genere_p' et de */ /* 'genere_Float', il faut prendre le "plus grand" des deux... */ /* ATTENTION : si 'IL_FAUT(Pconvolution_____remplacer__meme_niveau__par__niveau_different)' */ /* il faudrait en toute logique remplacer ci-dessous dans les noms de variable */ /* "de_meme_niveau" par "de_niveau_different", mais cela est evidemment impossible */ /* puisqu'il s'agit encore une fois de noms de variables... */ DEFV(Common,DEFV(Logical,ZINT(Pconvolution_____remplacer__meme_niveau__par__niveau_different,FAUX))); /* Introduit le 20040627111702 afin de permettre de rechercher non pas un point de meme */ /* niveau, mais un point de niveau different... */ /* */ /* ATTENTION, cet indicateur lorsqu'il est VRAI, change le sens des variables : */ /* */ /* Pconvolution_____rang_du_n_ieme_point_de_meme_niveau */ /* Pconvolution_____numero_du_n_ieme_point_de_meme_niveau */ /* Pconvolution_____X_du_n_ieme_point_de_meme_niveau */ /* Pconvolution_____Y_du_n_ieme_point_de_meme_niveau */ /* Pconvolution_____niveau_du_n_ieme_point_de_meme_niveau */ /* */ /* pour lesquelles, en toute logique, "de_meme_niveau" devrait etre alors remplace par */ /* "de_niveau_different"... */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* R E S U L T A T S U T I L E S D E L A C O N V O L U T I O N D ' U N P O I N T P A R U N N O Y A U */ /* P A R T A G E S P A R ' Pconvolution(...) ' E T ' PFconvolution(...) ' : */ /* */ /*************************************************************************************************************************************/ /* ATTENTION : 'nombre_reel_de_points', 'cumul_courant' et 'cumul_des_ponderations' sont */ /* trois variables mise en 'Common' parce que leurs valeurs peuvent etre tres utiles au */ /* retour de la fonction 'Pconvolution(...)' (voir par exemple le code de la fonction */ /* 'IFnombre_de_points_generalise_dans_un_voisinage(...)'). */ /* Les symboles {nombre_reel_de_points,cumul_courant,cumul_des_ponderations} ont ete */ /* prefixes par la racine "Pconvolution_" le 20030120142315 pour des raisons evidentes */ /* d'homogeneite... */ DEFV(Common,DEFV(Int,ZINT(Pconvolution_____nombre_reel_de_points,ZERO))); DEFV(Common,DEFV(Int,ZINT(Pconvolution_____nombre_reel_de_points__DANS_L_IMAGE,ZERO))); DEFV(Common,DEFV(Int,ZINT(Pconvolution_____nombre_reel_de_points__HORS_IMAGE__,ZERO))); DEFV(Local,DEFV(Int,INIT(nombre_reel_de_points_pour_le_calcul_de_la_moyenne,UNDEF))); /* Nombre reel (a cause des sorties d'ecran) de points traites sur la spirale. */ /* */ /* Les nombres 'DANS_L_IMAGE' et 'HORS_IMAGE' ont ete introduits le 20231031084321... */ DEFV(Common,DEFV(Float,ZINT(Pconvolution_____cumul_courant,FZERO))); /* Cumul courant lors du parcours de la spirale. */ DEFV(Common,DEFV(Float,ZINT(Pconvolution_____cumul_des_ponderations,FZERO))); /* Cumul des coefficients de ponderation pour les points reellement traites. */ /* ATTENTION : 'nombre_reel_de_points', 'cumul_courant' et 'cumul_des_ponderations' sont */ /* trois variables mise en 'Common' parce que leurs valeurs peuvent etre tres utiles au */ /* retour de la fonction 'Pconvolution(...)' (voir par exemple le code de la fonction */ /* 'IFnombre_de_points_generalise_dans_un_voisinage(...)'). */ /* Les symboles {nombre_reel_de_points,cumul_courant,cumul_des_ponderations} ont ete */ /* prefixes par la racine "Pconvolution_" le 20030120142315 pour des raisons evidentes */ /* d'homogeneite... */ DEFV(Local,DEFV(Float,ZINT(Pconvolution_____valeur_du_Laplacien_generalise,FZERO))); /* Valeur du Laplacien generalise losrque son calcul est demande (introduit le */ /* 20210225113338). */ DEFV(Common,DEFV(genere_Float,ZINT(Pconvolution_____dispersion_des_niveaux_sur_la_spirale,FZERO))); DEFV(Common,DEFV(genere_Float,ZINT(Pconvolution_____dispersion_des_niveaux_sur_la_spirale__ponderation__minimum,FZERO))); DEFV(Common,DEFV(genere_Float,ZINT(Pconvolution_____dispersion_des_niveaux_sur_la_spirale__ponderation__moyenne,FU))); DEFV(Common,DEFV(genere_Float,ZINT(Pconvolution_____dispersion_des_niveaux_sur_la_spirale__ponderation__maximum,FZERO))); DEFV(Common,DEFV(genere_Float,ZINT(Pconvolution_____dispersion_des_niveaux_sur_la_spirale__ponderation__translation,FZERO))); /* Dispersion des niveaux, c'est-a-dire somme des valeurs absolues entre niveaux courant */ /* et precedent sur la spirale. Ceci a ete introduit le 20151105103406... */ /* */ /* On notera le 20151105110016 qu'evidemment cette mesure n'est pas absolue et */ /* qu'evidemment elle est tres liee au parcours en spirale. Un autre type de parcours */ /* donnerait evidemment autre chose... */ /* */ /* Les elements de ponderation de la dispersion ont ete introduits le 20151112092202... */ DEFV(Common,DEFV(genere_Float,ZINT(Pconvolution_____moyenne_sur_la_spirale,FZERO))); /* Moyenne (non ponderee) des niveaux rencontres sur la spirale courante (introduit le */ /* 20020629175616) avec ou sans le premier point de la spirale. */ /* */ /* ATTENTION : on utilise 'genere_Float' car, en effet, cette variable est indifferemment */ /* utilisee par 'Pconvolution(...)' et 'PFconvolution(...)' ; donc, de 'genere_p' et de */ /* 'genere_Float', il faut prendre le "plus grand" des deux... */ /* */ /* On notera que 'Pconvolution_____moyenne_sur_la_spirale' ressemble beaucoup a */ /* 'Pconvolution_____cumul_courant', si ce n'est que la moyenne n'est pas ponderee */ /* comme l'est le cumul... */ DEFV(Common,DEFV(genere_Float,ZINT(Pconvolution_____minimum_sur_la_spirale,F_INFINI))); DEFV(Common,DEFV(genere_Float,ZINT(Pconvolution_____maximum_sur_la_spirale,F_MOINS_L_INFINI))); /* Extrema des niveaux rencontres sur la spirale courante. ATTENTION : ces deux valeurs */ /* sont mises en 'Common' car elles pourraient etre utiles ailleurs ; de plus, elle sont */ /* initialisees avec {INFINI,MOINS_L_INFINI} (et non pas avec {NIVEAU_UNDEF,NIVEAU_UNDEF} */ /* ou {BLANC,NOIR}), et donc declarees 'Int', d'une part afin de permettre de savoir si */ /* 'Pconvolution(...)' a ete appelee au moins une fois, et d'autre part, afin de ne pas */ /* faire l'hypothese implicite qu'il n'y a pas d'autres niveaux hors de [NOIR,BLANC]... */ /* */ /* Le 20011214085530 je suis passe de 'Int' a 'genere_Float' car, en effet, dans la mesure */ /* ou existent simultanement 'Pconvolution(...)' et 'PFconvolution(...)', il convient */ /* d'utiliser pour ces deux variables qui sont partagees par ces deux fonctions le type */ /* "maximal" (qui evite donc des pertes de precision...) ; de plus et simultanement, on est */ /* evidemment passe de {INFINI,MOINS_L_INFINI} a {F_INFINI,F_MOINS_L_INFINI}. */ /* */ /* Le 20020629232932 il a ete introduit la possibilite de faire cette recherche d'extrema */ /* en tenant compte ou pas du premier point de la spirale (comme cela est fait pour */ /* 'Pconvolution_____moyenne_sur_la_spirale'). */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D O N N E E S D E C A L C U L D U L A P L A C I E N G E N E R A L I S E : */ /* */ /*************************************************************************************************************************************/ DEFV(Common,DEFV(Logical,ZINT(Pconvolution_____calculer___le_Laplacien_generalise,FAUX))); DEFV(Common,DEFV(Logical,ZINT(Pconvolution_____soustraire_le_Laplacien_generalise,FAUX))); /* Afin de savoir si l'on doit calculer le Laplacien generalise (introduit le */ /* 20210225113338). */ /* */ /* Rappelons qu'au point {X,Y}, le Laplacien ("discret") vaut : */ /* */ /* D (X,Y) = P(X,Y) - P(X-1,Y) \ */ /* x | */ /* | Derivees premieres. */ /* D (X,Y) = P(X,Y) - P(X,Y-1) | */ /* y / */ /* */ /* */ /* 2 */ /* D (X,Y) = D (X+1,Y) - D (X,Y) \ */ /* x x x | */ /* | Derivees secondes. */ /* 2 | */ /* D (X,Y) = D (X,Y+1) - D (X,Y) / */ /* y y y */ /* */ /* */ /* 2 2 */ /* Laplacien(X,Y) = D (X,Y) + D (X,Y) */ /* x y */ /* */ /* soit : */ /* */ /* Laplacien(X,Y) = */ /* [P(X+1,Y) - P(X,Y)] */ /* + [P(X-1,Y) - P(X,Y)] */ /* + [P(X,Y+1) - P(X,Y)] */ /* + [P(X,Y-1) - P(X,Y)] */ /* */ /* On notera que si l'on soustrait cela a P(X,Y) on ameliore le contraste de l'image... */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D O N N E E S D E C A L C U L D E L ' I N E R T I E D ' U N P O I N T P A R U N N O Y A U : */ /* */ /*************************************************************************************************************************************/ DEFV(Common,DEFV(Logical,ZINT(Pconvolution_____calculer_l_inertie,FAUX))); /* Afin de savoir si l'on va convoluer "simplement" ('FAUX') ou bien calculer les moments */ /* d'inertie au voisinage du point courant ('VRAI') de l'image... */ DEFV(Common,DEFV(Float,ZINT(Pconvolution_____coefficient_de_Ixx,NE_PAS_CALCULER_L_INERTIE))); DEFV(Common,DEFV(Float,ZINT(Pconvolution_____coefficient_de_Ixyx,NE_PAS_CALCULER_L_INERTIE))); DEFV(Common,DEFV(Float,ZINT(Pconvolution_____coefficient_de_Iyy,NE_PAS_CALCULER_L_INERTIE))); DEFV(Common,DEFV(Float,ZINT(Pconvolution_____translation_des_I,CALCULER_L_INERTIE))); /* Afin de pouvoir sauter des points sur la spirale utilisee par 'Pconvolution(...)' ; */ /* mais a l'etat initial, tous les points seront pris en compte... */ #define COORDONNEE_D_INERTIE_X(X) \ FLOT(X) #define COORDONNEE_D_INERTIE_Y(Y) \ FLOT(Y) /* Fonctions de passage des coordonnees d'image {X,Y} aux coordonnees necessaires au */ /* calcul des differents moments d'inertie. On notera qu'une autre definition possible */ /* est : */ /* */ /* #define COORDONNEE_D_INERTIE_X(X) \ */ /* _____cNORMALISE_OX(X) */ /* #define COORDONNEE_D_INERTIE_Y(Y) \ */ /* _____cNORMALISE_OY(Y) */ /* */ /* La solution actuellement utilisee, via les 'FLOT(...)', semble meilleure que celle qui */ /* utilisait les '_____cNORMALISE_O?(...)', car en effet cette solution introduisait des */ /* erreurs (d'arrondi ?) se manifestant par un partitionnement en quatre cadrans de la */ /* plupart des images Resultat... */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D O N N E E S D E C A L C U L D E L ' H I S T O G R A M M E D E S */ /* N I V E A U X D U V O I S I N A G E D ' U N P O I N T : */ /* */ /*************************************************************************************************************************************/ DEFV(Local,DEFV(Logical,INIT(Pconvolution_____calculer_l_histogramme_des_niveaux,FAUX))); /* Faut-il calculer l'histogramme des niveaux (ceci fut introduit le 20070209090906). Sa */ /* valeur par defaut garantit la compatibilite anterieure. Son calcul n'a lieu que pour */ /* les elements non nuls du noyau... */ DEFV(Local,DEFV(Int,INIT(Pconvolution_____nombre_de_points_de_l_histogramme_des_niveaux,UNDEF))); /* Nombre de points qui sont pris en compte dans l'histogramme courant (ceci fut introduit */ /* le 20070227104454). */ DEFV(Local,DEFV(Int,DTb1(Pconvolution_____histogramme_des_niveaux,COULEURS))); /* L'histogramme est un vecteur comportant autant d'entrees qu'il y a de */ /* niveaux possibles ; dans chacune de celles-ci, on trouvera le nombre de */ /* points possedant ce niveau dans le voisinage d'un point introduit le 20070209090906). */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* G E S T I O N D U P A R C O U R S D E L A S P I R A L E : */ /* */ /*************************************************************************************************************************************/ DEFV(Common,DEFV(Logical,ZINT(Pconvolution_____la_spirale_est_interruptible,FAUX))); /* Afin de savoir si l'on peut interrompe ('VRAI') ou pas ('FAUX') le parcours de la */ /* spirale de convolution... */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* R E C H E R C H E D ' U N E F O R M E S U R L A S P I R A L E : */ /* */ /*************************************************************************************************************************************/ DEFV(Local,DEFV(Logical,INIT(Pconvolution_____recherche_d_une_forme_sur_la_spirale,FAUX))); /* Cet indicateur a ete introduit le 20030115145023. Sa valeur par defaut ('FAUX') permet */ /* d'assurer la compatibilite avec l'etat anterieur. Sa valeur 'VRAI" permet de faire du */ /* noyau 'n' une "forme" (c'est-a-dire une configuration particuliere de points recherchee). */ /* Cette forme est alors definie par le noyau 'n' qui est sytematiquement en format 'Float'. */ /* Ceci a ete introduit dans le but d'etudier des automates cellulaires bidimensionnels... */ /* On notera au passage qu'avec l'existant cela etait partiellement possible car, en effet, */ /* la somme ponderee des niveaux sur une spirale, a condition de choisir astucieusement les */ /* ponderarions, permet de coder une forme : par exemple si les ponderarions sont des */ /* puissances de 'COULEURS' ; ainsi au retour des fonctions de type 'Pconvolution(...)' */ /* il etait deja possible de tester si le voisinage du point {X,Y} correspondait a une */ /* certaine "forme" (c'est-a-dire une certaine configuration de points...). */ /* */ /* Le 20030117094239, cet indicateur est passe de 'Common' a 'Local' car, en effet, */ /* dans l'utilisation qui en est faite, il n'a pas besoin d'etre accessible en dehors */ /* de '$xiii/di_image$FON'. */ DEFV(Local,DEFV(Logical,INIT(Pconvolution_____la_forme_cherchee_a_ete_trouvee_sur_la_spirale,FAUX))); /* Permet, si 'IL_FAUT(Pconvolution_____recherche_d_une_forme_sur_la_spirale)', de renvoyer */ /* le resultat des tests... */ /* */ /* Le 20030117094239, cet indicateur est passe de 'Common' a 'Local' car, en effet, */ /* dans l'utilisation qui en est faite, il n'a pas besoin d'etre accessible en dehors */ /* de '$xiii/di_image$FON'. */ DEFV(Local,DEFV(Positive,INIT(Pconvolution_____nombre_courant_lors_de_la_recherche_d_une_forme_sur_la_spirale,ZERO))); /* Nombre d'elements non nuls lors du parcours de la spirale. */ /* Ceci a ete introduit le 20030126120532 suite a celle des listes de SUBSTITUTION dans la */ /* fonction 'Iautomate_cellulaire_bidimensionnel_par_convolution(...)'. */ DEFV(Local,DEFV(Positive,INIT(Pconvolution_____nombre_des_ponderations_lors_de_la_recherche_d_une_forme_sur_la_spirale,ZERO))); /* Nombre de coefficients de ponderation non nuls pour les points reellement traites. */ /* Ceci a ete introduit le 20030126120532 suite a celle des listes de SUBSTITUTION dans la */ /* fonction 'Iautomate_cellulaire_bidimensionnel_par_convolution(...)'. */ DEFV(Local,DEFV(Float,INIT(Pconvolution_____cumul_courant_lors_de_la_recherche_d_une_forme_sur_la_spirale,FZERO))); /* Cumul courant de tous les elements lors du parcours de la spirale. */ /* Introduit en plus de 'Pconvolution_____cumul_courant' le 20030127101035 pour reduire */ /* les ambiguites... */ DEFV(Local,DEFV(Float,INIT(Pconvolution_____cumul_des_ponderations_lors_de_la_recherche_d_une_forme_sur_la_spirale,FZERO))); /* Cumul de tous les coefficients de ponderation pour les points reellement traites. */ /* Introduit en plus de 'Pconvolution_____cumul_des_ponderations' le 20030127101035 pour */ /* reduire les ambiguites... */ DEFV(Local,DEFV(Float,INIT(Pconvolution_____produit_courant_lors_de_la_recherche_d_une_forme_sur_la_spirale,FU))); /* Produit courant des elements non nuls lors du parcours de la spirale. */ DEFV(Local,DEFV(Float,INIT(Pconvolution_____produit_des_ponderations_lors_de_la_recherche_d_une_forme_sur_la_spirale,FU))); /* Produit des coefficients de ponderation non nuls pour les points reellement traites. */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* " D I S P E R S I O N " E V E N T U E L L E D U N O Y A U D E C O N V O L U T I O N : */ /* */ /*************************************************************************************************************************************/ DEFV(Common,DEFV(Logical,INIT(Pconvolution_____disperser_le_noyau_de_convolution,FAUX))); /* Cet indicateur a ete introduit le 20201002104235. Sa valeur par defaut ('FAUX') permet */ /* d'assurer la compatibilite avec l'etat anterieur. */ DEFV(Common,DEFV(Float,INIT(Pconvolution_____disperser_le_noyau_de_convolution_X_a00,FZERO))); DEFV(Common,DEFV(Float,INIT(Pconvolution_____disperser_le_noyau_de_convolution_X_a01,FZERO))); DEFV(Common,DEFV(Float,INIT(Pconvolution_____disperser_le_noyau_de_convolution_X_a02,FZERO))); DEFV(Common,DEFV(Float,INIT(Pconvolution_____disperser_le_noyau_de_convolution_X_a10,FU))); DEFV(Common,DEFV(Float,INIT(Pconvolution_____disperser_le_noyau_de_convolution_X_a11,FZERO))); DEFV(Common,DEFV(Float,INIT(Pconvolution_____disperser_le_noyau_de_convolution_X_a12,FZERO))); DEFV(Common,DEFV(Float,INIT(Pconvolution_____disperser_le_noyau_de_convolution_X_a20,FZERO))); DEFV(Common,DEFV(Float,INIT(Pconvolution_____disperser_le_noyau_de_convolution_X_a21,FZERO))); DEFV(Common,DEFV(Float,INIT(Pconvolution_____disperser_le_noyau_de_convolution_X_a22,FZERO))); /* Coefficients de dispersion de la coordonnee 'X'. */ DEFV(Common,DEFV(Float,INIT(Pconvolution_____disperser_le_noyau_de_convolution_Y_a00,FZERO))); DEFV(Common,DEFV(Float,INIT(Pconvolution_____disperser_le_noyau_de_convolution_Y_a01,FU))); DEFV(Common,DEFV(Float,INIT(Pconvolution_____disperser_le_noyau_de_convolution_Y_a02,FZERO))); DEFV(Common,DEFV(Float,INIT(Pconvolution_____disperser_le_noyau_de_convolution_Y_a10,FZERO))); DEFV(Common,DEFV(Float,INIT(Pconvolution_____disperser_le_noyau_de_convolution_Y_a11,FZERO))); DEFV(Common,DEFV(Float,INIT(Pconvolution_____disperser_le_noyau_de_convolution_Y_a12,FZERO))); DEFV(Common,DEFV(Float,INIT(Pconvolution_____disperser_le_noyau_de_convolution_Y_a20,FZERO))); DEFV(Common,DEFV(Float,INIT(Pconvolution_____disperser_le_noyau_de_convolution_Y_a21,FZERO))); DEFV(Common,DEFV(Float,INIT(Pconvolution_____disperser_le_noyau_de_convolution_Y_a22,FZERO))); /* Coefficients de dispersion de la coordonnee 'Y'. */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* G E N E R A T E U R D E C O N V O L U T I O N D ' U N P O I N T P A R U N N O Y A U : */ /* */ /*************************************************************************************************************************************/ #define EDITION_INCONDITIONNELLE_DU_NOYAU_DE_CONVOLUTION(x,y,numero) \ Bblock \ CAL3(Prme5("NoyauDeConvolution(%+05d,%+05d)[%04d]=%+.^^^ : %s\n" \ /* On notera "%+05d" et non pas "%+04d" car, en effet, le "+" compte pour un caractere, */ \ /* d'ou le "5" (=4+1)... */ \ ,x,y \ ,numero \ ,ITb0(n,INDX(numero,PREMIER_POINT)) \ ,COND(EST_ACTIF(ITb0(in,INDX(numero,PREMIER_POINT))) \ ,"AUTORISE" \ ,"INHIBE" \ ) \ ) \ ); \ Eblock \ /* Introduit le 20210309134411... */ #define EDITION_CONDITIONNELLE_DU_NOYAU_DE_CONVOLUTION(eventuel_X_precedent,eventuel_Y_precedent,eventuel_numero_precedent_de_point) \ Bblock \ Test(IL_FAUT(Pconvolution_____editer_le_noyau_de_convolution)) \ /* Mis ici le 20210309134411 afin de pouvoir editer {X_courant,Y_courant} en plus... */ \ Bblock \ Test(IFET(IFEQ(X,Pconvolution_____coordonnee_X_d_edition_du_noyau_de_convolution) \ ,IFEQ(Y,Pconvolution_____coordonnee_Y_d_edition_du_noyau_de_convolution) \ ) \ ) \ Bblock \ Test(IFEQ(eventuel_numero_precedent_de_point,PREMIER_POINT)) \ Bblock \ EDITION_INCONDITIONNELLE_DU_NOYAU_DE_CONVOLUTION(eventuel_X_precedent \ ,eventuel_Y_precedent \ ,eventuel_numero_precedent_de_point \ ); \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ EDITION_INCONDITIONNELLE_DU_NOYAU_DE_CONVOLUTION(X_courant,Y_courant,numero_courant_de_point); \ /* Introduit le 20191205112713 alors que j'avais des problemes de comprehension du */ \ /* fonctionnement du programme 'v $xci/dilate.01$K' en mode "dilater=VRAI"... */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ /* Introduit le 20210315105035 afin de traiter le cas ou le noyau de convolution ne */ \ /* contient qu'un seul point... */ #define GENERE__FonctionF_C(nom_et_arguments_de_la_fonction,type_point,type_image,fonction_load,fonction_load_modulo) \ /* ATTENTION : le nom de la fonction est suivi de ses arguments pour des raisons liees */ \ /* a la recuperation automatique des fichiers d'arguments. */ \ DEFV(FonctionF,nom_et_arguments_de_la_fonction) \ /* Le resultat est egal a imageA2[X][Y] convoluee par le noyau. */ \ DEFV(Argument,DEFV(type_image,i1)); \ /* 'imageA1' : */ \ /* */ \ /* image Argument utilisee pour le centre de la spirale, */ \ DEFV(Argument,DEFV(type_image,i2)); \ /* 'imageA2' : */ \ /* */ \ /* image Argument utilisee pour parcourir la spirale. */ \ DEFV(Argument,DEFV(Int,X)); \ DEFV(Argument,DEFV(Int,Y)); \ /* Coordonnees entieres 'X' et 'Y' du point a convoluer. */ \ DEFV(Argument,DEFV(Logical,DTb1(nc,COULEURS))); \ /* 'niveaux_cumulables' (soit "nc" en abreviation) : */ \ /* */ \ /* definit les niveaux cumulables lors du calcul de 'Pconvolution_____cumul_courant'. */ \ /* */ \ /* ATTENTION, dans le cas ou 'type_point' est du type 'genere_Float', le vecteur 'nc' */ \ /* doit etre 'ADRESSE_NON_DEFINIE' car il n'a pas de sens ('COULEURS' n'ayant pas non */ \ /* plus de sens). Ceci a ete introduit le 20010212145101. */ \ DEFV(Argument,DEFV(Int,npn)); \ /* 'nombre_de_points_du_noyau' (soit "npn" en abreviation) : */ \ /* */ \ /* nombre de points contenus dans le noyau, y compris son centre. */ \ DEFV(Argument,DEFV(Float,DTb0(n))); \ /* 'noyau' (soit "n" en abreviation) : */ \ /* */ \ /* noyau de convolution : il est defini par une liste contenant une spirale */ \ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ \ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ \ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ \ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ \ /* trigonometrique. */ \ /* */ \ /* A compter du 20030115145023, ce noyau peut de plus definir une forme recherchee dans */ \ /* le cas 'IL_FAUT(Pconvolution_____recherche_d_une_forme_sur_la_spirale)', cette */ \ /* possibilite etant evidemment exclusive de la precedente... */ \ DEFV(Argument,DEFV(Logical,DTb0(in))); \ /* 'inhibition_du_noyau' (soit "in" en abreviation) : */ \ /* */ \ /* precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ \ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ \ /*-----------------------------------------------------------------------------------------------------------------------------------*/ \ Bblock \ DEFV(Logical,INIT(les_images_i1_et_i2_sont_standards \ ,COND(IFOU(IFEQ(IDENTITE(nc),ADRESSE_NON_DEFINIE),IFEQ(IDENTITE(nc),ADRESSE_NON_ENCORE_DEFINIE)) \ ,FAUX \ ,VRAI \ ) \ ) \ ); \ /* Afin de savoir le type des images 'i'1 et 'i2' : 'VRAI' pour les images 'image' */ \ /* ('genere_p') et 'FAUX' pour les images 'imageF' ('genere_Float'). Cet indicateur a */ \ /* ete introduit le 20020703153110. */ \ \ DEFV(Logical,INIT(parcourir_la_spirale,VRAI)); \ /* Indicateur de parcours de la spirale de convolution... */ \ DEFV(Int,INIT(npn_effectif,npn)); \ /* Nombre de points effectifs de la spirale (introduit le 20061224110500). */ \ \ DEFV(Int,INIT(X_du_centre_de_la_spirale \ ,COXA(ADD2(MULD(COXR(X),Pconvolution_____pasX_de_la_mosaique_de_convolution) \ ,Pconvolution_____translationX_de_la_mosaique_de_convolution \ ) \ ) \ ) \ ); \ /* Abscisse du centre initialisee sur le point argument eventuellement recentre par rapport */ \ /* a la mosaique courante, */ \ DEFV(Int,INIT(Y_du_centre_de_la_spirale \ ,COYA(ADD2(MULD(COYR(Y),Pconvolution_____pasY_de_la_mosaique_de_convolution) \ ,Pconvolution_____translationY_de_la_mosaique_de_convolution \ ) \ ) \ ) \ ); \ /* Ordonnee du centre initialisee sur le point argument eventuellement recentre par rapport */ \ /* a la mosaique courante. */ \ DEFV(Int,INIT(valeur_maximale_de_X_et_de_Y_relatifs,UNDEF)); \ /* Definition de la valeur maximale des coordonnees 'X' et 'Y' relatives au centre de la */ \ /* spirale. */ \ DEFV(Int,INIT(X_courant,UNDEF)); \ DEFV(Int,INIT(Y_courant,UNDEF)); \ /* Definition du point courant de la spirale... */ \ SPIRALE_DEFINITION \ /* Donnees de generation d'une spirale de parcours d'une image. */ \ \ DEFV(type_point,INIT(niveau_du_centre_de_la_spirale,CAST(type_point,NIVEAU_UNDEF))); \ /* Niveau du centre de la spirale. */ \ DEFV(type_point,INIT(niveau_precedent,NIVEAU_UNDEF)); \ DEFV(Logical,INIT(le_niveau_precedent_existe,FAUX)); \ /* Niveau precedent (introduit le 20151105103406...). */ \ \ DEFV(Int,INIT(numero_courant_de_point,UNDEF)); \ /* Numero du point courant sur une spirale lors de son parcours. */ \ DEFV(Int,INIT(rang_courant_du_n_ieme_point_de_meme_niveau,PRED(PCONVOLUTION_RANG_DU_N_IEME_POINT_DE_MEME_NIVEAU))); \ /* Rang courant du point de meme niveau que le centre de la spirale... */ \ \ DEFV(Float,INIT(cumul_de_l_ensemble_des_ponderations,FZERO)); \ /* Cumul des coefficients de ponderation correspondant au noyau complet ; ce cumul n'a de */ \ /* sens que si 'Pconvolution_____normaliser_le_cumul_pondere' est 'VRAI'... */ \ DEFV(Float,INIT(cumul_courant_normalise_avant_transfert,FLOT__UNDEF)); \ DEFV(Float,INIT(cumul_courant_normalise_apres_transfert,FLOT__UNDEF)); \ /* Pour permettre l'application d'une fonction de transfert avant le retour... */ \ \ DEFV(Logical,INIT(on_a_teste_au_moins_un_point_de_la_forme_cherchee,FAUX)); \ /* Afin de savoir si au moins un point de la forme a ete teste... */ \ /*..............................................................................................................................*/ \ /* ATTENTION : 'nombre_reel_de_points', 'cumul_courant' et 'cumul_des_ponderations' sont */ \ /* trois variables mise en 'Common' parce que leurs valeurs peuvent etre tres utiles au */ \ /* retour de la fonction 'Pconvolution(...)' (voir par exemple le code de la fonction */ \ /* 'IFnombre_de_points_generalise_dans_un_voisinage(...)'). */ \ /* Les symboles {nombre_reel_de_points,cumul_courant,cumul_des_ponderations} ont ete */ \ /* prefixes par la racine "Pconvolution_" le 20030120142315 pour des raisons evidentes */ \ /* d'homogeneite... */ \ \ EGAL(niveau_du_centre_de_la_spirale,fonction_load(i1,X_du_centre_de_la_spirale,Y_du_centre_de_la_spirale)); \ /* Niveau du centre de la spirale. */ \ \ CLIR(Pconvolution_____nombre_reel_de_points); \ /* Nombre reel (a cause des sorties d'ecran) de points traites sur la spirale. */ \ CLIR(Pconvolution_____nombre_reel_de_points__DANS_L_IMAGE); \ CLIR(Pconvolution_____nombre_reel_de_points__HORS_IMAGE__); \ /* Nombres reels 'DANS_L_IMAGE' et 'HORS_IMAGE' introduits le 20231031084321... */ \ EGAL(Pconvolution_____cumul_courant,FZERO); \ /* Cumul courant lors du parcours de la spirale. */ \ EGAL(Pconvolution_____cumul_des_ponderations,FZERO); \ /* Cumul des coefficients de ponderation pour les points reellement traites. */ \ \ EGAL(Pconvolution_____dispersion_des_niveaux_sur_la_spirale,FZERO); \ /* Dispersion des niveaux sur la spirale (introduite le 20151105103406). */ \ \ EGAL(Pconvolution_____moyenne_sur_la_spirale,FZERO); \ /* Moyenne (non ponderee) des niveaux rencontres sur la spirale courante. */ \ EGAL(Pconvolution_____minimum_sur_la_spirale,F_INFINI); \ EGAL(Pconvolution_____maximum_sur_la_spirale,F_MOINS_L_INFINI); \ /* Extrema des niveaux rencontres sur la spirale courante. ATTENTION, le 20020629175616, */ \ /* ces initialisations sont passees de {INFINI,MOINS_L_INFINI} aux valeurs beaucoup plus */ \ /* logiques {F_INFINI,F_MOINS_L_INFINI}. */ \ \ EGAL(Pconvolution_____numero_du_n_ieme_point_de_meme_niveau,PCONVOLUTION_NUMERO_DU_N_IEME_POINT_DE_MEME_NIVEAU); \ /* Numero du point de 'imageA2' sur la spirale courante possedant le meme niveau que le */ \ /* centre sur 'imageA1' (cette valeur initiale correspond au cas ou ce numero n'a pu etre */ \ /* trouve, aucun point n'ayant le niveau recherche...). */ \ \ Test(IL_FAUT(Pconvolution_____calculer___le_Laplacien_generalise)) \ Bblock \ EGAL(Pconvolution_____valeur_du_Laplacien_generalise \ ,COND(IL_FAUT(Pconvolution_____soustraire_le_Laplacien_generalise) \ ,niveau_du_centre_de_la_spirale \ ,FZERO \ ) \ ); \ /* Initialisation de la valeur du Laplacien generalise... */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ Test(IL_FAUT(Pconvolution_____calculer_l_histogramme_des_niveaux)) \ Bblock \ CLIR(Pconvolution_____nombre_de_points_de_l_histogramme_des_niveaux); \ /* Initialisation du nombre de points pris en compte dans l'histogramme courant... */ \ \ BoIn(niveau,NOIR,BLANC,PAS_COULEURS) \ Bblock \ CLIR(ITb1(Pconvolution_____histogramme_des_niveaux,INDX(niveau,NOIR))); \ /* Initialisation de l'histogramme des niveaux des points du voisinage, lorsque celui-ci */ \ /* est utile... */ \ Eblock \ EBoI \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ Test(IL_NE_FAUT_PAS(Pconvolution_____recherche_d_une_forme_sur_la_spirale)) \ Bblock \ Eblock \ ATes \ Bblock \ EGAL(Pconvolution_____nombre_courant_lors_de_la_recherche_d_une_forme_sur_la_spirale,ZERO); \ /* Nombre d'elements non nuls lors du parcours de la spirale. */ \ EGAL(Pconvolution_____nombre_des_ponderations_lors_de_la_recherche_d_une_forme_sur_la_spirale,ZERO); \ /* Nombre de coefficients de ponderation non nuls pour les points reellement traites. */ \ \ EGAL(Pconvolution_____cumul_courant_lors_de_la_recherche_d_une_forme_sur_la_spirale,FZERO); \ /* Cumul courant lors du parcours de la spirale. */ \ EGAL(Pconvolution_____cumul_des_ponderations_lors_de_la_recherche_d_une_forme_sur_la_spirale,FZERO); \ /* Cumul des coefficients de ponderation pour les points reellement traites. */ \ \ EGAL(Pconvolution_____produit_courant_lors_de_la_recherche_d_une_forme_sur_la_spirale,FU); \ /* Produit courant des elements non nuls lors du parcours de la spirale. */ \ EGAL(Pconvolution_____produit_des_ponderations_lors_de_la_recherche_d_une_forme_sur_la_spirale,FU); \ /* Produit des coefficients de ponderation non nuls pour les points reellement traites. */ \ \ EGAL(Pconvolution_____la_forme_cherchee_a_ete_trouvee_sur_la_spirale,VRAI); \ /* L'indicateur de retour est mis a 'VRAI' a priori (ce qui en soit est assez exceptionnel, */ \ /* puisqu'en general, c'est une valeur 'FAUX' qui est utilisee dans ce type de situation, */ \ /* mais ici, la seule valeur que l'on puisse forcer ensuite est 'FAUX' afin que la valeur */ \ /* 'FAUX' soit renvoyee des qu'un point au moins est diferrent de la forme recherchee...). */ \ /* L'indicateur local 'on_a_teste_au_moins_un_point_de_la_forme_cherchee' permet de corriger */ \ /* cette initialisation si elle etait incompatible avec l'execution a suivre (par exemple */ \ /* le cas ou aucun point n'a ete traite...). */ \ EGAL(cumul_courant_normalise_apres_transfert,FZERO); \ /* Uniquement pour ne pas renvoyer n'importe quoi... */ \ Eblock \ ETes \ \ EGAL(numero_courant_de_point,PREMIER_POINT); \ /* Initialisation du parcours de la spirale de convolution... */ \ \ Test(IL_NE_FAUT_PAS(Pconvolution_____parcourir_circulairement_les_spirales_carrees)) \ Bblock \ SPIRALE_VALIDATION; \ /* Validation des pas de parcours (pasX,pasY) des images. */ \ \ EGAL(X_courant,X_du_centre_de_la_spirale); \ EGAL(Y_courant,Y_du_centre_de_la_spirale); \ /* Initialisation du point courant de la spirale sur son centre... */ \ Eblock \ ATes \ Bblock \ Test(IL_FAUT(Pconvolution_____adapter_le_nombre_de_points_lors_du_parcours_circulaire_des_spirales_carrees)) \ Bblock \ EGAL(npn_effectif \ ,NOMBRE_DE_POINTS_EFFECTIF_D_UN_NOYAU_DE_CONVOLUTION_PARCOURU_CIRCULAIREMENT(npn) \ ); \ /* Positionnement sur le carre d'un nombre impair multiplie par pi/4 immediatement */ \ /* superieur (possibilite introduite le 20061224110500 et mise sous la forme d'un */ \ /* appel procedural le 20070104110240...). */ \ /* */ \ /* Le 20230407133928 je note que c'est cette adaptation de 'npn' qui a rendu impossible a */ \ /* cette date de recalculer 'v $xiia/VORO.11'. La seule solution simple semble etre celle */ \ /* qui inhibe cette adaptation via 'v $xci/distance.02$K 20230407135543'. On notera au */ \ /* passage que dans le cas de 'v $xiia/$Fnota Debut_listG_VORO_11', on a : */ \ /* */ \ /* npn=$tailleI (via "points=$tailleI") */ \ /* */ \ /* et qu'alors, l'operation precedente donne un 'npn_effectif' superieur a la taille de */ \ /* l'image et donc un numero de point 'PCONVOLUTION_NUMERO_DU_N_IEME_POINT_DE_MEME_NIVEAU' */ \ /* inexistant. Les tests comparant 'Pconvolution_____numero_du_n_ieme_point_de_meme_niveau' */ \ /* et 'PCONVOLUTION_NUMERO_DU_N_IEME_POINT_DE_MEME_NIVEAU' etaient donc alors toujours */ \ /* FAUX et ainsi les coordonnees 'Pconvolution_____X_du_n_ieme_point_de_meme_niveau' et */ \ /* 'Pconvolution_____Y_du_n_ieme_point_de_meme_niveau' restaient irremediablement a 'UNDEF'. */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ SPIRALE_CIRCULAIRE_VALIDATION(Pconvolution_____nombre_de_points_sautes); \ /* Validation des pas de parcours (pasX,pasY) des images. */ \ \ EGAL(valeur_maximale_de_X_et_de_Y_relatifs,COOA(MOIT(INTE(RACX(npn_effectif))),CHOI(Xmin,Ymin))); \ /* Calcul de la valeur maximale commune a 'X' et a 'Y' (relativement a une origine qui est */ \ /* le centre de la spirale courante...). */ \ Test(IFLT(DERNIER_POINT_D_UNE_SPIRALE_CIRCULAIRE(valeur_maximale_de_X_et_de_Y_relatifs),npn_effectif)) \ Bblock \ INCR(valeur_maximale_de_X_et_de_Y_relatifs,CHOI(PasX,PasY)); \ /* Correction par exces lorsque cela ne tombe pas juste... */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ SPIRALE_CIRCULAIRE_DEPLACEMENT_ET_PARCOURS(X_courant,Y_courant \ ,X_du_centre_de_la_spirale,Y_du_centre_de_la_spirale \ ,numero_courant_de_point \ ,valeur_maximale_de_X_et_de_Y_relatifs \ ,INITIALISER_UNE_SPIRALE_CIRCULAIRE \ ,NE_PAS_DESINITIALISER_UNE_SPIRALE_CIRCULAIRE \ ); \ /* Initialisation du processus et du point courant de la spirale sur son centre... */ \ \ Test(IL_FAUT(Pconvolution_____compatibilite_20141124)) \ /* Test introduit le 20141124184541... */ \ Bblock \ /* Dans ce cas, il y a plus de points utilises que de points definis sur la spirale. La */ \ /* consequence est qu'alors le centre de la spirale (c'est-a-dire {Xmin,Ymin} en relatif) */ \ /* est utilise plusieurs fois ; il remplace alors les points manquants... */ \ Eblock \ ATes \ Bblock \ Test(IL_FAUT(Pconvolution_____adapter_le_nombre_de_points_lors_du_parcours_circulaire_des_spirales_carrees)) \ Bblock \ EGAL(npn_effectif,Fparcours_circulaire_d_une_spirale_carree_____numero_du_dernier_point); \ /* Et on corrige 'npn_effectif' grace a la valeur determinee par */ \ /* 'v $xiipf/fonction.3$FON 20141124184050'... */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ ETes \ Eblock \ ETes \ \ Test(IFEXff(npn_effectif,UN,TAILLE_MAXIMALE_D_UN_NOYAU_DE_CONVOLUTION)) \ Bblock \ PRINT_ERREUR("le nombre de points du noyau de convolution est negatif ou nul"); \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ Test(IFLT(Pconvolution_____rang_du_n_ieme_point_de_meme_niveau,PCONVOLUTION_RANG_DU_N_IEME_POINT_DE_MEME_NIVEAU)) \ Bblock \ PRINT_ERREUR("le rang du n-ieme point recherche est mauvais"); \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ Tant(IL_FAUT(parcourir_la_spirale)) \ /* ATTENTION, jusqu'au 19960930102717, il y avait ici : */ \ /* */ \ /* DoIn(numero_courant_de_point */ \ /* ,PREMIER_POINT */ \ /* ,LSTX(PREMIER_POINT,npn) */ \ /* ,I */ \ /* ) */ \ /* */ \ /* mais afin d'introduire l'interruptibilite du parcours de la spirale, un 'Tant(...)' */ \ /* a ete mis a la place du 'DoIn(...)'. */ \ Bblock \ DEFV(Int,INIT(X_courant_effectif,X_courant)); \ DEFV(Int,INIT(Y_courant_effectif,Y_courant)); \ /* Definition du point courant "effectif" de la spirale... */ \ \ DEFV(type_point,INIT(niveau_courant,NIVEAU_UNDEF)); \ /* Niveau au point {X_courant_effectif,Y_courant_effectif}... */ \ \ Test(IL_FAUT(Pconvolution_____disperser_le_noyau_de_convolution)) \ /* La "dispersion" a ete introduite le 20201002104235... */ \ Bblock \ DEFV(Int,INIT(X_relative,COOR(X_courant,X_du_centre_de_la_spirale))); \ DEFV(Int,INIT(Y_relative,COOR(Y_courant,Y_du_centre_de_la_spirale))); \ DEFV(Int,INIT(X_relative_dispersee,UNDEF)); \ DEFV(Int,INIT(Y_relative_dispersee,UNDEF)); \ \ EGAL(X_relative_dispersee \ ,HORNER_2_02(X_relative \ ,Y_relative \ ,Pconvolution_____disperser_le_noyau_de_convolution_X_a22 \ ,Pconvolution_____disperser_le_noyau_de_convolution_X_a21 \ ,Pconvolution_____disperser_le_noyau_de_convolution_X_a20 \ ,Pconvolution_____disperser_le_noyau_de_convolution_X_a12 \ ,Pconvolution_____disperser_le_noyau_de_convolution_X_a11 \ ,Pconvolution_____disperser_le_noyau_de_convolution_X_a10 \ ,Pconvolution_____disperser_le_noyau_de_convolution_X_a02 \ ,Pconvolution_____disperser_le_noyau_de_convolution_X_a01 \ ,Pconvolution_____disperser_le_noyau_de_convolution_X_a00 \ ) \ ); \ EGAL(Y_relative_dispersee \ ,HORNER_2_02(X_relative \ ,Y_relative \ ,Pconvolution_____disperser_le_noyau_de_convolution_Y_a22 \ ,Pconvolution_____disperser_le_noyau_de_convolution_Y_a21 \ ,Pconvolution_____disperser_le_noyau_de_convolution_Y_a20 \ ,Pconvolution_____disperser_le_noyau_de_convolution_Y_a12 \ ,Pconvolution_____disperser_le_noyau_de_convolution_Y_a11 \ ,Pconvolution_____disperser_le_noyau_de_convolution_Y_a10 \ ,Pconvolution_____disperser_le_noyau_de_convolution_Y_a02 \ ,Pconvolution_____disperser_le_noyau_de_convolution_Y_a01 \ ,Pconvolution_____disperser_le_noyau_de_convolution_Y_a00 \ ) \ ); \ \ EGAL(X_courant_effectif,COOA(X_du_centre_de_la_spirale,X_relative_dispersee)); \ EGAL(Y_courant_effectif,COOA(Y_du_centre_de_la_spirale,Y_relative_dispersee)); \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ EGAL(niveau_courant \ ,COND(EST_VRAI(Pconvolution_____placer_l_image_sur_un_tore) \ ,fonction_load_modulo(i2,X_courant_effectif,Y_courant_effectif) \ ,fonction_load(i2,X_courant_effectif,Y_courant_effectif) \ ) \ ); \ /* Niveau courant sur la spirale (mis ici le 20070209090906 alors qu'avant cette date, il */ \ /* etait defini deux fois : une premiere fois apres le 'Test(...)' relatif a l'indicateur */ \ /* 'Pconvolution_____recherche_d_une_forme_sur_la_spirale' et une deuxieme fois apres le */ \ /* 'ATes' correspondant... */ \ \ /* ATTENTION : avant le 20210309134411, c'etait ici que se trouvait la sequence d'edition */ \ /* du noyau de convolution controle par 'Pconvolution_____editer_le_noyau_de_convolution'... */ \ \ Test(IL_FAUT(Pconvolution_____calculer___le_Laplacien_generalise)) \ Bblock \ INCR(Pconvolution_____valeur_du_Laplacien_generalise \ ,MUL3(COND(IL_FAUT(Pconvolution_____soustraire_le_Laplacien_generalise) \ ,NEGA(FU) \ ,NEUT(FU) \ ) \ ,ITb0(n,INDX(numero_courant_de_point,PREMIER_POINT)) \ ,SOUS(niveau_courant,niveau_du_centre_de_la_spirale) \ ) \ ); \ /* Calcul introduit le 20210225113338... */ \ /* */ \ /* On notera le 20210302144057 que dans le cas ou l'on est au centre de la spirale, on a */ \ /* evidemment : */ \ /* */ \ /* niveau_courant = niveau_du_centre_de_la_spirale */ \ /* */ \ /* et ainsi, le point courant ne joue aucun role dans ce cumul et ce quel que soit la */ \ /* valeur au centre du noyau. C'est pourquoi on a interet a donner une valeur non nulle au */ \ /* centre du noyau afin d'eviter le message "la somme des elements du noyau est nul" un peu */ \ /* plus loin au cas ou ('v $xci/nettete.01$K 20210302143425')... */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ Test(IL_FAUT(Pconvolution_____calculer_l_histogramme_des_niveaux)) \ Bblock \ Test(IZNE(ITb0(n,INDX(numero_courant_de_point,PREMIER_POINT)))) \ /* L'histogramme n'est evalue que aux emplacements non nuls du noyau (introduit le */ \ /* 20070209105114)... */ \ Bblock \ INCR(Pconvolution_____nombre_de_points_de_l_histogramme_des_niveaux,I); \ /* Comptage du nombre de points pris en compte dans l'histogramme courant... */ \ \ INCR(ITb1(Pconvolution_____histogramme_des_niveaux,INDX(niveau_courant,NOIR)),I); \ /* Calcul de l'histogramme des niveaux des points du voisinage, lorsque celui-ci est */ \ /* utile (ceci fut introduit le 20070209090906). */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ Test(IL_NE_FAUT_PAS(Pconvolution_____recherche_d_une_forme_sur_la_spirale)) \ Bblock \ DEFV(Float,INIT(ponderation_locale,ITb0(n,INDX(numero_courant_de_point,PREMIER_POINT)))); \ /* Definition de la ponderation locale en faisant l'hypothese que l'on va faire une */ \ /* convolution "normale" et non point calculer l'inertie locale... */ \ \ Test(IL_FAUT(Pconvolution_____calculer_l_inertie)) \ Bblock \ EGAL(ponderation_locale \ ,MUL2(ponderation_locale \ ,LIN3(Pconvolution_____coefficient_de_Ixx \ ,EXP2(SOUS(COORDONNEE_D_INERTIE_Y(Y_courant),COORDONNEE_D_INERTIE_Y(Y_du_centre_de_la_spirale))) \ ,Pconvolution_____coefficient_de_Ixyx \ ,MUL2(SOUS(COORDONNEE_D_INERTIE_X(X_courant),COORDONNEE_D_INERTIE_X(X_du_centre_de_la_spirale)) \ ,SOUS(COORDONNEE_D_INERTIE_Y(Y_courant),COORDONNEE_D_INERTIE_Y(Y_du_centre_de_la_spirale)) \ ) \ ,Pconvolution_____coefficient_de_Iyy \ ,EXP2(SOUS(COORDONNEE_D_INERTIE_X(X_courant),COORDONNEE_D_INERTIE_X(X_du_centre_de_la_spirale))) \ ,Pconvolution_____translation_des_I \ ) \ ) \ ); \ /* Lorsque le calcul de l'inertie est demandee, la 'ponderation_locale' est "completee" par */ \ /* l'expression : */ \ /* */ \ /* 2 2 */ \ /* alpha.Y + beta.X.Y + gamma.X + delta */ \ /* */ \ /* qui permettra, apres multiplication par le niveau au point {X,Y}, d'avoir, suivant la */ \ /* valeur de (alpha,beta,gamma,delta), les quatre moments d'inertie : */ \ /* */ \ /* (alpha,beta,gamma,delta) = (1,0,0,0) ==> Ixx */ \ /* (alpha,beta,gamma,delta) = (0,1,0,0) ==> Ixy = Iyx */ \ /* (alpha,beta,gamma,delta) = (0,0,1,0) ==> Iyy */ \ /* */ \ /* a partir desquels on pourra, par exemple, calculer les directions propres locales... */ \ /* */ \ /* ATTENTION, on notera que la somme : */ \ /* */ \ /* 2 2 */ \ /* alpha.Y + beta.X.Y + gamma.X + delta */ \ /* */ \ /* est nulle si le nombre de points de la spirale est un carre. Dans ces conditions, */ \ /* l'utilisation de ce mode exige : */ \ /* */ \ /* Pconvolution_____normaliser_le_cumul_pondere=FAUX */ \ /* */ \ /* car sinon, 'Pconvolution(...)' renverra 'AUCUN_POINT_TRAITE_DANS_LE_NOYAU'... */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ Test(IL_FAUT(Pconvolution_____normaliser_le_cumul_pondere)) \ Bblock \ INCR(cumul_de_l_ensemble_des_ponderations \ ,ponderation_locale \ ); \ /* On cumule l'ensemble des ponderations lorsque la normalisation du cumul courant est */ \ /* demandee, et ce afin de valider le noyau... */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ INCR(Pconvolution_____nombre_reel_de_points__DANS_L_IMAGE,COND(TEST_DANS_L_IMAGE(X_courant,Y_courant),I,ZERO)); \ INCR(Pconvolution_____nombre_reel_de_points__HORS_IMAGE__,COND(TEST_HORS_IMAGE(X_courant,Y_courant),I,ZERO)); \ /* Comptages introduits le 20231031084321... */ \ \ Test(IFET(IFOU(EST_VRAI(Pconvolution_____placer_l_image_sur_un_tore) \ ,IFET(EST_FAUX(Pconvolution_____placer_l_image_sur_un_tore),TEST_DANS_L_IMAGE(X_courant,Y_courant)) \ ) \ ,EST_ACTIF(ITb0(in,INDX(numero_courant_de_point,PREMIER_POINT))) \ ) \ ) \ Bblock \ DEFV(Logical,INIT(le_niveau_courant_est_cumulable,LUNDEF)); \ /* Afin de savoir si 'niveau_courant' est cumulable. Cet indicateur a ete introduit */ \ /* le 20020703153110. */ \ \ Test(IFOU(IL_FAUT(Pconvolution_____tester_le_niveau_du_centre_de_la_spirale) \ ,IFGT(numero_courant_de_point,PREMIER_POINT) \ ) \ ) \ Bblock \ /* Pour sauter le premier point evidemment... */ \ Test(IFOU(IFET(IL_NE_FAUT_PAS(Pconvolution_____remplacer__meme_niveau__par__niveau_different) \ ,IFEQ(niveau_courant,niveau_du_centre_de_la_spirale) \ ) \ ,IFET(IL_FAUT(Pconvolution_____remplacer__meme_niveau__par__niveau_different) \ ,IFNE(niveau_courant,niveau_du_centre_de_la_spirale) \ ) \ ) \ ) \ Bblock \ Test(IFEQ(Pconvolution_____numero_du_n_ieme_point_de_meme_niveau \ ,PCONVOLUTION_NUMERO_DU_N_IEME_POINT_DE_MEME_NIVEAU \ ) \ ) \ /* Afin de ne prendre que le premier point... */ \ Bblock \ INCR(rang_courant_du_n_ieme_point_de_meme_niveau,I); \ /* Rang courant du point de meme niveau que le centre de la spirale... */ \ \ Test(IFEQ(rang_courant_du_n_ieme_point_de_meme_niveau \ ,Pconvolution_____rang_du_n_ieme_point_de_meme_niveau \ ) \ ) \ Bblock \ /* Cas ou l'on a atteint le "n-ieme" point de meme niveau que le centre de la spirale : */ \ \ /* ATTENTION : si 'IL_FAUT(Pconvolution_____remplacer__meme_niveau__par__niveau_different)' */ \ /* il faudrait en toute logique remplacer ci-dessous dans les noms de variable */ \ /* "de_meme_niveau" par "de_niveau_different", mais cela est evidemment impossible */ \ /* puisqu'il s'agit encore une fois de noms de variables... */ \ \ EGAL(Pconvolution_____numero_du_n_ieme_point_de_meme_niveau,numero_courant_de_point); \ /* Numero du point de 'imageA2' sur la spirale courante possedant le meme niveau que le */ \ /* centre sur 'imageA1'. */ \ EGAL(Pconvolution_____X_du_n_ieme_point_de_meme_niveau,X_courant); \ EGAL(Pconvolution_____Y_du_n_ieme_point_de_meme_niveau,Y_courant); \ /* Et memorisation de ses coordonnees... */ \ EGAL(Pconvolution_____niveau_du_n_ieme_point_de_meme_niveau \ ,niveau_courant \ ); \ /* Et memorisation de son niveau (introduit le 20060125102933)... */ \ \ /* ATTENTION : si 'IL_FAUT(Pconvolution_____remplacer__meme_niveau__par__niveau_different)' */ \ /* il faudrait en toute logique remplacer ci-dessous dans les noms de variable */ \ /* "de_meme_niveau" par "de_niveau_different", mais cela est evidemment impossible */ \ /* puisqu'il s'agit encore une fois de noms de variables... */ \ \ Test(EST_VRAI(Pconvolution_____la_spirale_est_interruptible)) \ Bblock \ EGAL(parcourir_la_spirale,FAUX); \ /* Afin d'interrompre prematurement le parcours de la spirale... */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ ATes \ Bblock \ /* Cas ou l'on n'a pas encore atteint le "n-ieme" point de meme niveau que le centre de la */ \ /* spirale : on attend... */ \ Eblock \ ETes \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ Test(EST_FAUX(les_images_i1_et_i2_sont_standards)) \ /* Le test relatif a 'IDENTITE(nc)' a ete introduit le 20010212145101 afin de permettre */ \ /* de ne pas tester un element du vecteur 'DEFV(Logical,DTb1(nc,COULEURS))' qui n'a pas */ \ /* de sens lorsque 'type_point' est du type 'genere_Float'. Dans ce cas, le vecteur 'nc' */ \ /* doit etre 'ADRESSE_NON_DEFINIE'... */ \ Bblock \ EGAL(le_niveau_courant_est_cumulable,VRAI); \ /* Dans le cas 'genere_Float', les niveaux sont tous cumulables puisqu'il est impossible */ \ /* de construire une liste 'nc' indexee par 'niveau_courant'. */ \ Eblock \ ATes \ Bblock \ Test(EST_VRAI(ITb1(nc,INDX(niveau_courant,NOIR)))) \ /* Dans le cas 'genere_p', la une liste 'nc' indexee par 'niveau_courant' existe... */ \ /* */ \ /* Avant le 20020703143629, ce test etait regroupe avec le precedent via un 'IFOU(...)'. */ \ /* Mais ce code ne garantissait finalement pas l'ordre des tests effectues et il n'etait */ \ /* pas impossible que le 'ITb1(nc,INDX(niveau_courant,NOIR)' soit accede malgre tout (d'ou */ \ /* un "Segmentation fault" possible) meme lorsque la liste 'nc' n'avait pas de sens... */ \ Bblock \ EGAL(le_niveau_courant_est_cumulable,VRAI); \ Eblock \ ATes \ Bblock \ EGAL(le_niveau_courant_est_cumulable,FAUX); \ Eblock \ ETes \ Eblock \ ETes \ \ Test(EST_VRAI(le_niveau_courant_est_cumulable)) \ Bblock \ /* Traitement des points qui sont cumulables... */ \ INCR(Pconvolution_____nombre_reel_de_points,I); \ /* On compte les points traites. */ \ INCR(Pconvolution_____cumul_des_ponderations \ ,ponderation_locale \ ); \ /* On cumule les ponderations reellement utilisees, */ \ INCR(Pconvolution_____cumul_courant \ ,MUL2(ponderation_locale \ ,FLOT(NIVR(niveau_courant)) \ ) \ ); \ /* Et on cumule en ponderant... */ \ /* */ \ /* ATTENTION : on notera la presence de 'load_point(...)' et non de 'load_point_valide(...)' */ \ /* ce qui n'est pas dangereux puisque l'on est a l'interieur d'un 'TEST_DANS_L_IMAGE(...)'. */ \ \ Test(EST_VRAI(le_niveau_precedent_existe)) \ Bblock \ INCR(Pconvolution_____dispersion_des_niveaux_sur_la_spirale \ ,SOUA(FLOT(NIVR(niveau_courant)),FLOT(NIVR(niveau_precedent))) \ ); \ /* Mise a jour de la dispersion des niveaux sur la spirale (introduite le 20151105103406). */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ Test(IFOU(IL_FAUT(Pconvolution_____utiliser_le_premier_point_pour_la_recherche_des_extrema) \ ,IFET(IL_NE_FAUT_PAS(Pconvolution_____utiliser_le_premier_point_pour_la_recherche_des_extrema) \ ,IFGT(Pconvolution_____nombre_reel_de_points,UN) \ ) \ ) \ ) \ Bblock \ INCR(Pconvolution_____moyenne_sur_la_spirale \ ,FLOT(NIVR(niveau_courant)) \ ); \ /* Calcul de la moyenne (sans ponderer)... */ \ EGAL(Pconvolution_____minimum_sur_la_spirale \ ,MIN2(Pconvolution_____minimum_sur_la_spirale,FLOT(niveau_courant)) \ ); \ EGAL(Pconvolution_____maximum_sur_la_spirale \ ,MAX2(Pconvolution_____maximum_sur_la_spirale,FLOT(niveau_courant)) \ ); \ /* Extrema des niveaux rencontres sur la spirale courante. */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ ATes \ Bblock \ Test(EST_ACTIF(ITb0(in,INDX(numero_courant_de_point,PREMIER_POINT)))) \ Bblock \ DEFV(Float,INIT(valeur_courante_de_la_forme \ ,ITb0(n,INDX(numero_courant_de_point,PREMIER_POINT)) \ ) \ ); \ DEFV(type_point,INIT(point_courant_de_la_forme,CAST(type_point,NIVEAU_UNDEF))); \ EGAL(point_courant_de_la_forme,CAST(type_point,valeur_courante_de_la_forme)); \ /* Definition du point courant de la forme... */ \ \ Test(IFNE(valeur_courante_de_la_forme,FLOT(point_courant_de_la_forme))) \ Bblock \ PRINT_ERREUR("la forme recherchee contient des valeurs non entieres"); \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ INCR(Pconvolution_____nombre_reel_de_points,I); \ /* On compte les points traites (introduit le 20030120161237). */ \ \ INCR(Pconvolution_____cumul_des_ponderations_lors_de_la_recherche_d_une_forme_sur_la_spirale \ ,valeur_courante_de_la_forme \ ); \ INCR(Pconvolution_____cumul_courant_lors_de_la_recherche_d_une_forme_sur_la_spirale \ ,FLOT(niveau_courant) \ ); \ /* 'Pconvolution_____cumul_des_ponderations_lors_de_la_recherche_d_une_forme_sur_la_spirale' */ \ /* donnera le cumul des points de la forme cherchee, quant a */ \ /* 'Pconvolution_____cumul_courant_lors_de_la_recherche_d_une_forme_sur_la_spirale', il */ \ /* donnera le cumul des niveaux rencontres. Evidemment, */ \ /* si 'EST_VRAI(Pconvolution_____la_forme_cherchee_a_ete_trouvee_sur_la_spirale)' ces deux */ \ /* quantites seront egales si de plus 'valeur_courante_de_la_forme' est systematiquement */ \ /* une valeur entiere. Ceci a ete introduit le 20030120161237 pour d'eventuelles */ \ /* ameliorations a venir (certaines furent introduites le 20030120163418). */ \ \ Test(IZNE(valeur_courante_de_la_forme)) \ Bblock \ INCR(Pconvolution_____nombre_des_ponderations_lors_de_la_recherche_d_une_forme_sur_la_spirale,I); \ /* Introduit le 20030126120532 pour rendre plus "precis" les tests lors de SUBSTITUTION */ \ /* dans la fonction 'Iautomate_cellulaire_bidimensionnel_par_convolution(...)'. */ \ EGAL(Pconvolution_____produit_des_ponderations_lors_de_la_recherche_d_une_forme_sur_la_spirale \ ,MUL2(Pconvolution_____produit_des_ponderations_lors_de_la_recherche_d_une_forme_sur_la_spirale \ ,valeur_courante_de_la_forme \ ) \ ); \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ Test(IZNE(FLOT(niveau_courant))) \ Bblock \ INCR(Pconvolution_____nombre_courant_lors_de_la_recherche_d_une_forme_sur_la_spirale,I); \ /* Introduit le 20030126120532 pour rendre plus "precis" les tests lors de SUBSTITUTION */ \ /* dans la fonction 'Iautomate_cellulaire_bidimensionnel_par_convolution(...)'. */ \ EGAL(Pconvolution_____produit_courant_lors_de_la_recherche_d_une_forme_sur_la_spirale \ ,MUL2(Pconvolution_____produit_courant_lors_de_la_recherche_d_une_forme_sur_la_spirale \ ,FLOT(niveau_courant) \ ) \ ); \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ EGAL(on_a_teste_au_moins_un_point_de_la_forme_cherchee,VRAI); \ /* Ainsi, on sait qu'au moins un point a ete teste... */ \ \ Test(IFNE(niveau_courant,point_courant_de_la_forme)) \ Bblock \ EGAL(Pconvolution_____la_forme_cherchee_a_ete_trouvee_sur_la_spirale,FAUX); \ /* Ainsi, a la moindre difference entre la spirale et la forme recherchee (contenue donc */ \ /* dans 'n'), la valeur remanente 'FAUX' est renvoyee... */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ ETes \ \ Test(IL_FAUT(parcourir_la_spirale)) \ Bblock \ Test(IFLT(numero_courant_de_point,LSTX(PREMIER_POINT,npn_effectif))) \ Bblock \ /* Il reste des points... */ \ DEFV(Int,INIT(numero_precedent_de_point,numero_courant_de_point)); \ DEFV(Int,INIT(X_precedent,X_courant)); \ DEFV(Int,INIT(Y_precedent,Y_courant)); \ /* Introduit le 20210309134411 pour l'eventuelle edition du noyau... */ \ \ INCR(numero_courant_de_point,I); \ /* Progression sur la spirale. */ \ \ Test(IL_NE_FAUT_PAS(Pconvolution_____parcourir_circulairement_les_spirales_carrees)) \ Bblock \ SPIRALE_DEPLACEMENT_ET_PARCOURS(X_courant,Y_courant \ ,Pconvolution_____nombre_de_points_sautes \ ); \ /* Deplacement du point courant de la spirale carree... */ \ Eblock \ ATes \ Bblock \ SPIRALE_CIRCULAIRE_DEPLACEMENT_ET_PARCOURS(X_courant,Y_courant \ ,X_du_centre_de_la_spirale,Y_du_centre_de_la_spirale \ ,numero_courant_de_point \ ,valeur_maximale_de_X_et_de_Y_relatifs \ ,NE_PAS_INITIALISER_UNE_SPIRALE_CIRCULAIRE \ ,NE_PAS_DESINITIALISER_UNE_SPIRALE_CIRCULAIRE \ ); \ /* Deplacement du point courant de la spirale circulaire... */ \ Eblock \ ETes \ \ EDITION_CONDITIONNELLE_DU_NOYAU_DE_CONVOLUTION(X_precedent,Y_precedent,numero_precedent_de_point); \ /* Mis sous cette forme le 20210315105035... */ \ Eblock \ ATes \ Bblock \ EGAL(parcourir_la_spirale,FAUX); \ /* On a fini de parcourir la spirale... */ \ Eblock \ ETes \ Eblock \ ATes \ Bblock \ /* Cas ou le parcours a ete interrompu prematurement... */ \ Eblock \ ETes \ \ EGAL(niveau_precedent,niveau_courant); \ EGAL(le_niveau_precedent_existe,VRAI); \ /* Introduit le 20151105103406... */ \ Eblock \ ETan \ \ Test(IFEQ(npn_effectif,UN)) \ Bblock \ EDITION_CONDITIONNELLE_DU_NOYAU_DE_CONVOLUTION(UNDEF,UNDEF,POINT_INEXISTANT); \ /* Introduit le 20210315105035 pour pouvoir editer les noyaux n'ayant qu'un seul point. */ \ /* On notera le 'PRED(PREMIER_POINT)' qui signifie qu'il n'y a pas de point precedent... */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ Test(IL_NE_FAUT_PAS(Pconvolution_____recherche_d_une_forme_sur_la_spirale)) \ Bblock \ Test(IFEQ(Pconvolution_____numero_du_n_ieme_point_de_meme_niveau \ ,PCONVOLUTION_NUMERO_DU_N_IEME_POINT_DE_MEME_NIVEAU \ ) \ ) \ /* Cas ou l'on n'a pas rencontre de points ayant le meme niveau que le centre de la spirale. */ \ Bblock \ EGAL(Pconvolution_____X_du_n_ieme_point_de_meme_niveau,X_courant); \ EGAL(Pconvolution_____Y_du_n_ieme_point_de_meme_niveau,Y_courant); \ /* On force alors le point courant (en fait je ne sais pas quoi faire d'autre ; toute */ \ /* autre valeur -'UNDEF', 'ZERO', 'INFINI',...- etant aussi arbitraire...). Au passage la */ \ /* valeur {X_courant,Y_courant} correspond malgre tout a une sorte d'infini (relativement */ \ /* a 'nombre_de_points_du_noyau'. */ \ Eblock \ ATes \ Bblock \ /* Cas ou l'on a rencontre un point ayant le meme niveau que le centre de la spirale... */ \ Eblock \ ETes \ \ Test(IL_FAUT(Pconvolution_____normaliser_le_cumul_pondere)) \ Bblock \ Test(IZEQ(cumul_de_l_ensemble_des_ponderations)) \ Bblock \ PRINT_ERREUR("la somme des elements du noyau est nul"); \ CAL1(Prer1("(faire 'Pconvolution_____normaliser_le_cumul_pondere=%s')",C_FAUX____)); \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ EGAL(cumul_courant_normalise_avant_transfert \ ,COND(IFET(IZGT(Pconvolution_____nombre_reel_de_points) \ ,IZNE(Pconvolution_____cumul_des_ponderations) \ ) \ ,VDIV(Pconvolution_____cumul_courant \ ,COND(EST_VRAI(Pconvolution_____normaliser_uniquement_avec_les_ponderations_utilisees) \ ,Pconvolution_____cumul_des_ponderations \ ,cumul_de_l_ensemble_des_ponderations \ ) \ ) \ ,AUCUN_POINT_TRAITE_DANS_LE_NOYAU \ ) \ ); \ /* Cumul courant normalise avant l'application de la fonction de transfert... */ \ \ Test(IFNE(Pconvolution_____exposant_de_la_fonction_de_transfert \ ,EXPOSANT_DE_LA_FONCTION_DE_TRANSFERT_UNITE_APRES_CONVOLUTION \ ) \ ) \ Bblock \ EGAL(cumul_courant_normalise_apres_transfert \ ,COND(EST_VRAI(les_images_i1_et_i2_sont_standards) \ ,F___DENORMALISE_NIVEAU(PUIX(______NORMALISE_NIVEAU(cumul_courant_normalise_avant_transfert) \ ,Pconvolution_____exposant_de_la_fonction_de_transfert \ ) \ ) \ ,PUIX(cumul_courant_normalise_avant_transfert \ ,Pconvolution_____exposant_de_la_fonction_de_transfert \ ) \ ) \ ); \ /* Cas d'une fonction de transfert quelconque. ATTENTION, cette methode a malheureusement */ \ /* des effets pervers : par exemple, la convolution "unite" (ne portant que sur un seul */ \ /* point) qui devrait laisser inchangee les niveaux, les modifie lorsque le parametre */ \ /* 'Pconvolution_____exposant_de_la_fonction_de_transfert' n'est pas egal a 1 ; cela fait */ \ /* donc perdre du contraste aux images... */ \ /* */ \ /* ATTENTION : avant le 20020703153110 les images de type 'imageF' subissaient elles-aussi */ \ /* les effets de '______NORMALISE_NIVEAU(...)' et 'F___DENORMALISE_NIVEAU(...)', mais cela */ \ /* n'etait pas logique et a ete corrige... */ \ Eblock \ ATes \ Bblock \ EGAL(cumul_courant_normalise_apres_transfert,cumul_courant_normalise_avant_transfert); \ /* Cas d'une fonction de transfert "unite"... */ \ Eblock \ ETes \ Eblock \ ATes \ Bblock \ EGAL(cumul_courant_normalise_apres_transfert,Pconvolution_____cumul_courant); \ /* Cas ou la normalisation du resultat n'est pas demandee... */ \ Eblock \ ETes \ \ Test(IFET(IL_FAUT(Pconvolution_____conserver_le_niveau_du_centre_de_la_spirale_s_il_est_le_minimum) \ ,IL_FAUT(Pconvolution_____conserver_le_niveau_du_centre_de_la_spirale_s_il_est_le_maximum) \ ) \ ) \ Bblock \ PRINT_ATTENTION("il est impossible de conserver le minimum et le maximum simultanement : le maximum l'emporte"); \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ Test(IFET(IL_FAUT(Pconvolution_____conserver_le_niveau_du_centre_de_la_spirale_s_il_est_le_minimum) \ ,IFEQ(niveau_du_centre_de_la_spirale,Pconvolution_____minimum_sur_la_spirale) \ ) \ ) \ Bblock \ EGAL(cumul_courant_normalise_apres_transfert,niveau_du_centre_de_la_spirale); \ /* La possibilite de conserver le niveau courant (celui du point courant {X,Y}) s'il */ \ /* est egal au maximum rencontre sur la spirale a ete introduite le 20130630183754... */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ Test(IFET(IL_FAUT(Pconvolution_____conserver_le_niveau_du_centre_de_la_spirale_s_il_est_le_maximum) \ ,IFEQ(niveau_du_centre_de_la_spirale,Pconvolution_____maximum_sur_la_spirale) \ ) \ ) \ Bblock \ EGAL(cumul_courant_normalise_apres_transfert,niveau_du_centre_de_la_spirale); \ /* La possibilite de conserver le niveau courant (celui du point courant {X,Y}) s'il */ \ /* est egal au maximum rencontre sur la spirale a ete introduite le 20130630183754... */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ EGAL(nombre_reel_de_points_pour_le_calcul_de_la_moyenne \ ,COND(IL_FAUT(Pconvolution_____utiliser_le_premier_point_pour_la_recherche_des_extrema) \ ,NEUT(Pconvolution_____nombre_reel_de_points) \ ,PRED(Pconvolution_____nombre_reel_de_points) \ ) \ ); \ EGAL(Pconvolution_____moyenne_sur_la_spirale \ ,NIVA(COND(IZGT(nombre_reel_de_points_pour_le_calcul_de_la_moyenne) \ ,VDIV(Pconvolution_____moyenne_sur_la_spirale \ ,FLOT(nombre_reel_de_points_pour_le_calcul_de_la_moyenne) \ ) \ ,AUCUN_POINT_TRAITE_DANS_LE_NOYAU \ ) \ ) \ ); \ /* Mise a jour de la moyenne non ponderee... */ \ Eblock \ ATes \ Bblock \ Test(EST_FAUX(on_a_teste_au_moins_un_point_de_la_forme_cherchee)) \ Bblock \ EGAL(Pconvolution_____la_forme_cherchee_a_ete_trouvee_sur_la_spirale,FAUX); \ /* Ainsi on "annule" la valeur initiale par defaut de cet indicateur ('VRAI')... */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ ETes \ \ Test(IL_FAUT(Pconvolution_____parcourir_circulairement_les_spirales_carrees)) \ Bblock \ Test(IFET(IFEQ(X,ADD2(PREX(Xmax),PasX)),IFEQ(Y,ADD2(PREY(Ymax),PasY)))) \ /* ATTENTION, il est imperatif que 'begin_image' utilise la fonction 'DoIn(...)', ce qui */ \ /* signifie que les coordonnees sont traitees de facon croissante (de 'Xmin' a 'Xmax' et */ \ /* de 'Ymin' a 'Ymax'), car en effet, la fonction 'Pconvolution(...)' utilise cela pour */ \ /* desinitialiser si necessaire les spirales circulaires... */ \ Bblock \ SPIRALE_CIRCULAIRE_DEPLACEMENT_ET_PARCOURS(ARGUMENT_INDIFFERENT(X_courant),ARGUMENT_INDIFFERENT(Y_courant) \ ,UNDEF,UNDEF \ ,UNDEF \ ,UNDEF \ ,NE_PAS_INITIALISER_UNE_SPIRALE_CIRCULAIRE \ ,DESINITIALISER_UNE_SPIRALE_CIRCULAIRE \ ); \ /* Desinitialisation d'une spirale circulaire lorsque l'on est sur le point {Xmax,Ymax}. */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ begin_nouveau_block \ Bblock \ DEFV(Float,INIT(normalisateur_de_la_dispersion \ ,LIN3(Pconvolution_____dispersion_des_niveaux_sur_la_spirale__ponderation__minimum \ ,Pconvolution_____minimum_sur_la_spirale \ ,Pconvolution_____dispersion_des_niveaux_sur_la_spirale__ponderation__moyenne \ ,Pconvolution_____moyenne_sur_la_spirale \ ,Pconvolution_____dispersion_des_niveaux_sur_la_spirale__ponderation__maximum \ ,Pconvolution_____maximum_sur_la_spirale \ ,Pconvolution_____dispersion_des_niveaux_sur_la_spirale__ponderation__translation \ ) \ ) \ ); \ \ Test(IZNE(normalisateur_de_la_dispersion)) \ Bblock \ EGAL(Pconvolution_____dispersion_des_niveaux_sur_la_spirale \ ,DIVI(Pconvolution_____dispersion_des_niveaux_sur_la_spirale \ ,normalisateur_de_la_dispersion \ ) \ ); \ /* Cette renormalisation "generalisee" a ete introduite le 20151112092202 apres avoir note */ \ /* qu'en son absence, par exemple, deux champs aleatoires d'extrema respectifs differents */ \ /* avaient des dispersions differentes alors que les applications qui sont faites de cela */ \ /* demandaient les memes dispersions ('v $xrC/SondelettesMesures.01$vv$Z dimension.02.X'). */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ end_nouveau_block \ \ RETU(LIZ4(Pconvolution_____ponderation_de_cumul_courant_normalise_apres_transfert,cumul_courant_normalise_apres_transfert \ ,Pconvolution_____ponderation_de_Pconvolution_____minimum_sur_la_spirale,Pconvolution_____minimum_sur_la_spirale \ ,Pconvolution_____ponderation_de_Pconvolution_____maximum_sur_la_spirale,Pconvolution_____maximum_sur_la_spirale \ ,Pconvolution_____ponderation_de_Pconvolution_____moyenne_sur_la_spirale,Pconvolution_____moyenne_sur_la_spirale \ ) \ ); \ /* Le 'LIN3(...)' fut introduit le 20070205133747... */ \ /* */ \ /* On notera le 20141125093146 quelque chose qui m'a surpris a cette date mais qui est */ \ /* en fait tout a fait logique. Avec les parametres par defaut, supposons un unique */ \ /* point P (de niveau 'BLANC' par exemple). Si l'on fait une convolution 3x3 (soit donc */ \ /* avec l'argument "points=9" de 'v $xci/convol.01$K points=', le point P ainsi que ses */ \ /* 8 voisins vont se voir attribuer le niveau 'BLANC/9'. En effet, le parcours en */ \ /* spirale partant de ces 1+8 points va necessairement contenir quelque part sur la */ \ /* spirale le point P. Le cumul 'Pconvolution_____cumul_courant' vaut alors evidemment */ \ /* '(1xBLANC) + (8xNOIR)' (soit donc 'BLANC') puisqu'en effet les ponderations des niveaux */ \ /* rencontres sur une spirale sont egales a 1 par defaut. Ainsi, on n'obtient pas, comme */ \ /* je le croyais naivement un degrade centre sur P, mais un carre 3x3 de niveau uniforme */ \ /* 'BLANC/9'... */ \ /* */ \ /* La moyenne fut introduite le 20161117133025, meme si cela ne sert pas a grand chose, */ \ /* la moyenne ressemblant beaucoup au cumul si ce n'est que ce dernier est pondere... */ \ Eblock /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* C O N V O L U T I O N D ' U N P O I N T P A R U N N O Y A U */ /* P O U R U N E I M A G E " S T A N D A R D " : */ /* */ /*************************************************************************************************************************************/ BFonctionF #define lp(imageA,X,Y) \ load_point_valide(imageA,X,Y) #define lpm(imageA,X,Y) \ load_point_modulo(imageA,X,Y) /* Pour raccourcir les noms afin que 'GENERE__FonctionF_C(...)' tienne sur une ligne... */ /* */ /* On notera le passage de 'load_point(...)' a 'load_point_valide(...)' effectue le */ /* 20070227122318 car, en effet, l'introduction de 'v $xci/CompteVoi.01$K' provoquait */ /* le message : */ /* */ /* Segmentation fault */ /* */ /* bien mysterieux (il est etonnant que cela ne se soit pas vu plus tot...). */ DEFV(Common,GENERE__FonctionF_C(Pconvolution(i1,i2,X,Y,nc,npn,n,in),genere_p,image,lp,lpm)) /* Common,DEFV(Fonction,) : */ #undef lpm #undef lp EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* C O N V O L U T I O N D ' U N P O I N T P A R U N N O Y A U */ /* P O U R U N E I M A G E " F L O T T A N T E " : */ /* */ /*************************************************************************************************************************************/ BFonctionF #define lFp(imageA,X,Y) \ loadF_point_valide(imageA,X,Y) #define lFpm(imageA,X,Y) \ loadF_point_modulo(imageA,X,Y) /* Pour raccourcir les noms afin que 'GENERE__FonctionF_C(...)' tienne sur une ligne... */ /* */ /* On notera le passage de 'loadF_point(...)' a 'loadF_point_valide(...)' effectue le */ /* 20070227122318 par symetrie avec 'lp(...)' et 'lpm(...)' ci-dessus... */ DEFV(Common,GENERE__FonctionF_C(PFconvolution(i1,i2,X,Y,nc,npn,n,in),genere_Float,imageF,lFp,lFpm)) /* Common,DEFV(Fonction,) : */ #undef lFpm #undef lFp EFonctionF #undef GENERE__FonctionF_C #undef EDITION_CONDITIONNELLE_DU_NOYAU_DE_CONVOLUTION #undef EDITION_INCONDITIONNELLE_DU_NOYAU_DE_CONVOLUTION #undef COORDONNEE_D_INERTIE_Y #undef COORDONNEE_D_INERTIE_X #undef PCONVOLUTION_NUMERO_DU_N_IEME_POINT_DE_MEME_NIVEAU #undef AUCUN_POINT_TRAITE_DANS_LE_NOYAU #undef TraY_DE_LA_MOSAIQUE_DE_CONVOLUTION #undef TraX_DE_LA_MOSAIQUE_DE_CONVOLUTION #undef PasY_DE_LA_MOSAIQUE_DE_CONVOLUTION #undef PasX_DE_LA_MOSAIQUE_DE_CONVOLUTION /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* V A L I D A T I O N D ' U N N O Y A U D E C O N V O L U T I O N : */ /* */ /*************************************************************************************************************************************/ #define VALIDATION_DE_____nombre_de_points_du_noyau_____BORNE_INFERIEURE \ UN #define VALIDATION_DE_____nombre_de_points_du_noyau_____BORNE_SUPERIEURE \ TAILLE_MAXIMALE_D_UN_NOYAU_DE_CONVOLUTION #define VALIDATION_DE_____nombre_de_points_du_noyau_____VALEUR_PAR_DEFAUT \ VALIDATION_DE_____nombre_de_points_du_noyau_____BORNE_INFERIEURE #define VALIDATION_DE_____nombre_de_points_du_noyau \ Bblock \ Test(IFEXff(nombre_de_points_du_noyau \ ,VALIDATION_DE_____nombre_de_points_du_noyau_____BORNE_INFERIEURE \ ,VALIDATION_DE_____nombre_de_points_du_noyau_____BORNE_SUPERIEURE \ ) \ ) \ Bblock \ PRINT_ERREUR("le nombre de points du noyau de convolution est bizarre"); \ CAL1(Prer4("(il vaut %d est hors de [%d,%d], la valeur %d est donc forcee)\n" \ ,nombre_de_points_du_noyau \ ,VALIDATION_DE_____nombre_de_points_du_noyau_____BORNE_INFERIEURE \ ,VALIDATION_DE_____nombre_de_points_du_noyau_____BORNE_SUPERIEURE \ ,VALIDATION_DE_____nombre_de_points_du_noyau_____VALEUR_PAR_DEFAUT \ ) \ ); \ \ EGAL(nombre_de_points_du_noyau,VALIDATION_DE_____nombre_de_points_du_noyau_____VALEUR_PAR_DEFAUT); \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ /* Procedure introduite le 20211020181331... */ #define VALIDATION_DE_____facteur_du_nombre_de_points_____BORNE_INFERIEURE \ FZERO #define VALIDATION_DE_____facteur_du_nombre_de_points_____BORNE_SUPERIEURE \ FLOT(TAILLE_MAXIMALE_D_UN_NOYAU_DE_CONVOLUTION) #define VALIDATION_DE_____facteur_du_nombre_de_points_____VALEUR_PAR_DEFAUT \ SUCC(VALIDATION_DE_____facteur_du_nombre_de_points_____BORNE_INFERIEURE) #define VALIDATION_DE_____facteur_du_nombre_de_points \ Bblock \ Test(IFEXof(facteur_du_nombre_de_points \ ,VALIDATION_DE_____facteur_du_nombre_de_points_____BORNE_INFERIEURE \ ,VALIDATION_DE_____facteur_du_nombre_de_points_____BORNE_SUPERIEURE \ ) \ ) \ /* Le 20061224105502 'IFEXff(...,UN,...)' a ete remplace par 'IFEXof(...,ZERO,...)' qui */ \ /* plus general et plus compatible avec les '$K's les utilisant... */ \ Bblock \ PRINT_ERREUR("le facteur du nombre de points du noyau de convolution est bizarre (1)"); \ CAL1(Prer4("(il vaut %f et hors de ]%f,%f], la valeur %f est donc forcee)\n" \ ,facteur_du_nombre_de_points \ ,VALIDATION_DE_____facteur_du_nombre_de_points_____BORNE_INFERIEURE \ ,VALIDATION_DE_____facteur_du_nombre_de_points_____BORNE_SUPERIEURE \ ,VALIDATION_DE_____facteur_du_nombre_de_points_____VALEUR_PAR_DEFAUT \ ) \ ); \ \ EGAL(facteur_du_nombre_de_points,VALIDATION_DE_____facteur_du_nombre_de_points_____VALEUR_PAR_DEFAUT); \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ /* Procedure introduite le 20211020181331... */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* C O N V O L U T I O N D ' U N E I M A G E P A R U N N O Y A U : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Iconvolution(imageR ,facteur_multiplicatif ,imageA ,niveaux_a_traiter,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ) ) ) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] convoluee par le noyau. */ DEFV(Argument,DEFV(Float,facteur_multiplicatif)); /* Facteur multiplicatif du produit de convolution en chaque point {X,Y}. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_a_traiter,COULEURS))); /* Definit les niveaux sur lesquels on doit faire la convolution par 'Pconvolution()'. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_cumulables,COULEURS))); /* Definit les niveaux cumulables lors du calcul de 'Pconvolution_____cumul_courant'. */ DEFV(Argument,DEFV(Int,nombre_de_points_du_noyau)); /* Nombre de points contenus dans le noyau, y compris son centre. */ DEFV(Argument,DEFV(Float,DTb0(noyau))); /* Noyau de convolution : il est defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ DEFV(Argument,DEFV(Logical,DTb0(inhibition_du_noyau))); /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ SPIRALE_VALIDATION; VALIDATION_DE_____nombre_de_points_du_noyau; /* Mis sous cette forme le 20211020181331... */ begin_image_AvecEditionProgression /* ATTENTION, il est imperatif que 'begin_image' utilise la fonction 'DoIn(...)', ce qui */ /* signifie que les coordonnees sont traitees de facon croissante (de 'Xmin' a 'Xmax' et */ /* de 'Ymin' a 'Ymax'), car en effet, la fonction 'Pconvolution(...)' utilise cela pour */ /* desinitialiser si necessaire les spirales circulaires... */ /* */ /* Le 20170520104209 a ete introduit "_AvecEditionProgression"... */ Bblock DEFV(genere_p,INIT(niveau_courant,load_point(imageA,X,Y))); /* Niveau courant au point courant... */ Test(EST_VRAI(ITb1(niveaux_a_traiter,INDX(niveau_courant,NOIR)))) Bblock /* Traitement des points a traiter... */ store_point(GENP(NIVA(MUL2(facteur_multiplicatif ,Pconvolution(imageA,imageA ,X,Y ,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ) ) ) ,imageR ,X,Y ,FVARIABLE ); /* Et on convolue point par point... */ Eblock ATes Bblock store_point(GENP(NIVA(MUL2(facteur_multiplicatif,NIVR(niveau_courant)))) ,imageR ,X,Y ,FVARIABLE ); /* Et on ne convolue pas lorsque le niveau courant n'est pas "traitable"... */ Eblock ETes Eblock end_image_AvecEditionProgression /* Le 20170520104209 a ete introduit "_AvecEditionProgression"... */ RETI(imageR); Eblock EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* C O N V O L U T I O N D ' U N E I M A G E P A R U N N O Y A U */ /* L O R S Q U E L E S V A R I A T I O N S L O C A L E S S O N T I M P O R T A N T E S : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(Logical,ZINT(Iconvolution_____fonction_des_variations_locales_extraire_les_contours,FAUX))); /* Afin de savoir si l'on doit extraire les contours (introduit le 20010720200856). */ DEFV(Common,DEFV(genere_p,ZINT(Iconvolution_____fonction_des_variations_locales_niveau_hors_contours,NOIR))); /* Niveau hors-contours... */ DEFV(Common,DEFV(FonctionP,POINTERp(Iconvolution_fonction_des_variations_locales(imageR ,facteur_multiplicatif ,imageA ,niveaux_a_traiter,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ,seuil_de_la_difference_des_extrema ) ) ) ) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] convoluee par le noyau. */ DEFV(Argument,DEFV(Float,facteur_multiplicatif)); /* Facteur multiplicatif du produit de convolution en chaque point {X,Y}. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_a_traiter,COULEURS))); /* Definit les niveaux sur lesquels on doit faire la convolution par 'Pconvolution()'. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_cumulables,COULEURS))); /* Definit les niveaux cumulables lors du calcul de 'Pconvolution_____cumul_courant'. */ DEFV(Argument,DEFV(Int,nombre_de_points_du_noyau)); /* Nombre de points contenus dans le noyau, y compris son centre. */ DEFV(Argument,DEFV(Float,DTb0(noyau))); /* Noyau de convolution : il est defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ DEFV(Argument,DEFV(Logical,DTb0(inhibition_du_noyau))); /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ DEFV(Argument,DEFV(Int,seuil_de_la_difference_des_extrema)); /* Seuil relatif a : */ /* */ /* Pconvolution_____maximum_sur_la_spirale-Pconvolution_____minimum_sur_la_spirale */ /* */ /* au-dela duquel il y a convolution (une valeur nulle donne une convolution systematique). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ SPIRALE_VALIDATION; VALIDATION_DE_____nombre_de_points_du_noyau; /* Mis sous cette forme le 20211020181331... */ begin_image_AvecEditionProgression Bblock /* ATTENTION, il est imperatif que 'begin_image' utilise la fonction 'DoIn(...)', ce qui */ /* signifie que les coordonnees sont traitees de facon croissante (de 'Xmin' a 'Xmax' et */ /* de 'Ymin' a 'Ymax'), car en effet, la fonction 'Pconvolution(...)' utilise cela pour */ /* desinitialiser si necessaire les spirales circulaires... */ /* */ /* Le 20170520104209 a ete introduit "_AvecEditionProgression"... */ DEFV(genere_p,INIT(niveau_courant,load_point(imageA,X,Y))); DEFV(genere_Float,INIT(nouveau_niveau_courant,FLOT__NIVEAU_UNDEF)); /* Niveau courant et nouveau niveau au point courant {X,Y}. */ Test(EST_VRAI(ITb1(niveaux_a_traiter,INDX(niveau_courant,NOIR)))) Bblock /* Traitement des points a traiter... */ DEFV(Float,INIT(niveau_convolue_courant ,Pconvolution(imageA,imageA ,X,Y ,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ) ); /* Convolution au point courant. */ Test(IFGE(SOUS(Pconvolution_____maximum_sur_la_spirale,Pconvolution_____minimum_sur_la_spirale) ,seuil_de_la_difference_des_extrema ) ) Bblock EGAL(nouveau_niveau_courant ,COND(IL_FAUT(Iconvolution_____fonction_des_variations_locales_extraire_les_contours) ,FLOT(NIVR(niveau_courant)) ,niveau_convolue_courant ) ); /* Et on convolue point par point lorsque l'on est au dessus du seuil et qu'une */ /* extraction des contours n'est pas demandee. Dans le cas contraire, on garde le */ /* niveau courant qui semble faire partie d'un contour. */ Eblock ATes Bblock EGAL(nouveau_niveau_courant ,COND(IL_FAUT(Iconvolution_____fonction_des_variations_locales_extraire_les_contours) ,FLOT(NIVR(Iconvolution_____fonction_des_variations_locales_niveau_hors_contours)) ,FLOT(NIVR(niveau_courant)) ) ); /* Et on ne convolue pas lorsque l'on est en dessous du seuil et qu'une extraction */ /* des contours n'est pas demandee. Dans le cas contraire, un niveau "hors contours" */ /* est force. */ Eblock ETes Eblock ATes Bblock EGAL(nouveau_niveau_courant,FLOT(NIVR(niveau_courant))); /* Et on ne convolue pas lorsque le niveau courant n'est pas "traitable"... */ Eblock ETes store_point(GENP(NIVA(MUL2(facteur_multiplicatif,nouveau_niveau_courant))) ,imageR ,X,Y ,FVARIABLE ); /* Et mise en place du nouveau niveau au point courant {X,Y}. */ Eblock end_image_AvecEditionProgression /* Le 20170520104209 a ete introduit "_AvecEditionProgression"... */ RETI(imageR); Eblock EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* C O N V O L U T I O N F L O T T A N T E D ' U N E I M A G E P A R U N N O Y A U : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFconvolution(imageR ,facteur_multiplicatif ,imageA ,niveaux_a_traiter,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ) ) ) DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] convoluee par le noyau. */ DEFV(Argument,DEFV(Float,facteur_multiplicatif)); /* Facteur multiplicatif du produit de convolution en chaque point {X,Y}. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_a_traiter,COULEURS))); /* Definit les niveaux sur lesquels on doit faire la convolution par 'Pconvolution()'. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_cumulables,COULEURS))); /* Definit les niveaux cumulables lors du calcul de 'Pconvolution_____cumul_courant'. */ DEFV(Argument,DEFV(Int,nombre_de_points_du_noyau)); /* Nombre de points contenus dans le noyau, y compris son centre. */ DEFV(Argument,DEFV(Float,DTb0(noyau))); /* Noyau de convolution : il est defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ DEFV(Argument,DEFV(Logical,DTb0(inhibition_du_noyau))); /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ SPIRALE_VALIDATION; VALIDATION_DE_____nombre_de_points_du_noyau; /* Mis sous cette forme le 20211020181331... */ begin_image_AvecEditionProgression /* ATTENTION, il est imperatif que 'begin_image' utilise la fonction 'DoIn(...)', ce qui */ /* signifie que les coordonnees sont traitees de facon croissante (de 'Xmin' a 'Xmax' et */ /* de 'Ymin' a 'Ymax'), car en effet, la fonction 'Pconvolution(...)' utilise cela pour */ /* desinitialiser si necessaire les spirales circulaires... */ /* */ /* Le 20170520104209 a ete introduit "_AvecEditionProgression"... */ Bblock DEFV(genere_p,INIT(niveau_courant,load_point(imageA,X,Y))); /* Niveau courant au point courant... */ Test(EST_VRAI(ITb1(niveaux_a_traiter,INDX(niveau_courant,NOIR)))) Bblock /* Traitement des points a traiter... */ storeF_point(NIVA(MUL2(facteur_multiplicatif ,Pconvolution(imageA,imageA ,X,Y ,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ) ) ,imageR ,X,Y ); /* Et on convolue point par point... */ Eblock ATes Bblock storeF_point(NIVA(MUL2(facteur_multiplicatif,FLOT(NIVR(niveau_courant)))) ,imageR ,X,Y ); /* Et on ne convolue pas lorsque le niveau courant n'est pas "traitable"... */ Eblock ETes Eblock end_image_AvecEditionProgression /* Le 20170520104209 a ete introduit "_AvecEditionProgression"... */ RETIF(imageR); Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* C O N V O L U T I O N F L O T T A N T E D ' U N E I M A G E F L O T T A N T E P A R U N N O Y A U : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFFconvolution(imageR ,facteur_multiplicatif ,imageA ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ) ) ) DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] convoluee par le noyau. */ DEFV(Argument,DEFV(Float,facteur_multiplicatif)); /* Facteur multiplicatif du produit de convolution en chaque point {X,Y}. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Int,nombre_de_points_du_noyau)); /* Nombre de points contenus dans le noyau, y compris son centre. */ DEFV(Argument,DEFV(Float,DTb0(noyau))); /* Noyau de convolution : il est defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ DEFV(Argument,DEFV(Logical,DTb0(inhibition_du_noyau))); /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Logical,INIT(POINTERl(niveaux_cumulables),ADRESSE_NON_DEFINIE)); /* Ceci est destine a eviter un message du type : */ /* */ /* argument is incompatible with formal parameter */ /* */ /* (sur 'SYSTEME_SGO200A2_IRIX_CC') lors du traitement du 'PFconvolution(...)' qui suit. */ /*..............................................................................................................................*/ SPIRALE_VALIDATION; VALIDATION_DE_____nombre_de_points_du_noyau; /* Mis sous cette forme le 20211020181331... */ begin_image_AvecEditionProgression /* ATTENTION, il est imperatif que 'begin_image' utilise la fonction 'DoIn(...)', ce qui */ /* signifie que les coordonnees sont traitees de facon croissante (de 'Xmin' a 'Xmax' et */ /* de 'Ymin' a 'Ymax'), car en effet, la fonction 'PFconvolution(...)' utilise cela pour */ /* desinitialiser si necessaire les spirales circulaires... */ /* */ /* Le 20170520104209 a ete introduit "_AvecEditionProgression"... */ Bblock storeF_point(MUL2(facteur_multiplicatif ,PFconvolution(imageA,imageA ,X,Y ,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ) ,imageR ,X,Y ); /* Et on convolue point par point... */ Eblock end_image_AvecEditionProgression /* Le 20170520104209 a ete introduit "_AvecEditionProgression"... */ RETIF(imageR); Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* C O N V O L U T I O N F L O T T A N T E D E S E U I L L A G E */ /* D ' U N E I M A G E F L O T T A N T E P A R U N N O Y A U : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFFconvolution_de_seuillage(imageR ,imageA ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ,seuil ,niveau_inferieur ,niveau_median ,niveau_superieur ) ) ) ) DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] convoluee par le noyau. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Int,nombre_de_points_du_noyau)); /* Nombre de points contenus dans le noyau, y compris son centre. */ DEFV(Argument,DEFV(Float,DTb0(noyau))); /* Noyau de convolution : il est defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ DEFV(Argument,DEFV(Logical,DTb0(inhibition_du_noyau))); /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ DEFV(Argument,DEFV(genere_Float,seuil)); /* Seuil de selection de l'un des trois {niveau_inferieur,niveau_median,niveau_superieur}. */ DEFV(Argument,DEFV(genere_Float,niveau_inferieur)); DEFV(Argument,DEFV(genere_Float,niveau_median)); DEFV(Argument,DEFV(genere_Float,niveau_superieur)); /* Niveaux de marquage de la position de 'Pconvolution_____minimum_sur_la_spirale' et de */ /* 'Pconvolution_____maximum_sur_la_spirale' par rapport a 'seuil'. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Logical,INIT(POINTERl(niveaux_cumulables),ADRESSE_NON_DEFINIE)); /* Ceci est destine a eviter un message du type : */ /* */ /* argument is incompatible with formal parameter */ /* */ /* (sur 'SYSTEME_SGO200A2_IRIX_CC') lors du traitement du 'PFconvolution(...)' qui suit. */ /*..............................................................................................................................*/ SPIRALE_VALIDATION; VALIDATION_DE_____nombre_de_points_du_noyau; /* Mis sous cette forme le 20211020181331... */ begin_image_AvecEditionProgression /* ATTENTION, il est imperatif que 'begin_image' utilise la fonction 'DoIn(...)', ce qui */ /* signifie que les coordonnees sont traitees de facon croissante (de 'Xmin' a 'Xmax' et */ /* de 'Ymin' a 'Ymax'), car en effet, la fonction 'PFconvolution(...)' utilise cela pour */ /* desinitialiser si necessaire les spirales circulaires... */ /* */ /* Le 20170520104209 a ete introduit "_AvecEditionProgression"... */ Bblock DEFV(genere_Float,INIT(niveau_de_marquage,FLOT__NIVEAU_UNDEF)); /* Futur niveau de marquage du point {X,Y}. */ CALS(PFconvolution(imageA,imageA ,X,Y ,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ); /* Convolution au point {X,Y}. Ce calcul permet d'evaluer les valeurs de */ /* 'Pconvolution_____minimum_sur_la_spirale' et 'Pconvolution_____maximum_sur_la_spirale'. */ Test(IFET(IFLT(Pconvolution_____minimum_sur_la_spirale,seuil) ,IFGT(Pconvolution_____maximum_sur_la_spirale,seuil) ) ) Bblock EGAL(niveau_de_marquage,niveau_median); /* Cas : */ /* */ /* minimum < seuil < maximum */ /* */ Eblock ATes Bblock Test(IFET(IFLT(Pconvolution_____minimum_sur_la_spirale,seuil) ,IFLE(Pconvolution_____maximum_sur_la_spirale,seuil) ) ) Bblock EGAL(niveau_de_marquage,niveau_inferieur); /* Cas : */ /* */ /* minimum < maximum <= seuil */ /* */ Eblock ATes Bblock Test(IFET(IFGE(Pconvolution_____minimum_sur_la_spirale,seuil) ,IFGT(Pconvolution_____maximum_sur_la_spirale,seuil) ) ) Bblock EGAL(niveau_de_marquage,niveau_superieur); /* Cas : */ /* */ /* seuil <= minimum < maximum */ /* */ Eblock ATes Bblock PRINT_ATTENTION("relation d'ordre non prevue entre {minimum,maximum} et le seuil"); Eblock ETes Eblock ETes Eblock ETes storeF_point(niveau_de_marquage ,imageR ,X,Y ); /* Et on convolue point par point en marquant la position par rapport a 'seuil'... */ Eblock end_image_AvecEditionProgression /* Le 20170520104209 a ete introduit "_AvecEditionProgression"... */ RETIF(imageR); Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* C O N V O L U T I O N D ' U N E I M A G E P A R U N N O Y A U E T R E N O R M A L I S A T I O N : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Iconvolution_avec_renormalisation(imageR ,facteur_multiplicatif ,imageA ,niveaux_a_traiter,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ,renormaliser_les_niveaux ) ) ) ) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] convoluee par le noyau. */ DEFV(Argument,DEFV(Float,facteur_multiplicatif)); /* Facteur multiplicatif du produit de convolution en chaque point {X,Y}. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_a_traiter,COULEURS))); /* Definit les niveaux sur lesquels on doit faire la convolution par 'Pconvolution()'. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_cumulables,COULEURS))); /* Definit les niveaux cumulables lors du calcul de 'Pconvolution_____cumul_courant'. */ DEFV(Argument,DEFV(Int,nombre_de_points_du_noyau)); /* Nombre de points contenus dans le noyau, y compris son centre. */ DEFV(Argument,DEFV(Float,DTb0(noyau))); /* Noyau de convolution : il est defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ DEFV(Argument,DEFV(Logical,DTb0(inhibition_du_noyau))); /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ DEFV(Argument,DEFV(Logical,renormaliser_les_niveaux)); /* Cet indicateur precise s'il faut renormaliser les niveaux ('VRAI') ou les laisser */ /* inchanger ('FAUX'). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock BDEFV(imageF,imageR_flottante); /* Image flottante Resultat apres la convolution. */ /*..............................................................................................................................*/ VALIDATION_DE_____nombre_de_points_du_noyau; /* Mis sous cette forme le 20211020181331... */ CALS(IFconvolution(imageR_flottante ,facteur_multiplicatif ,imageA ,niveaux_a_traiter,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ); /* Convolution flottante de l'image Argument... */ Test(IL_FAUT(renormaliser_les_niveaux)) Bblock CALS(Ifloat_std_avec_renormalisation(imageR,imageR_flottante)); /* Conversion de l'image Resultat en une image standard avec renormalisation... */ Eblock ATes Bblock CALS(Ifloat_std(imageR,imageR_flottante,FLOT__NOIR,FLOT__BLANC)); /* Conversion de l'image Resultat en une image standard sans renormalisation... */ Eblock ETes EDEFV(imageF,imageR_flottante); /* Image flottante Resultat apres la convolution. */ RETI(imageR); Eblock EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* L A P L A C I E N G E N E R A L I S E D ' U N E I M A G E F L O T T A N T E : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Logical,SINT(IFlaplacien_generalise_____compatibilite_20231031,FAUX))); /* Permet de generer des images suivant la methode anterieure au 20231031084321 en ce qui */ /* concerne le cas des points 'HORS_IMAGE's... */ DEFV(Common,DEFV(FonctionF,POINTERp(IFlaplacien_generalise(imageR ,facteur_multiplicatif ,imageA ,niveaux_a_traiter,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ) ) ) /* Fonction introduite le 20210225113338... */ DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] convoluee par le noyau. */ DEFV(Argument,DEFV(Float,facteur_multiplicatif)); /* Facteur multiplicatif du produit de convolution en chaque point {X,Y}. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_a_traiter,COULEURS))); /* Definit les niveaux sur lesquels on doit faire la convolution par 'Pconvolution()'. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_cumulables,COULEURS))); /* Definit les niveaux cumulables lors du calcul de 'Pconvolution_____cumul_courant'. */ DEFV(Argument,DEFV(Int,nombre_de_points_du_noyau)); /* Nombre de points contenus dans le noyau, y compris son centre. */ DEFV(Argument,DEFV(Float,DTb0(noyau))); /* Noyau de convolution : il est defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ DEFV(Argument,DEFV(Logical,DTb0(inhibition_du_noyau))); /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ SPIRALE_VALIDATION; VALIDATION_DE_____nombre_de_points_du_noyau; /* Mis sous cette forme le 20211020181331... */ begin_image_AvecEditionProgression /* ATTENTION, il est imperatif que 'begin_image' utilise la fonction 'DoIn(...)', ce qui */ /* signifie que les coordonnees sont traitees de facon croissante (de 'Xmin' a 'Xmax' et */ /* de 'Ymin' a 'Ymax'), car en effet, la fonction 'Pconvolution(...)' utilise cela pour */ /* desinitialiser si necessaire les spirales circulaires... */ Bblock DEFV(genere_Float,INIT(niveau_courant,loadF_point(imageA,X,Y))); /* Niveau courant au point courant... */ Test(EST_VRAI(ITb1(niveaux_a_traiter,INDX(niveau_courant,NOIR)))) Bblock /* Traitement des points a traiter... */ CALS(PFconvolution(imageA,imageA ,X,Y ,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ); /* Convolution au point {X,Y}. Ce calcul permet de calculer le Laplacien generalise... */ storeF_point(MUL2(facteur_multiplicatif ,COND(IFOU(IL_FAUT(IFlaplacien_generalise_____compatibilite_20231031) ,IFET(IL_NE_FAUT_PAS(IFlaplacien_generalise_____compatibilite_20231031) ,IZEQ(Pconvolution_____nombre_reel_de_points__HORS_IMAGE__) ) ) ,Pconvolution_____valeur_du_Laplacien_generalise ,niveau_courant ) ) ,imageR ,X,Y ); /* Dans le cas ou il y a des points 'HORS_IMAGE's, on utilise le niveau courant afin */ /* d'eviter des effets de bord (introduit le 20231031084321), cela s'etant vu lors de */ /* mise au point de 'v $xiirv/SMIT.H4' au format 'Sdu' (c'est d'ailleurs pour cela que */ /* cette image a ete finalement calculee avec le format 'Squ' dans utiliser l'amelioration */ /* de la nettete via 'v $xci/nettete.01$K'...). */ Eblock ATes Bblock storeF_point(MUL2(facteur_multiplicatif,NIVR(niveau_courant)) ,imageR ,X,Y ); /* Et on ne convolue pas lorsque le niveau courant n'est pas "traitable"... */ Eblock ETes Eblock end_image_AvecEditionProgression RETIF(imageR); Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* L A P L A C I E N G E N E R A L I S E D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Ilaplacien_generalise(imageR ,facteur_multiplicatif ,imageA ,niveaux_a_traiter,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ,renormaliser_les_niveaux ) ) ) ) /* Fonction introduite le 20210225113338... */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] convoluee par le noyau. */ DEFV(Argument,DEFV(Float,facteur_multiplicatif)); /* Facteur multiplicatif du produit de convolution en chaque point {X,Y}. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_a_traiter,COULEURS))); /* Definit les niveaux sur lesquels on doit faire la convolution par 'Pconvolution()'. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_cumulables,COULEURS))); /* Definit les niveaux cumulables lors du calcul de 'Pconvolution_____cumul_courant'. */ DEFV(Argument,DEFV(Int,nombre_de_points_du_noyau)); /* Nombre de points contenus dans le noyau, y compris son centre. */ DEFV(Argument,DEFV(Float,DTb0(noyau))); /* Noyau de convolution : il est defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ DEFV(Argument,DEFV(Logical,DTb0(inhibition_du_noyau))); /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ DEFV(Argument,DEFV(Logical,renormaliser_les_niveaux)); /* Cet indicateur precise s'il faut renormaliser les niveaux ('VRAI') ou les laisser */ /* inchanger ('FAUX'). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ BDEFV(imageF,imageA_flottante); BDEFV(imageF,imageR_flottante); CALS(Istd_float(imageA_flottante,FLOT__NOIR,FLOT__BLANC,imageA)); /* Conversion de l'image Argument en flottant... */ CALS(IFlaplacien_generalise(imageR_flottante ,facteur_multiplicatif ,imageA_flottante ,niveaux_a_traiter,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ); Test(IL_FAUT(renormaliser_les_niveaux)) Bblock CALS(Ifloat_std_avec_renormalisation(imageR,imageR_flottante)); /* Conversion de l'image Resultat en une image standard avec renormalisation... */ Eblock ATes Bblock CALS(Ifloat_std_avec_troncation(imageR,imageR_flottante,FLOT__NOIR,FLOT__BLANC)); /* Conversion de l'image Resultat en une image standard sans renormalisation... */ /* */ /* On notera le 20210225144953 la necessite de faire une conversion avec troncation */ /* utilisant [NOIR,BLANC] a cause des effets de bord. En effet, le parcours en spirale */ /* aux bords des images, qui utilise des 'v $xiii/di_image$FON define...lp.imageA.X.Y.'s */ /* et des 'v $xiii/di_image$FON define...lFp.imageA.X.Y.'s, recupere des 'NOIR's qui */ /* "perturbent" le calcul du laplacien aux bords des images. Cela se voit, par exemple, */ /* tres bien avec une image toute blanche pour laquelle le laplacien devrait etre nul en */ /* tous les points, mais ce qui n'est pas vrai aux bords... */ Eblock ETes EDEFV(imageF,imageR_flottante); EDEFV(imageF,imageA_flottante); RETI(imageR); Eblock EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* R E C H E R C H E E T M A R Q U A G E D E V O I S I N A G E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Irecherche_et_marquage_de_voisinage(imageR ,imageA ,niveaux_a_traiter,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ,niveau_interieur ,niveau_exterieur ,niveau_de_marquage ) ) ) ) /* Fonction introduite le 20070209095622... */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] convoluee par le noyau. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_a_traiter,COULEURS))); /* Definit les niveaux sur lesquels on doit faire la convolution par 'Pconvolution()'. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_cumulables,COULEURS))); /* Definit les niveaux cumulables lors du calcul de 'Pconvolution_____cumul_courant'. */ DEFV(Argument,DEFV(Int,nombre_de_points_du_noyau)); /* Nombre de points contenus dans le noyau, y compris son centre. */ DEFV(Argument,DEFV(Float,DTb0(noyau))); /* Noyau de convolution : il est defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ DEFV(Argument,DEFV(Logical,DTb0(inhibition_du_noyau))); /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ DEFV(Argument,DEFV(genere_p,niveau_interieur)); DEFV(Argument,DEFV(genere_p,niveau_exterieur)); DEFV(Argument,DEFV(genere_p,niveau_de_marquage)); /* Si le point courant {X,Y} possede le niveau 'niveau_interieur' et si dans son voisinage */ /* il y a au moins un point de niveau 'niveau_exterieur', alors ce point courant {X,Y} est */ /* marque avec 'niveau_de_marquage'... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ BSaveModifyVariable(Logical,Pconvolution_____calculer_l_histogramme_des_niveaux,VRAI); /* Activation du calcul de l'histogramme du voisinage de chaque point... */ /* */ /* Mis sous cette forme le 20101115152408... */ SPIRALE_VALIDATION; VALIDATION_DE_____nombre_de_points_du_noyau; /* Mis sous cette forme le 20211020181331... */ begin_image_AvecEditionProgression /* ATTENTION, il est imperatif que 'begin_image' utilise la fonction 'DoIn(...)', ce qui */ /* signifie que les coordonnees sont traitees de facon croissante (de 'Xmin' a 'Xmax' et */ /* de 'Ymin' a 'Ymax'), car en effet, la fonction 'Pconvolution(...)' utilise cela pour */ /* desinitialiser si necessaire les spirales circulaires... */ /* */ /* Le 20170520104209 a ete introduit "_AvecEditionProgression"... */ Bblock DEFV(genere_p,INIT(niveau_courant,load_point(imageA,X,Y))); /* Niveau courant au point courant... */ Test(EST_VRAI(ITb1(niveaux_a_traiter,INDX(niveau_courant,NOIR)))) Bblock /* Traitement des points a traiter... */ CALS(Pconvolution(imageA,imageA ,X,Y ,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ); /* Convolution au point {X,Y}. Ce calcul permet de calculer l'histogramme des niveaux du */ /* voisinage... */ store_point(COND(IFET(IFEQ(niveau_courant,niveau_interieur) ,IZGT(ITb1(Pconvolution_____histogramme_des_niveaux,INDX(niveau_exterieur,NOIR))) ) ,niveau_de_marquage ,niveau_courant ) ,imageR ,X,Y ,FVARIABLE ); /* Et on convolue point par point... */ /* */ /* Si le point courant {X,Y} possede le niveau 'niveau_interieur' et si dans son voisinage */ /* il y a au moins un point de niveau 'niveau_exterieur', alors ce point courant {X,Y} est */ /* marque avec 'niveau_de_marquage'... */ Eblock ATes Bblock store_point(niveau_courant ,imageR ,X,Y ,FVARIABLE ); /* Et on ne convolue pas lorsque le niveau courant n'est pas "traitable"... */ Eblock ETes Eblock end_image_AvecEditionProgression /* Le 20170520104209 a ete introduit "_AvecEditionProgression"... */ ESaveModifyVariable(Logical,Pconvolution_____calculer_l_histogramme_des_niveaux); /* Mis sous cette forme le 20101115152408... */ RETI(imageR); Eblock EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* C O M P T A G E D E S V O I S I N S D ' U N N I V E A U D O N N E : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Float,SINT(Icomptage_des_voisins_de_niveau_donne_____ponderation_de_l_histogramme_des_niveaux,FU))); DEFV(Common,DEFV(Float,SINT(Icomptage_des_voisins_de_niveau_donne_____ponderation_de_la_dimension_fractale,FZERO))); DEFV(Common,DEFV(Float,SINT(Icomptage_des_voisins_de_niveau_donne_____constante_multiplicative,FU))); /* Afin de "configurer" le resultat final (introduits le 20070227132913). */ DEFV(Common,DEFV(FonctionF,POINTERF(Icomptage_des_voisins_de_niveau_donne(imageR ,imageA ,niveaux_a_traiter,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ,niveau_a_tester ) ) ) ) /* Fonction introduite le 20070227104853... */ DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] convoluee par le noyau. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_a_traiter,COULEURS))); /* Definit les niveaux sur lesquels on doit faire la convolution par 'Pconvolution()'. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_cumulables,COULEURS))); /* Definit les niveaux cumulables lors du calcul de 'Pconvolution_____cumul_courant'. */ DEFV(Argument,DEFV(Int,nombre_de_points_du_noyau)); /* Nombre de points contenus dans le noyau, y compris son centre. */ DEFV(Argument,DEFV(Float,DTb0(noyau))); /* Noyau de convolution : il est defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ DEFV(Argument,DEFV(Logical,DTb0(inhibition_du_noyau))); /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ DEFV(Argument,DEFV(genere_p,niveau_a_tester)); /* Niveau a tester dans le voisinage du point {X,Y}... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ BSaveModifyVariable(Logical,Pconvolution_____calculer_l_histogramme_des_niveaux,VRAI); /* Activation du calcul de l'histogramme du voisinage de chaque point... */ /* */ /* Mis sous cette forme le 20101115152408... */ SPIRALE_VALIDATION; VALIDATION_DE_____nombre_de_points_du_noyau; /* Mis sous cette forme le 20211020181331... */ begin_image_AvecEditionProgression /* ATTENTION, il est imperatif que 'begin_image' utilise la fonction 'DoIn(...)', ce qui */ /* signifie que les coordonnees sont traitees de facon croissante (de 'Xmin' a 'Xmax' et */ /* de 'Ymin' a 'Ymax'), car en effet, la fonction 'Pconvolution(...)' utilise cela pour */ /* desinitialiser si necessaire les spirales circulaires... */ /* */ /* Le 20170520104209 a ete introduit "_AvecEditionProgression"... */ Bblock DEFV(genere_p,INIT(niveau_courant,load_point(imageA,X,Y))); /* Niveau courant au point courant... */ Test(EST_VRAI(ITb1(niveaux_a_traiter,INDX(niveau_courant,NOIR)))) Bblock /* Traitement des points a traiter... */ CALS(Pconvolution(imageA,imageA ,X,Y ,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ); /* Convolution au point {X,Y}. Ce calcul permet de calculer l'histogramme des niveaux du */ /* voisinage... */ Test(IFET(IZGT(Pconvolution_____nombre_de_points_de_l_histogramme_des_niveaux) ,IZGT(ITb1(Pconvolution_____histogramme_des_niveaux,INDX(niveau_a_tester,NOIR))) ) ) Bblock storeF_point(LIZ2(Icomptage_des_voisins_de_niveau_donne_____ponderation_de_l_histogramme_des_niveaux ,FLOT(ITb1(Pconvolution_____histogramme_des_niveaux,INDX(niveau_a_tester,NOIR))) ,Icomptage_des_voisins_de_niveau_donne_____ponderation_de_la_dimension_fractale ,DIVI(SOUS(LOGX(ITb1(Pconvolution_____histogramme_des_niveaux,INDX(niveau_a_tester,NOIR))) ,LOGX(Icomptage_des_voisins_de_niveau_donne_____constante_multiplicative) ) ,LOGX(RAC2(Pconvolution_____nombre_de_points_de_l_histogramme_des_niveaux)) ) ) ,imageR ,X,Y ); /* Et on convolue point par point... */ /* */ /* On notera que la dimension fractale 'Df' est calculee selon la relation : */ /* */ /* Df */ /* N = K.R */ /* */ /* soit donc : */ /* */ /* Log(N) - Log(K) */ /* Df = ----------------- */ /* Log(R) */ /* */ /* ou 'N' est le nombre de points rencontres de niveau 'niveau_a_tester', 'R' est le "rayon" */ /* ou "cote" de la boite d'evaluation (dont le carre, qui est une surface, est donne par le */ /* nombre de points traites 'Pconvolution_____nombre_de_points_de_l_histogramme_des_niveaux' */ /* et enfin 'K' est une constante arbitraire... */ Eblock ATes Bblock storeF_point(FZERO ,imageR ,X,Y ); /* Et on ne convolue pas lorsqu'aucun niveau n'a ete traite... */ Eblock ETes Eblock ATes Bblock storeF_point(FZERO ,imageR ,X,Y ); /* Et on ne convolue pas lorsque le niveau courant n'est pas "traitable"... */ Eblock ETes Eblock end_image_AvecEditionProgression /* Le 20170520104209 a ete introduit "_AvecEditionProgression"... */ ESaveModifyVariable(Logical,Pconvolution_____calculer_l_histogramme_des_niveaux); /* Mis sous cette forme le 20101115152408... */ RETIF(imageR); Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* R E C H E R C H E D E S M I N I M A L O C A U X D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(genere_p,SINT(Iminima_locaux_____niveau_de_marquage_des_points_non_minimaux,BLANC))); /* Niveau de marquage des points qui ne sont pas des minima locaux... */ DEFV(Common,DEFV(Logical,SINT(Iminima_locaux_____marquer_les_points_minimaux_avec_le_niveau_courant,VRAI))); DEFV(Common,DEFV(genere_p,SINT(Iminima_locaux_____niveau_de_marquage_des_points_minimaux,NOIR))); /* Niveau de marquage des points qui sont des minima locaux (introduit le 20040717102208). */ DEFV(Common,DEFV(Int,SINT(Iminima_locaux_____borne_inferieure_relative_du_voisinage,ZERO))); DEFV(Common,DEFV(Int,SINT(Iminima_locaux_____borne_superieure_relative_du_voisinage,ZERO))); /* Definition du voisinage d'un minimum local quelconque. */ DEFV(Common,DEFV(FonctionP,POINTERp(Iminima_locaux(imageR ,imageA ,niveaux_a_traiter,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ) ) ) /* Fonction introduite le 20040717092953... */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] convoluee par le noyau. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_a_traiter,COULEURS))); /* Definit les niveaux sur lesquels on doit faire la convolution par 'Pconvolution()'. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_cumulables,COULEURS))); /* Definit les niveaux cumulables lors du calcul de 'Pconvolution_____cumul_courant'. */ DEFV(Argument,DEFV(Int,nombre_de_points_du_noyau)); /* Nombre de points contenus dans le noyau, y compris son centre. */ DEFV(Argument,DEFV(Float,DTb0(noyau))); /* Noyau de convolution : il est defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ DEFV(Argument,DEFV(Logical,DTb0(inhibition_du_noyau))); /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ SPIRALE_VALIDATION; VALIDATION_DE_____nombre_de_points_du_noyau; /* Mis sous cette forme le 20211020181331... */ Test(IFGT(Iminima_locaux_____borne_inferieure_relative_du_voisinage ,Iminima_locaux_____borne_superieure_relative_du_voisinage ) ) Bblock PRINT_ERREUR("les bornes inferieure et superieure du voisinage sont mal ordonnees"); Eblock ATes Bblock Eblock ETes begin_image_AvecEditionProgression /* ATTENTION, il est imperatif que 'begin_image' utilise la fonction 'DoIn(...)', ce qui */ /* signifie que les coordonnees sont traitees de facon croissante (de 'Xmin' a 'Xmax' et */ /* de 'Ymin' a 'Ymax'), car en effet, la fonction 'Pconvolution(...)' utilise cela pour */ /* desinitialiser si necessaire les spirales circulaires... */ /* */ /* Le 20170520104209 a ete introduit "_AvecEditionProgression"... */ Bblock DEFV(genere_p,INIT(niveau_courant,load_point(imageA,X,Y))); /* Niveau courant au point courant... */ Test(EST_VRAI(ITb1(niveaux_a_traiter,INDX(niveau_courant,NOIR)))) Bblock /* Traitement des points a traiter... */ CALS(Pconvolution(imageA,imageA ,X,Y ,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ); /* Convolution au point {X,Y}. Ce calcul permet d'evaluer le minimum local... */ store_point(COND(IFINff(SOUS(FLOT(niveau_courant),Pconvolution_____minimum_sur_la_spirale) ,Iminima_locaux_____borne_inferieure_relative_du_voisinage ,Iminima_locaux_____borne_superieure_relative_du_voisinage ) ,COND(IL_FAUT(Iminima_locaux_____marquer_les_points_minimaux_avec_le_niveau_courant) ,niveau_courant ,Iminima_locaux_____niveau_de_marquage_des_points_minimaux ) ,Iminima_locaux_____niveau_de_marquage_des_points_non_minimaux ) ,imageR ,X,Y ,FVARIABLE ); /* Et on convolue point par point... */ Eblock ATes Bblock store_point(niveau_courant ,imageR ,X,Y ,FVARIABLE ); /* Et on ne convolue pas lorsque le niveau courant n'est pas "traitable"... */ Eblock ETes Eblock end_image_AvecEditionProgression /* Le 20170520104209 a ete introduit "_AvecEditionProgression"... */ RETI(imageR); Eblock EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* R E C H E R C H E D E S M I N I M A L O C A U X D ' U N E I M A G E F L O T T A N T E : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(genere_Float,SINT(IFminima_locaux_____niveau_de_marquage_des_points_non_minimaux,FU))); /* Niveau de marquage des points qui ne sont pas des minima locaux... */ DEFV(Common,DEFV(Logical,SINT(IFminima_locaux_____marquer_les_points_minimaux_avec_le_niveau_courant,VRAI))); DEFV(Common,DEFV(genere_Float,SINT(IFminima_locaux_____niveau_de_marquage_des_points_minimaux,FZERO))); /* Niveau de marquage des points qui sont des minima locaux (introduit le 20040717102208). */ DEFV(Common,DEFV(Float,SINT(IFminima_locaux_____borne_inferieure_relative_du_voisinage,FZERO))); DEFV(Common,DEFV(Float,SINT(IFminima_locaux_____borne_superieure_relative_du_voisinage,FZERO))); /* Definition du voisinage d'un minimum local quelconque. */ DEFV(Common,DEFV(FonctionF,POINTERF(IFminima_locaux(imageR ,imageA ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ) ) ) /* Fonction introduite le 20040717092953... */ DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] convoluee par le noyau. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Int,nombre_de_points_du_noyau)); /* Nombre de points contenus dans le noyau, y compris son centre. */ DEFV(Argument,DEFV(Float,DTb0(noyau))); /* Noyau de convolution : il est defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ DEFV(Argument,DEFV(Logical,DTb0(inhibition_du_noyau))); /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Logical,INIT(POINTERl(niveaux_cumulables),ADRESSE_NON_DEFINIE)); /* Juste pour eviter des problemes ci-apres avec 'PFconvolution(...)', mais a part cela */ /* inutile... */ /*..............................................................................................................................*/ SPIRALE_VALIDATION; VALIDATION_DE_____nombre_de_points_du_noyau; /* Mis sous cette forme le 20211020181331... */ Test(IFGT(IFminima_locaux_____borne_inferieure_relative_du_voisinage ,IFminima_locaux_____borne_superieure_relative_du_voisinage ) ) Bblock PRINT_ERREUR("les bornes inferieure et superieure du voisinage sont mal ordonnees"); Eblock ATes Bblock Eblock ETes begin_image /* ATTENTION, il est imperatif que 'begin_image' utilise la fonction 'DoIn(...)', ce qui */ /* signifie que les coordonnees sont traitees de facon croissante (de 'Xmin' a 'Xmax' et */ /* de 'Ymin' a 'Ymax'), car en effet, la fonction 'Pconvolution(...)' utilise cela pour */ /* desinitialiser si necessaire les spirales circulaires... */ Bblock DEFV(genere_Float,INIT(niveau_courant,loadF_point(imageA,X,Y))); /* Niveau courant au point courant... */ CALS(PFconvolution(imageA,imageA ,X,Y ,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ); /* Convolution au point {X,Y}. Ce calcul permet d'evaluer le minimum local... */ storeF_point(COND(IFINff(SOUS(niveau_courant,Pconvolution_____minimum_sur_la_spirale) ,IFminima_locaux_____borne_inferieure_relative_du_voisinage ,IFminima_locaux_____borne_superieure_relative_du_voisinage ) ,COND(IL_FAUT(IFminima_locaux_____marquer_les_points_minimaux_avec_le_niveau_courant) ,niveau_courant ,IFminima_locaux_____niveau_de_marquage_des_points_minimaux ) ,IFminima_locaux_____niveau_de_marquage_des_points_non_minimaux ) ,imageR ,X,Y ); /* Et on convolue point par point... */ Eblock end_image RETIF(imageR); Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* R E C H E R C H E D E S M A X I M A L O C A U X D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(genere_p,SINT(Imaxima_locaux_____niveau_de_marquage_des_points_non_maximaux,NOIR))); /* Niveau de marquage des points qui ne sont pas des maxima locaux... */ DEFV(Common,DEFV(Logical,SINT(Imaxima_locaux_____marquer_les_points_maximaux_avec_le_niveau_courant,VRAI))); DEFV(Common,DEFV(genere_p,SINT(Imaxima_locaux_____niveau_de_marquage_des_points_maximaux,BLANC))); /* Niveau de marquage des points qui sont des maxima locaux (introduit le 20040717102208). */ DEFV(Common,DEFV(Int,SINT(Imaxima_locaux_____borne_inferieure_relative_du_voisinage,ZERO))); DEFV(Common,DEFV(Int,SINT(Imaxima_locaux_____borne_superieure_relative_du_voisinage,ZERO))); /* Definition du voisinage d'un maximum local quelconque (introduit le 20040717090458). */ DEFV(Common,DEFV(FonctionP,POINTERp(Imaxima_locaux(imageR ,imageA ,niveaux_a_traiter,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ) ) ) /* Fonction introduite le 20040626104841... */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] convoluee par le noyau. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_a_traiter,COULEURS))); /* Definit les niveaux sur lesquels on doit faire la convolution par 'Pconvolution()'. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_cumulables,COULEURS))); /* Definit les niveaux cumulables lors du calcul de 'Pconvolution_____cumul_courant'. */ DEFV(Argument,DEFV(Int,nombre_de_points_du_noyau)); /* Nombre de points contenus dans le noyau, y compris son centre. */ DEFV(Argument,DEFV(Float,DTb0(noyau))); /* Noyau de convolution : il est defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ DEFV(Argument,DEFV(Logical,DTb0(inhibition_du_noyau))); /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ SPIRALE_VALIDATION; VALIDATION_DE_____nombre_de_points_du_noyau; /* Mis sous cette forme le 20211020181331... */ Test(IFGT(Imaxima_locaux_____borne_inferieure_relative_du_voisinage ,Imaxima_locaux_____borne_superieure_relative_du_voisinage ) ) Bblock PRINT_ERREUR("les bornes inferieure et superieure du voisinage sont mal ordonnees"); Eblock ATes Bblock Eblock ETes begin_image_AvecEditionProgression /* ATTENTION, il est imperatif que 'begin_image' utilise la fonction 'DoIn(...)', ce qui */ /* signifie que les coordonnees sont traitees de facon croissante (de 'Xmin' a 'Xmax' et */ /* de 'Ymin' a 'Ymax'), car en effet, la fonction 'Pconvolution(...)' utilise cela pour */ /* desinitialiser si necessaire les spirales circulaires... */ /* */ /* Le 20170520104209 a ete introduit "_AvecEditionProgression"... */ Bblock DEFV(genere_p,INIT(niveau_courant,load_point(imageA,X,Y))); /* Niveau courant au point courant... */ Test(EST_VRAI(ITb1(niveaux_a_traiter,INDX(niveau_courant,NOIR)))) Bblock /* Traitement des points a traiter... */ CALS(Pconvolution(imageA,imageA ,X,Y ,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ); /* Convolution au point {X,Y}. Ce calcul permet d'evaluer le maximum local... */ store_point(COND(IFINff(SOUS(FLOT(niveau_courant),Pconvolution_____maximum_sur_la_spirale) ,Imaxima_locaux_____borne_inferieure_relative_du_voisinage ,Imaxima_locaux_____borne_superieure_relative_du_voisinage ) ,COND(IL_FAUT(Imaxima_locaux_____marquer_les_points_maximaux_avec_le_niveau_courant) ,niveau_courant ,Imaxima_locaux_____niveau_de_marquage_des_points_maximaux ) ,Imaxima_locaux_____niveau_de_marquage_des_points_non_maximaux ) ,imageR ,X,Y ,FVARIABLE ); /* Et on convolue point par point... */ Eblock ATes Bblock store_point(niveau_courant ,imageR ,X,Y ,FVARIABLE ); /* Et on ne convolue pas lorsque le niveau courant n'est pas "traitable"... */ Eblock ETes Eblock end_image_AvecEditionProgression /* Le 20170520104209 a ete introduit "_AvecEditionProgression"... */ RETI(imageR); Eblock EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* R E C H E R C H E D E S M A X I M A L O C A U X D ' U N E I M A G E F L O T T A N T E : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(genere_Float,SINT(IFmaxima_locaux_____niveau_de_marquage_des_points_non_maximaux,FZERO))); /* Niveau de marquage des points qui ne sont pas des maxima locaux... */ DEFV(Common,DEFV(Logical,SINT(IFmaxima_locaux_____marquer_les_points_maximaux_avec_le_niveau_courant,VRAI))); DEFV(Common,DEFV(genere_Float,SINT(IFmaxima_locaux_____niveau_de_marquage_des_points_maximaux,FU))); /* Niveau de marquage des points qui sont des maxima locaux (introduit le 20040717102208). */ DEFV(Common,DEFV(Float,SINT(IFmaxima_locaux_____borne_inferieure_relative_du_voisinage,FZERO))); DEFV(Common,DEFV(Float,SINT(IFmaxima_locaux_____borne_superieure_relative_du_voisinage,FZERO))); /* Definition du voisinage d'un maximum local quelconque (introduit le 20040717090458). */ DEFV(Common,DEFV(FonctionF,POINTERF(IFmaxima_locaux(imageR ,imageA ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ) ) ) /* Fonction introduite le 20040626104841... */ DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] convoluee par le noyau. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Int,nombre_de_points_du_noyau)); /* Nombre de points contenus dans le noyau, y compris son centre. */ DEFV(Argument,DEFV(Float,DTb0(noyau))); /* Noyau de convolution : il est defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ DEFV(Argument,DEFV(Logical,DTb0(inhibition_du_noyau))); /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Logical,INIT(POINTERl(niveaux_cumulables),ADRESSE_NON_DEFINIE)); /* Juste pour eviter des problemes ci-apres avec 'PFconvolution(...)', mais a part cela */ /* inutile... */ /*..............................................................................................................................*/ SPIRALE_VALIDATION; VALIDATION_DE_____nombre_de_points_du_noyau; /* Mis sous cette forme le 20211020181331... */ Test(IFGT(IFmaxima_locaux_____borne_inferieure_relative_du_voisinage ,IFmaxima_locaux_____borne_superieure_relative_du_voisinage ) ) Bblock PRINT_ERREUR("les bornes inferieure et superieure du voisinage sont mal ordonnees"); Eblock ATes Bblock Eblock ETes begin_image /* ATTENTION, il est imperatif que 'begin_image' utilise la fonction 'DoIn(...)', ce qui */ /* signifie que les coordonnees sont traitees de facon croissante (de 'Xmin' a 'Xmax' et */ /* de 'Ymin' a 'Ymax'), car en effet, la fonction 'Pconvolution(...)' utilise cela pour */ /* desinitialiser si necessaire les spirales circulaires... */ Bblock DEFV(genere_Float,INIT(niveau_courant,loadF_point(imageA,X,Y))); /* Niveau courant au point courant... */ CALS(PFconvolution(imageA,imageA ,X,Y ,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ); /* Convolution au point {X,Y}. Ce calcul permet d'evaluer le maximum local... */ storeF_point(COND(IFINff(SOUS(niveau_courant,Pconvolution_____maximum_sur_la_spirale) ,IFmaxima_locaux_____borne_inferieure_relative_du_voisinage ,IFmaxima_locaux_____borne_superieure_relative_du_voisinage ) ,COND(IL_FAUT(IFmaxima_locaux_____marquer_les_points_maximaux_avec_le_niveau_courant) ,niveau_courant ,IFmaxima_locaux_____niveau_de_marquage_des_points_maximaux ) ,IFmaxima_locaux_____niveau_de_marquage_des_points_non_maximaux ) ,imageR ,X,Y ); /* Et on convolue point par point... */ Eblock end_image RETIF(imageR); Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* G E N E R A T I O N D ' U N N O Y A U D E C O N V O L U T I O N A L ' A I D E D ' U N E I M A G E : */ /* */ /* */ /* Nota tres important : */ /* */ /* Rappelons d'abord qu'en notant '0' */ /* le numero du premier point d'une */ /* spirale (ou "centre"), le parcours */ /* de celle-ci se fait de la facon */ /* suivante : */ /* */ /* */ /* 4 -- 3 -- 2 */ /* | | . */ /* | | . */ /* 5 0 -- 1 . */ /* | | */ /* | | */ /* 6 -- 7 -- 8 -- 9 */ /* */ /* */ /* Pour generer un noyau, on partira */ /* en general d'une image reduite de la */ /* facon suivante : */ /* */ /* Std */ /* $xci/reduction$X A=$xiio/GAUSS.8110 centrer=VRAI ... */ /* */ /* */ /* Cette reduction de moitie faite a partir */ /* d'une image aux dimensions puissance de 2 */ /* ('Std') donne a l'arrivee une petite image */ /* centree (futur noyau) dont les dimensions */ /* sont aussi une puissance de 2. Or en general */ /* un noyau doit avoir un point central, et donc */ /* avoir des dimensions impaires. Prenons l'exemple */ /* de sept reductions successives ; l'image "noyau" */ /* a donc une dimension de 4 par 4 (=512/128, puisque */ /* 2 a la puissance 7 vaut 128). Le centre de l'image */ /* (Xcentre,Ycentre) etant dans ce cas le point de */ /* coordonnees (256,256), on aura le tableau (ou '1' */ /* designe le premier point 'PREMIER_POINT' du noyau) : */ /* */ /* */ /* 17=====16=====15=====14=====13 */ /* || || */ /* * * * * * * * * * * * * * * * || */ /* * /||////////////////////// * || */ /* * /18/////05=====04=====03/ * 12 */ /* * /||/////||////////////||/ * || */ /* * /||/////||////////////||/ * || */ /* * /||/////||////////////||/ * || */ /* * /19/////06/////01=====02/ * 11 */ /* * /||/////||/////////////// * || .. */ /* * /||/////||//+//////////// * || .. */ /* * /||/////||/////////////// * || .. */ /* * /20/////07=====08=====09==*==10 27 */ /* * /||////////////////////// * || */ /* * /||////////////////////// * || */ /* * /||////////////////////// * || */ /* * /21=====22=====23=====24==*==25=====26 */ /* * ///////////////////////// * */ /* * * * * * * * * * * * * * * * */ /* */ /* */ /* Ainsi, l'image "noyau" materialisee par des "*" */ /* n'a pas de centre (indique par un "+"), et dans */ /* le cas presente ci-dessus, il vaudrait */ /* mieux se contenter d'un noyau 3x3, a */ /* condition que les 9 valeurs associees */ /* correspondent bien a ce que l'on attend */ /* (par exemple, que le point '1' soit le */ /* maximum des 9 valeurs, ou encore qu'il */ /* soit pour eux un centre de symetrie...). */ /* */ /* Enfin, comme le montre clairement la figure, */ /* un noyau 5x5 entrainerait l'introduction de */ /* valeurs nulles dans le noyau (pour les points */ /* 10 a 17, et 25). */ /* */ /* Tout ceci donc pour expliquer pourquoi au */ /* lieu de considerer un point, c'est en fait une */ /* moyenne sur 4 points qui est faite : par exemple */ /* le point '1' sera remplace par la moyenne des */ /* points '1', '6', '7' et '8'... */ /* */ /*************************************************************************************************************************************/ #define FONCTION_DE_CONVOLUTION(valeur) \ NEUT(valeur) \ /* A priori, on prend une fonction neutre... */ BFonctionI DEFV(Common,DEFV(Positive,SINT(CALCUL_D_UN_NOYAU_DE_CONVOLUTION_VARIABLE_____Pnoyau_nombre_de_points_sautes ,NOMBRE_DE_POINTS_SAUTES_SUR_LA_SPIRALE ) ) ); /* Afin de pouvoir sauter des points sur la spirale utilisee pour initialiser un noyau de */ /* convolution par 'CALCUL_D_UN_NOYAU_DE_CONVOLUTION_VARIABLE(...)'. */ #define X_DE_DEPART_POUR_INITIALISER_UN_NOYAU_DE_CONVOLUTION_VARIABLE \ Xcentre #define Y_DE_DEPART_POUR_INITIALISER_UN_NOYAU_DE_CONVOLUTION_VARIABLE \ Ycentre /* Pour definir le centre de la spirale definissant un noyau de convolution variable... */ DEFV(Common,DEFV(Logical,SINT(CALCUL_D_UN_NOYAU_DE_CONVOLUTION_VARIABLE_____editer_les_messages_du_calcul ,EDITER_LES_MESSAGES_DU_CALCUL_D_UN_NOYAU_DE_CONVOLUTION_VARIABLE ) ) ); /* Afin de savoir s'il faut editer ou pas les messages d'erreur de generation d'un */ /* noyau de convolution variable... */ #define CALCUL_D_UN_NOYAU_DE_CONVOLUTION_VARIABLE(noyau \ ,inhibition_du_noyau \ ,definition_noyau \ ,inhibition_noyau \ ,seuil \ ,nombre_de_points \ ,X_depart \ ,Y_depart \ ,saut \ ) \ Bblock \ DEFV(Int,INIT(X_courant,X_depart)); \ /* Abscisse courante initialisee sur le point de depart, */ \ DEFV(Int,INIT(Y_courant,Y_depart)); \ /* Ordonnee courante initialisee sur le point de depart. */ \ SPIRALE_DEFINITION \ /* Donnees de generation d'une spirale d'initialisation d'un noyau... */ \ DEFV(Int,INIT(index_d_initialisation_du_noyau,UNDEF)); \ /* Index d'initialisation du noyau. */ \ SPIRALE_VALIDATION; \ /* Validation des pas de parcours (pasX,pasY) des images. */ \ \ Test(IFEXff(NOMBRE_DE_POINTS_EFFECTIF_D_UN_NOYAU_DE_CONVOLUTION_PARCOURU_CIRCULAIREMENT(nombre_de_points) \ ,UN \ ,TAILLE_MAXIMALE_D_UN_NOYAU_DE_CONVOLUTION \ ) \ ) \ Bblock \ PRINT_ERREUR("le nombre de points du noyau de convolution est bizarre"); \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ DoIn(index_d_initialisation_du_noyau \ ,PREMIER_POINT \ ,LSTX(PREMIER_POINT \ ,NOMBRE_DE_POINTS_EFFECTIF_D_UN_NOYAU_DE_CONVOLUTION_PARCOURU_CIRCULAIREMENT(nombre_de_points) \ ) \ ,I \ ) \ Bblock \ Test(TOUJOURS_FAUX) \ Bblock \ /* Ancienne version ou l'on prend un point unique et ou l'on aimerait tant disposer de */ \ /* puissances de 2 impaires... Je la conserve parce que je n'aime pas jeter... */ \ EGAL(ITb1(noyau,INDX(index_d_initialisation_du_noyau,PREMIER_POINT)) \ ,FONCTION_DE_CONVOLUTION(______NORMALISE_NIVEAU(load_point_valide(definition_noyau \ ,X_courant \ ,Y_courant \ ) \ ) \ ) \ ); \ /* Initialisation du noyau de convolution a partir d'une image donnee... */ \ Eblock \ ATes \ Bblock \ /* Nouvelle version ou l'on fait la moyenne sur 4 points, telle que pour le point '1' cette */ \ /* moyenne "entoure" le centre de l'image... */ \ Test(IFET(IL_FAUT(CALCUL_D_UN_NOYAU_DE_CONVOLUTION_VARIABLE_____editer_les_messages_du_calcul) \ ,IFOU(IFLE(Xcentre,MOYE(Xmin,Xmax)),IFLE(Ycentre,MOYE(Ymin,Ymax))) \ ) \ ) \ /* On notera que la position de ce test n'est pas tres optimisee, puisqu'il est effectue a */ \ /* chaque iteration du 'DoIn(...)', mais qu'il en est ainsi parce que l'on est a l'interieur */ \ /* d'un test "inconditionnel" : */ \ /* */ \ /* Test(TOUJOURS_FAUX) */ \ /* */ \ /* Sortir donc ce test non optimise du 'DoIn(...)' voudrait dire le mettre a l'interieur */ \ /* d'un test "inconditionnel" complementaire du precedent : */ \ /* */ \ /* Test(TOUJOURS_VRAI) */ \ /* */ \ /* ce qui compliquerait eventuellement l'inversion logique pour revenir a la situation */ \ /* anterieure (celle ou l'on ne faisait pas le 'MOY4(...)'). */ \ Bblock \ PRINT_ERREUR("'Xcentre' et 'Ycentre' sont incompatibles avec les arguments de 'MOY4(...)'"); \ /* On notera que s'il y a egalite entre les centres ('X' et 'Y') et les 'MOYE(...)', il faut */ \ /* revenir a la version qui n'utilise pas 'MOY4(...)', et que s'il y a inferiorite stricte, */ \ /* il faut changer la position des quatre elements dont on calcule la 'MOY4(...)'... */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ EGAL(ITb1(noyau,INDX(index_d_initialisation_du_noyau,PREMIER_POINT)) \ ,FONCTION_DE_CONVOLUTION(MOY4(______NORMALISE_NIVEAU(load_point_valide(definition_noyau \ ,NEUT(X_courant) \ ,NEUT(Y_courant) \ ) \ ) \ ,______NORMALISE_NIVEAU(load_point_valide(definition_noyau \ ,PREX(X_courant) \ ,PREY(Y_courant) \ ) \ ) \ ,______NORMALISE_NIVEAU(load_point_valide(definition_noyau \ ,PREX(X_courant) \ ,NEUT(Y_courant) \ ) \ ) \ ,______NORMALISE_NIVEAU(load_point_valide(definition_noyau \ ,NEUT(X_courant) \ ,PREY(Y_courant) \ ) \ ) \ ) \ ) \ ); \ /* Initialisation du noyau de convolution a partir d'une image donnee... */ \ Eblock \ ETes \ \ Test(IFGE(load_point_valide(inhibition_noyau,X_courant,Y_courant),seuil)) \ /* On notera l'utilisation de 'IFGE(...)' ce qui permet de rendre 'ACTIF' ou 'INACTIF' les */ \ /* eventuels points hors-image (voir 'load_point_valide(...)') en jouant uniquement sur le */ \ /* seuil (par exemple, le seuil 'NOIR' rendra 'ACTIF' les points hors-images, alors que le */ \ /* seuil 'SUCN(NOIR)' les rendra 'INACTIF'). On verra aussi dans 'v $xrq/nucleon.LN$I' un */ \ /* exemple d'utilisation, ou le fait que le test soit 'IFGE(...)' est fondamental... */ \ Bblock \ EGAL(ITb1(inhibition_du_noyau,INDX(index_d_initialisation_du_noyau,PREMIER_POINT)),ACTIF); \ /* Tous ses elements etant actifs lorsque l'on est au-dessus du seuil (ou egal a celui-ci), */ \ Eblock \ ATes \ Bblock \ EGAL(ITb1(inhibition_du_noyau,INDX(index_d_initialisation_du_noyau,PREMIER_POINT)),INACTIF); \ /* Et inactifs en dessous... */ \ Eblock \ ETes \ \ SPIRALE_DEPLACEMENT_ET_PARCOURS(X_courant,Y_courant,saut); \ /* Deplacement du point courant de la spirale... */ \ Eblock \ EDoI \ Eblock \ /* Calcul a partir d'une image d'un noyau de convolution variable... */ DEFV(Common,DEFV(FonctionI,Igeneration_d_un_noyau_de_convolution(noyau ,inhibition_du_noyau ,nombre_de_points_du_noyau_de_convolution ,ARGUMENT_POINTERs(centre_de_la_spirale_de_definition_du_noyau) ,saut_dans_la_spirale ,image_definissant_la_valeur_du_noyau ,image_inhibant_la_valeur_du_noyau ,seuil_d_inhibition_du_noyau ) ) ) DEFV(Argument,DEFV(Float,DTb0(noyau))); /* Noyau de convolution Resultat defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ DEFV(Argument,DEFV(Logical,DTb0(inhibition_du_noyau))); /* Liste d'inhibition Resultat qui precise pour chaque element du noyau s'il est 'ACTIF' (a */ /* utiliser dans les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ DEFV(Argument,DEFV(Int,nombre_de_points_du_noyau_de_convolution)); /* Nombre de points a donner au noyau de convolution. */ DEFV(Argument,DEFV(pointF_2D,POINTERs(centre_de_la_spirale_de_definition_du_noyau))); /* Coordonnees du centre de la spirale dans 'image_definissant_la_valeur_du_noyau'. */ DEFV(Argument,DEFV(Positive,saut_dans_la_spirale)); /* Afin de pouvoir sauter des points sur la spirale utilisee pour initialiser un noyau de */ /* convolution par 'CALCUL_D_UN_NOYAU_DE_CONVOLUTION_VARIABLE(...)'. */ DEFV(Argument,DEFV(image,image_definissant_la_valeur_du_noyau)); /* Image Argument qui va etre parcourue a l'aide d'une spirale carree pour definir le noyau */ /* de convolution 'noyau'. */ DEFV(Argument,DEFV(image,image_inhibant_la_valeur_du_noyau)); DEFV(Argument,DEFV(genere_p,seuil_d_inhibition_du_noyau)); /* Image Argument qui va etre parcourue a l'aide d'une spirale carree pour inhiber */ /* (eventuellement) le noyau de convolution, en fonction du seuil associe... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock INIT_ERROR; /* ATTENTION : 'INIT_ERROR' est mis en tete des variables locales au cas ou des couples */ /* ('BDEFV','EDEFV') suivraient... */ /*..............................................................................................................................*/ CALCUL_D_UN_NOYAU_DE_CONVOLUTION_VARIABLE(noyau ,inhibition_du_noyau ,image_definissant_la_valeur_du_noyau ,image_inhibant_la_valeur_du_noyau,seuil_d_inhibition_du_noyau ,nombre_de_points_du_noyau_de_convolution ,_cDENORMALISE_OX(ASI1(centre_de_la_spirale_de_definition_du_noyau,x)) ,_cDENORMALISE_OY(ASI1(centre_de_la_spirale_de_definition_du_noyau,y)) ,saut_dans_la_spirale ); /* Calcul du noyau de convolution 'noyau' a partir des deux images Argument... */ RETU_ERROR; Eblock EFonctionI /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* C O N V O L U T I O N D ' U N E I M A G E P A R U N N O Y A U V A R I A B L E : : */ /* */ /*************************************************************************************************************************************/ #define NOMBRE_DE_POINTS(niveau) \ TRON(INTE(MUL2(facteur_du_nombre_de_points,FLOT(NIVR(niveau)))),UN,TAILLE_MAXIMALE_D_UN_NOYAU_DE_CONVOLUTION) \ /* Convertit un niveau(X,Y) en un nombre de points pour le noyau courant. */ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Iconvolution_variable(imageR ,facteur_multiplicatif ,imageA ,niveaux_a_traiter,niveaux_cumulables ,facteur_du_nombre_de_points ,image_donnant_le_nombre_de_points_du_noyau ,image_definissant_la_valeur_du_noyau ,image_inhibant_la_valeur_du_noyau ,seuil_d_inhibition_du_noyau ) ) ) ) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] convoluee par un */ /* noyau dont le nombre de points est variable et donne par le produit : */ /* (facteur_du_nombre_de_points)*(image_donnant_le_nombre_de_points_du_noyau[X][Y]). */ DEFV(Argument,DEFV(Float,facteur_multiplicatif)); /* Facteur multiplicatif du produit de convolution en chaque point {X,Y}. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_a_traiter,COULEURS))); /* Definit les niveaux sur lesquels on doit faire la convolution par 'Pconvolution()'. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_cumulables,COULEURS))); /* Definit les niveaux cumulables lors du calcul de 'Pconvolution_____cumul_courant'. */ DEFV(Argument,DEFV(Float,facteur_du_nombre_de_points)); /* Pour calculer le nombre de points contenus dans le noyau, y compris */ /* son centre, au point courant {X,Y}. */ DEFV(Argument,DEFV(image,image_donnant_le_nombre_de_points_du_noyau)); /* Image dont le point courant {X,Y} donne au facteur 'facteur_du_nombre_de_points' */ /* le nombre d'elements du noyau de convolution courant pour le point {X,Y}. */ DEFV(Argument,DEFV(image,image_definissant_la_valeur_du_noyau)); /* Image dont le centre va definir la valeur du noyau de convolution. */ DEFV(Argument,DEFV(image,image_inhibant_la_valeur_du_noyau)); DEFV(Argument,DEFV(genere_p,seuil_d_inhibition_du_noyau)); /* Image dont le centre va inhiber (eventuellement) le noyau de convolution, en fonction */ /* du seuil correspondant... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Int,INIT(index,UNDEF)); /* Index d'initialisation du noyau. */ DEFV(Float,DTb1(noyau,TAILLE_MAXIMALE_D_UN_NOYAU_DE_CONVOLUTION)); /* Noyau de convolution : il est defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ DEFV(Logical,DTb1(inhibition_du_noyau,TAILLE_MAXIMALE_D_UN_NOYAU_DE_CONVOLUTION)); /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ /*..............................................................................................................................*/ SPIRALE_VALIDATION; VALIDATION_DE_____facteur_du_nombre_de_points; /* Mis sous cette forme le 20211020181331... */ Test(IFGT(NOMBRE_DE_POINTS(BLANC),TAILLE_MAXIMALE_D_UN_NOYAU_DE_CONVOLUTION)) Bblock PRINT_ERREUR("la taille du noyau de convolution variable est trop grande (1)"); Eblock ATes Bblock Eblock ETes CALCUL_D_UN_NOYAU_DE_CONVOLUTION_VARIABLE(noyau ,inhibition_du_noyau ,image_definissant_la_valeur_du_noyau ,image_inhibant_la_valeur_du_noyau ,seuil_d_inhibition_du_noyau ,NOMBRE_DE_POINTS(BLANC) ,X_DE_DEPART_POUR_INITIALISER_UN_NOYAU_DE_CONVOLUTION_VARIABLE ,Y_DE_DEPART_POUR_INITIALISER_UN_NOYAU_DE_CONVOLUTION_VARIABLE ,CALCUL_D_UN_NOYAU_DE_CONVOLUTION_VARIABLE_____Pnoyau_nombre_de_points_sautes ); /* Initialisation du noyau de convolution a partir d'une spirale partant du centre de */ /* l'image 'image_definissant_le_noyau'... */ /* */ /* ATTENTION, on verra avec profit les commentaires contenus dans 'v $xiii/di_image$FON' */ /* relatifs a la fonction 'Igeneration_d_un_noyau_de_convolution(...)' au sujet des rapports */ /* entre la taille des images et la "forme" des noyaux... */ begin_image /* ATTENTION, il est imperatif que 'begin_image' utilise la fonction 'DoIn(...)', ce qui */ /* signifie que les coordonnees sont traitees de facon croissante (de 'Xmin' a 'Xmax' et */ /* de 'Ymin' a 'Ymax'), car en effet, la fonction 'Pconvolution(...)' utilise cela pour */ /* desinitialiser si necessaire les spirales circulaires... */ Bblock DEFV(genere_p,INIT(niveau_courant,load_point(imageA,X,Y))); /* Niveau courant au point courant... */ Test(EST_VRAI(ITb1(niveaux_a_traiter,INDX(niveau_courant,NOIR)))) Bblock /* Traitement des points a traiter... */ store_point(GENP(NIVA(MUL2(facteur_multiplicatif ,Pconvolution(imageA,imageA ,X,Y ,niveaux_cumulables ,NOMBRE_DE_POINTS(load_point(image_donnant_le_nombre_de_points_du_noyau,X,Y)) ,noyau,inhibition_du_noyau ) ) ) ) ,imageR ,X,Y ,FVARIABLE ); /* Et on convolue point par point avec le noyau (1,1,1,...) de longueur */ /* variable donnee par 'image_donnant_le_nombre_de_points_du_noyau'... */ Eblock ATes Bblock store_point(GENP(NIVA(MUL2(facteur_multiplicatif,NIVR(niveau_courant)))) ,imageR ,X,Y ,FVARIABLE ); /* Et on ne convolue pas lorsque le niveau courant n'est pas "traitable"... */ Eblock ETes Eblock end_image RETI(imageR); Eblock EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* C O N V O L U T I O N F L O T T A N T E D ' U N E I M A G E P A R U N N O Y A U V A R I A B L E : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Logical,SINT(IFconvolution_variable_____compatibilite_20151208,FAUX))); /* Permet de generer des images suivant la methode anterieure au 20151208151604 en ce qui */ /* concerne le cas ou un noyau de convolution n'a aucun point... */ DEFV(Common,DEFV(FonctionF,POINTERF(IFconvolution_variable(imageR ,facteur_multiplicatif ,imageA ,niveaux_a_traiter,niveaux_cumulables ,facteur_du_nombre_de_points ,image_donnant_le_nombre_de_points_du_noyau ,image_definissant_la_valeur_du_noyau ,image_inhibant_la_valeur_du_noyau ,seuil_d_inhibition_du_noyau ) ) ) ) DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] convoluee par par un */ /* noyau dont le nombre de points est variable et donne par le produit : */ /* (facteur_du_nombre_de_points)*(image_donnant_le_nombre_de_points_du_noyau[X][Y]). */ DEFV(Argument,DEFV(Float,facteur_multiplicatif)); /* Facteur multiplicatif du produit de convolution en chaque point {X,Y}. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_a_traiter,COULEURS))); /* Definit les niveaux sur lesquels on doit faire la convolution par 'Pconvolution()'. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_cumulables,COULEURS))); /* Definit les niveaux cumulables lors du calcul de 'Pconvolution_____cumul_courant'. */ DEFV(Argument,DEFV(Float,facteur_du_nombre_de_points)); /* Pour calculer le nombre de points contenus dans le noyau, y compris */ /* son centre, au point courant {X,Y}. */ DEFV(Argument,DEFV(image,image_donnant_le_nombre_de_points_du_noyau)); /* Image dont le point courant {X,Y} donne au facteur 'facteur_du_nombre_de_points' */ /* le nombre d'elements du noyau de convolution courant pour le point {X,Y}. */ DEFV(Argument,DEFV(image,image_definissant_la_valeur_du_noyau)); /* Image dont le centre va definir la valeur du noyau de convolution. */ DEFV(Argument,DEFV(image,image_inhibant_la_valeur_du_noyau)); DEFV(Argument,DEFV(genere_p,seuil_d_inhibition_du_noyau)); /* Image dont le centre va inhiber (eventuellement) le noyau de convolution, en fonction */ /* du seuil correspondant... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Int,INIT(index,UNDEF)); /* Index d'initialisation du noyau. */ DEFV(Float,DTb1(noyau,TAILLE_MAXIMALE_D_UN_NOYAU_DE_CONVOLUTION)); /* Noyau de convolution : il est defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ DEFV(Logical,DTb1(inhibition_du_noyau,TAILLE_MAXIMALE_D_UN_NOYAU_DE_CONVOLUTION)); /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ /*..............................................................................................................................*/ SPIRALE_VALIDATION; VALIDATION_DE_____facteur_du_nombre_de_points; /* Mis sous cette forme le 20211020181331... */ Test(IFGT(NOMBRE_DE_POINTS(BLANC),TAILLE_MAXIMALE_D_UN_NOYAU_DE_CONVOLUTION)) Bblock PRINT_ERREUR("la taille du noyau de convolution variable est trop grande (2)"); Eblock ATes Bblock Eblock ETes CALCUL_D_UN_NOYAU_DE_CONVOLUTION_VARIABLE(noyau ,inhibition_du_noyau ,image_definissant_la_valeur_du_noyau ,image_inhibant_la_valeur_du_noyau ,seuil_d_inhibition_du_noyau ,NOMBRE_DE_POINTS(BLANC) ,X_DE_DEPART_POUR_INITIALISER_UN_NOYAU_DE_CONVOLUTION_VARIABLE ,Y_DE_DEPART_POUR_INITIALISER_UN_NOYAU_DE_CONVOLUTION_VARIABLE ,CALCUL_D_UN_NOYAU_DE_CONVOLUTION_VARIABLE_____Pnoyau_nombre_de_points_sautes ); /* Initialisation du noyau de convolution a partir d'une spirale partant du centre de */ /* l'image 'image_definissant_le_noyau'... */ /* */ /* ATTENTION, on verra avec profit les commentaires contenus dans 'v $xiii/di_image$FON' */ /* relatifs a la fonction 'Igeneration_d_un_noyau_de_convolution(...)' au sujet des rapports */ /* entre la taille des images et la "forme" des noyaux... */ begin_image /* ATTENTION, il est imperatif que 'begin_image' utilise la fonction 'DoIn(...)', ce qui */ /* signifie que les coordonnees sont traitees de facon croissante (de 'Xmin' a 'Xmax' et */ /* de 'Ymin' a 'Ymax'), car en effet, la fonction 'Pconvolution(...)' utilise cela pour */ /* desinitialiser si necessaire les spirales circulaires... */ Bblock DEFV(genere_p,INIT(niveau_courant,load_point(imageA,X,Y))); DEFV(genere_Float,INIT(niveau_courant_par_defaut,FLOT__UNDEF)); EGAL(niveau_courant_par_defaut,NIVA(MUL2(facteur_multiplicatif,FLOT(NIVR(niveau_courant))))); /* Niveau courant au point courant... */ Test(EST_VRAI(ITb1(niveaux_a_traiter,INDX(niveau_courant,NOIR)))) Bblock /* Traitement des points a traiter... */ DEFV(genere_p,INIT(nombre_de_points_du_noyau,load_point(image_donnant_le_nombre_de_points_du_noyau,X,Y))); Test(IFOU(IL_FAUT(IFconvolution_variable_____compatibilite_20151208) ,IFET(IL_NE_FAUT_PAS(IFconvolution_variable_____compatibilite_20151208) ,IZGT(nombre_de_points_du_noyau) ) ) ) /* A compter du 20151208151604 et par defaut, si le nombre local de points du noyau */ /* est nul, la convolution est neutre... */ Bblock storeF_point(NIVA(MUL2(facteur_multiplicatif ,Pconvolution(imageA,imageA ,X,Y ,niveaux_cumulables ,NOMBRE_DE_POINTS(nombre_de_points_du_noyau) ,noyau,inhibition_du_noyau ) ) ) ,imageR ,X,Y ); /* Et on convolue point par point avec le noyau (1,1,1,...) de longueur */ /* variable donnee par 'image_donnant_le_nombre_de_points_du_noyau'... */ Eblock ATes Bblock storeF_point(niveau_courant_par_defaut ,imageR ,X,Y ); /* Et on transfere "simplement" le point {X,Y}... */ Eblock ETes Eblock ATes Bblock storeF_point(niveau_courant_par_defaut ,imageR ,X,Y ); /* Et on ne convolue pas lorsque le niveau courant n'est pas "traitable"... */ Eblock ETes Eblock end_image RETIF(imageR); Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* C O N V O L U T I O N F L O T T A N T E D ' U N E I M A G E F L O T T A N T E */ /* P A R U N N O Y A U V A R I A B L E : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Logical,SINT(IFFconvolution_variable_____compatibilite_20151208,FAUX))); /* Par "symetrie" avec 'IFconvolution_variable_____compatibilite_20151208'... */ DEFV(Common,DEFV(FonctionF,POINTERF(IFFconvolution_variable(imageR ,facteur_multiplicatif ,imageA ,niveaux_a_traiter,niveaux_cumulables ,facteur_du_nombre_de_points ,image_donnant_le_nombre_de_points_du_noyau ,image_definissant_la_valeur_du_noyau ,image_inhibant_la_valeur_du_noyau ,seuil_d_inhibition_du_noyau ) ) ) ) /* Fonction introduite le 20240826120244... */ DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] convoluee par par un */ /* noyau dont le nombre de points est variable et donne par le produit : */ /* (facteur_du_nombre_de_points)*(image_donnant_le_nombre_de_points_du_noyau[X][Y]). */ DEFV(Argument,DEFV(Float,facteur_multiplicatif)); /* Facteur multiplicatif du produit de convolution en chaque point {X,Y}. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_a_traiter,COULEURS))); /* Definit les niveaux sur lesquels on doit faire la convolution par 'Pconvolution()'. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_cumulables,COULEURS))); /* Definit les niveaux cumulables lors du calcul de 'Pconvolution_____cumul_courant'. */ DEFV(Argument,DEFV(Float,facteur_du_nombre_de_points)); /* Pour calculer le nombre de points contenus dans le noyau, y compris */ /* son centre, au point courant {X,Y}. */ DEFV(Argument,DEFV(image,image_donnant_le_nombre_de_points_du_noyau)); /* Image dont le point courant {X,Y} donne au facteur 'facteur_du_nombre_de_points' */ /* le nombre d'elements du noyau de convolution courant pour le point {X,Y}. */ DEFV(Argument,DEFV(image,image_definissant_la_valeur_du_noyau)); /* Image dont le centre va definir la valeur du noyau de convolution. */ DEFV(Argument,DEFV(image,image_inhibant_la_valeur_du_noyau)); DEFV(Argument,DEFV(genere_p,seuil_d_inhibition_du_noyau)); /* Image dont le centre va inhiber (eventuellement) le noyau de convolution, en fonction */ /* du seuil correspondant... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Int,INIT(index,UNDEF)); /* Index d'initialisation du noyau. */ DEFV(Float,DTb1(noyau,TAILLE_MAXIMALE_D_UN_NOYAU_DE_CONVOLUTION)); /* Noyau de convolution : il est defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ DEFV(Logical,DTb1(inhibition_du_noyau,TAILLE_MAXIMALE_D_UN_NOYAU_DE_CONVOLUTION)); /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ /*..............................................................................................................................*/ SPIRALE_VALIDATION; VALIDATION_DE_____facteur_du_nombre_de_points; Test(IFGT(NOMBRE_DE_POINTS(BLANC),TAILLE_MAXIMALE_D_UN_NOYAU_DE_CONVOLUTION)) Bblock PRINT_ERREUR("la taille du noyau de convolution variable est trop grande (2)"); Eblock ATes Bblock Eblock ETes CALCUL_D_UN_NOYAU_DE_CONVOLUTION_VARIABLE(noyau ,inhibition_du_noyau ,image_definissant_la_valeur_du_noyau ,image_inhibant_la_valeur_du_noyau ,seuil_d_inhibition_du_noyau ,NOMBRE_DE_POINTS(BLANC) ,X_DE_DEPART_POUR_INITIALISER_UN_NOYAU_DE_CONVOLUTION_VARIABLE ,Y_DE_DEPART_POUR_INITIALISER_UN_NOYAU_DE_CONVOLUTION_VARIABLE ,CALCUL_D_UN_NOYAU_DE_CONVOLUTION_VARIABLE_____Pnoyau_nombre_de_points_sautes ); /* Initialisation du noyau de convolution a partir d'une spirale partant du centre de */ /* l'image 'image_definissant_le_noyau'... */ /* */ /* ATTENTION, on verra avec profit les commentaires contenus dans 'v $xiii/di_image$FON' */ /* relatifs a la fonction 'Igeneration_d_un_noyau_de_convolution(...)' au sujet des rapports */ /* entre la taille des images et la "forme" des noyaux... */ begin_image /* ATTENTION, il est imperatif que 'begin_image' utilise la fonction 'DoIn(...)', ce qui */ /* signifie que les coordonnees sont traitees de facon croissante (de 'Xmin' a 'Xmax' et */ /* de 'Ymin' a 'Ymax'), car en effet, la fonction 'Pconvolution(...)' utilise cela pour */ /* desinitialiser si necessaire les spirales circulaires... */ Bblock DEFV(genere_Float,INIT(niveau_courant,loadF_point(imageA,X,Y))); DEFV(genere_Float,INIT(niveau_courant_par_defaut,FLOT__UNDEF)); EGAL(niveau_courant_par_defaut,MUL2(facteur_multiplicatif,niveau_courant)); /* Niveau courant au point courant... */ Test(EST_VRAI(ITb1(niveaux_a_traiter,INDX(niveau_courant,NOIR)))) Bblock /* Traitement des points a traiter... */ DEFV(genere_p,INIT(nombre_de_points_du_noyau,load_point(image_donnant_le_nombre_de_points_du_noyau,X,Y))); Test(IFOU(IL_FAUT(IFFconvolution_variable_____compatibilite_20151208) ,IFET(IL_NE_FAUT_PAS(IFFconvolution_variable_____compatibilite_20151208) ,IZGT(nombre_de_points_du_noyau) ) ) ) Bblock storeF_point(NIVA(MUL2(facteur_multiplicatif ,PFconvolution(imageA,imageA ,X,Y ,niveaux_cumulables ,NOMBRE_DE_POINTS(nombre_de_points_du_noyau) ,noyau,inhibition_du_noyau ) ) ) ,imageR ,X,Y ); /* Et on convolue point par point avec le noyau (1,1,1,...) de longueur */ /* variable donnee par 'image_donnant_le_nombre_de_points_du_noyau'... */ Eblock ATes Bblock storeF_point(niveau_courant_par_defaut ,imageR ,X,Y ); /* Et on transfere "simplement" le point {X,Y}... */ Eblock ETes Eblock ATes Bblock storeF_point(niveau_courant_par_defaut ,imageR ,X,Y ); /* Et on ne convolue pas lorsque le niveau courant n'est pas "traitable"... */ Eblock ETes Eblock end_image RETIF(imageR); Eblock EFonctionF #undef Y_DE_DEPART_POUR_INITIALISER_UN_NOYAU_DE_CONVOLUTION_VARIABLE #undef X_DE_DEPART_POUR_INITIALISER_UN_NOYAU_DE_CONVOLUTION_VARIABLE /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* C O N V O L U T I O N D ' U N E I M A G E P A R U N N O Y A U V A R I A B L E */ /* E T R E N O R M A L I S A T I O N : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Iconvolution_variable_avec_renormalisation(imageR ,facteur_multiplicatif ,imageA ,niveaux_a_traiter,niveaux_cumulables ,facteur_du_nombre_de_points ,image_donnant_le_nombre_de_points_du_noyau ,image_definissant_la_valeur_du_noyau ,image_inhibant_la_valeur_du_noyau ,seuil_d_inhibition_du_noyau ,renormaliser_les_niveaux ) ) ) ) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] convoluee par un */ /* noyau dont le nombre de points est variable et donne par le produit : */ /* (facteur_du_nombre_de_points)*(image_donnant_le_nombre_de_points_du_noyau[X][Y]). */ DEFV(Argument,DEFV(Float,facteur_multiplicatif)); /* Facteur multiplicatif du produit de convolution en chaque point {X,Y}. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_a_traiter,COULEURS))); /* Definit les niveaux sur lesquels on doit faire la convolution par 'Pconvolution()'. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_cumulables,COULEURS))); /* Definit les niveaux cumulables lors du calcul de 'Pconvolution_____cumul_courant'. */ DEFV(Argument,DEFV(Float,facteur_du_nombre_de_points)); /* Pour calculer le nombre de points contenus dans le noyau, y compris */ /* son centre, au point courant {X,Y}. */ DEFV(Argument,DEFV(image,image_donnant_le_nombre_de_points_du_noyau)); /* Image dont le point courant {X,Y} donne au facteur 'facteur_du_nombre_de_points' */ /* le nombre d'elements du noyau de convolution courant pour le point {X,Y}. */ DEFV(Argument,DEFV(image,image_definissant_la_valeur_du_noyau)); /* Image dont le centre va definir la valeur du noyau de convolution. */ DEFV(Argument,DEFV(image,image_inhibant_la_valeur_du_noyau)); DEFV(Argument,DEFV(genere_p,seuil_d_inhibition_du_noyau)); /* Image dont le centre va inhiber (eventuellement) le noyau de convolution, en fonction */ /* du seuil correspondant... */ DEFV(Argument,DEFV(Logical,renormaliser_les_niveaux)); /* Cet indicateur precise s'il faut renormaliser les niveaux ('VRAI') ou les laisser */ /* inchanger ('FAUX'). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock BDEFV(imageF,imageR_flottante); /* Image flottante Resultat apres la convolution. */ /*..............................................................................................................................*/ VALIDATION_DE_____facteur_du_nombre_de_points; /* Mis sous cette forme le 20211020181331... */ CALS(IFconvolution_variable(imageR_flottante ,facteur_multiplicatif ,imageA ,niveaux_a_traiter,niveaux_cumulables ,facteur_du_nombre_de_points ,image_donnant_le_nombre_de_points_du_noyau ,image_definissant_la_valeur_du_noyau ,image_inhibant_la_valeur_du_noyau ,seuil_d_inhibition_du_noyau ) ); /* Convolution flottante de l'image Argument... */ Test(IL_FAUT(renormaliser_les_niveaux)) Bblock CALS(Ifloat_std_avec_renormalisation(imageR,imageR_flottante)); /* Conversion de l'image Resultat en une image standard avec renormalisation... */ Eblock ATes Bblock CALS(Ifloat_std(imageR,imageR_flottante,FLOT__NOIR,FLOT__BLANC)); /* Conversion de l'image Resultat en une image standard sans renormalisation... */ Eblock ETes EDEFV(imageF,imageR_flottante); /* Image flottante Resultat apres la convolution. */ RETI(imageR); Eblock EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* C O N V O L U T I O N D ' U N E I M A G E E N F O N C T I O N D U G R A D I E N T L O C A L : */ /* */ /*************************************************************************************************************************************/ BFonctionP #define DEMI_TAILLE_MAXIMALE_DU_NOYAU \ PRED(MOIT(INTE(RACX(TAILLE_MAXIMALE_D_UN_NOYAU_DE_CONVOLUTION)))) \ /* Demi-cote maximal du noyau de convolution calcule a partir d'une fonction qui est */ \ /* grossierement l'inverse de 'NOMBRE_DE_POINTS(...)'... */ #define VALIDE_DEMI_TAILLE_DU_NOYAU(demi_taille) \ TRON(demi_taille \ ,UN \ ,DEMI_TAILLE_MAXIMALE_DU_NOYAU \ ) \ /* Validation d'une demi-taille ('demi_largeur_du_noyau', 'demi_hauteur_du_noyau' ou */ \ /* 'demi_taille_maximale_du_noyau'). */ #define NOMBRE_LINEAIRE_DE_POINTS(inverse_d_une_composante_du_gradient) \ VALIDE_DEMI_TAILLE_DU_NOYAU(TRON(INTE(MUL2(facteur_du_nombre_de_points,inverse_d_une_composante_du_gradient)) \ ,ZERO \ ,demi_taille_maximale_du_noyau \ ) \ ) \ /* Convertit l'inverse d'une composante du gradient en un nombre de points. On notera */ \ /* l'on prend en compte l'inverse du gradient (et non pas le gradient lui-meme) : ainsi, */ \ /* plus le champ varie lentement dans une direction, plus le noyau s'etend dans cette */ \ /* direction... Enfin, le 'ZERO' du 'TRON(...)' est destine au cas ou l'argument */ \ /* 'demi_taille_maximale_du_noyau' serait nul. */ #define NOMBRE_DE_POINTS_POUR_LE_GRADIENT(demi_largeur,demi_hauteur) \ NOMBRE_DE_POINTS_EFFECTIF_D_UN_NOYAU_DE_CONVOLUTION_PARCOURU_CIRCULAIREMENT \ (INTE(EXP2(DOUP(MAX2(demi_largeur,demi_hauteur))))) \ /* Nombre total de points du noyau (y compris ceux qui ne sont pas utiles), et de facon a */ \ /* ce qu'il soit un carre de cote impair (il possede donc un centre...). ATTENTION : */ \ /* 'demi_largeur_du_noyau' et 'demi_hauteur_du_noyau' (et donc 'inverse_du_gradient_local') */ \ /* doivent etre connus avant de calculer 'nombre_de_points_du_noyau'... */ DEFV(Common,DEFV(FonctionP,POINTERp(Iconvolution_en_fonction_du_gradient_local(imageR ,facteur_multiplicatif ,imageA ,niveaux_a_traiter,niveaux_cumulables ,facteur_du_nombre_de_points ,demi_taille_maximale_du_noyau ) ) ) ) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] convoluee par un */ /* noyau dont le nombre de points est variable et donne par le gradient local... */ DEFV(Argument,DEFV(Float,facteur_multiplicatif)); /* Facteur multiplicatif du produit de convolution en chaque point {X,Y}. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_a_traiter,COULEURS))); /* Definit les niveaux sur lesquels on doit faire la convolution par 'Pconvolution()'. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_cumulables,COULEURS))); /* Definit les niveaux cumulables lors du calcul de 'Pconvolution_____cumul_courant'. */ DEFV(Argument,DEFV(Float,facteur_du_nombre_de_points)); /* Pour calculer le nombre de points contenus dans le noyau, y compris */ /* son centre, au point courant {X,Y}. */ DEFV(Argument,DEFV(Positive,demi_taille_maximale_du_noyau)); /* Demi-taille maximale du noyau... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Int,INIT(index,UNDEF)); /* Index d'initialisation du noyau. */ DEFV(Float,DTb1(noyau,TAILLE_MAXIMALE_D_UN_NOYAU_DE_CONVOLUTION)); /* Noyau de convolution : il est defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ DEFV(Logical,DTb1(inhibition_du_noyau,TAILLE_MAXIMALE_D_UN_NOYAU_DE_CONVOLUTION)); /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ DEFV(deltaF_2D,gradient_local); /* Definition du gradient local en chaque point {X,Y}... */ DEFV(deltaF_2D,inverse_du_gradient_local); /* Et valeur absolue de son inverse. On notera qu'il est introduit pour eviter un probleme */ /* d'assemblage sur 'SYSTEME_SG4D..._IRIX_CC' ("saut superieur a 32K"...). */ DEFV(Int,INIT(nombre_de_points_du_noyau,UNDEF)); /* Nombre de points total du noyau de convolution courant. ATTENTION : */ /* 'nombre_de_points_du_noyau' a ete malheureusement introduit pour reduire le temps de */ /* calcul de facon drastique... */ DEFV(Int,INIT(demi_largeur_du_noyau,UNDEF)); DEFV(Int,INIT(demi_hauteur_du_noyau,UNDEF)); /* Demi-tailles de la partie utile du noyau de convolution courant. ATTENTION : */ /* 'demi_largeur_du_noyau' et 'demi_hauteur_du_noyau' ont ete malheureusement introduits */ /* pour reduire le temps de calcul de facon drastique... */ /*..............................................................................................................................*/ SPIRALE_VALIDATION; VALIDATION_DE_____facteur_du_nombre_de_points; /* Mis sous cette forme le 20211020181331... */ DoIn(index ,PREMIER_POINT ,LSTX(PREMIER_POINT ,NOMBRE_DE_POINTS_POUR_LE_GRADIENT(VALIDE_DEMI_TAILLE_DU_NOYAU(demi_taille_maximale_du_noyau) ,VALIDE_DEMI_TAILLE_DU_NOYAU(demi_taille_maximale_du_noyau) ) ) ,I ) Bblock EGAL(ITb1(noyau,INDX(index,PREMIER_POINT)),FONCTION_DE_CONVOLUTION(FU)); /* Initialisation du noyau de convolution (1,1,1,...) sur le maximum possible, sachant que */ /* 'inhibition_du_noyau' fera ensuite la difference entre les elements actifs et les autres. */ Eblock EDoI begin_image /* ATTENTION, il est imperatif que 'begin_image' utilise la fonction 'DoIn(...)', ce qui */ /* signifie que les coordonnees sont traitees de facon croissante (de 'Xmin' a 'Xmax' et */ /* de 'Ymin' a 'Ymax'), car en effet, la fonction 'Pconvolution(...)' utilise cela pour */ /* desinitialiser si necessaire les spirales circulaires... */ Bblock DEFV(genere_p,INIT(niveau_courant,load_point(imageA,X,Y))); /* Niveau courant au point courant... */ Test(EST_VRAI(ITb1(niveaux_a_traiter,INDX(niveau_courant,NOIR)))) Bblock /* Traitement des points a traiter... */ INITIALISATION_ACCROISSEMENT_2D(gradient_local ,DIVI(SOUS(______NORMALISE_NIVEAU(NIVR(load_point_valide(imageA,SUCX(X),NEUT(Y)))) ,______NORMALISE_NIVEAU(NIVR(load_point_valide(imageA,PREX(X),NEUT(Y)))) ) ,DOUB(pasX) ) ,DIVI(SOUS(______NORMALISE_NIVEAU(NIVR(load_point_valide(imageA,NEUT(X),SUCY(Y)))) ,______NORMALISE_NIVEAU(NIVR(load_point_valide(imageA,NEUT(X),PREY(Y)))) ) ,DOUB(pasY) ) ); /* Approximation du gradient local au point courant {X,Y} a l'aide de differences finies : */ /* */ /* 'U' notant le champ ('imageA'), on a : */ /* */ /* dU U(X+1,Y) - U(X-1,Y) */ /* ---- = --------------------- */ /* dX 2 */ /* */ /* dU U(X,Y+1) - U(X,Y-1) */ /* ---- = --------------------- */ /* dY 2 */ /* */ /* L'inverse du gradient va definir le noyau de convolution : */ /* */ /* . . . . . . . . . . . . . . . . . . . . . */ /* . . */ /* . . */ /* . . */ /* . . */ /* . . */ /* _______________________________________ */ /* |/ / / / / / / / / / / / / / / / / / / /| */ /* | / / / / / / / / / / / / / / / / / / / | 1 */ /* |/ / / / / / / / / / / / / / / / / / / /| ------ */ /* | / / / / / / / / / / / / / / / / / / / | dU */ /* |/ / / / / / / / / / / / / / / / / / / /| ---- */ /* | / / / / / / / / / / / / / / / / / / / | dX */ /* |_______________________________________| */ /* . . */ /* . . */ /* . . */ /* . . */ /* . . */ /* . . . . . . . . . . . . . . . . . . . . . */ /* */ /* 1 */ /* ------ */ /* dU */ /* ---- */ /* dY */ /* */ /* On notera que l'on suppose dans ce dessin une relation d'ordre arbitraire entre les */ /* deux composantes du gradient, et ce afin de pouvoir donner un exemple... */ Test(IFOU(IZNE(ASD1(gradient_local,dx)),IZNE(ASD1(gradient_local,dy)))) Bblock /* On ne convolue que si le gradient est defini (l'une au moins de ses composante est */ /* non nulle). */ SPIRALE_DEFINITION /* Donnees de generation d'une spirale de parcours d'une image mise en donnees locales */ /* de 'begin_image'/'end_image' afin que la spirale soit reinitialisee pour chaque point */ /* {X,Y}... */ DEFV(Int,INIT(X_courant,X)); DEFV(Int,INIT(Y_courant,Y)); /* Point courant initialise sur le point courant {X,Y}. */ SPIRALE_VALIDATION; INITIALISATION_ACCROISSEMENT_2D(inverse_du_gradient_local ,INVZ(ABSO(ASD1(gradient_local,dx))) ,INVZ(ABSO(ASD1(gradient_local,dy))) ); /* Calcul de l'inverse du gradient local, qui va nous donner les dimensions utiles du */ /* noyau de convolution. ATTENTION : 'inverse_du_gradient_local' doit etre calcule avant */ /* toute autre variable ('demi_largeur_du_noyau', 'demi_hauteur_du_noyau' et */ /* 'nombre_de_points_du_noyau'). */ EGAL(demi_largeur_du_noyau,NOMBRE_LINEAIRE_DE_POINTS(ASD1(inverse_du_gradient_local,dx))); EGAL(demi_hauteur_du_noyau,NOMBRE_LINEAIRE_DE_POINTS(ASD1(inverse_du_gradient_local,dy))); /* Demi-tailles de la partie utile du noyau de convolution. ATTENTION : comme ci-dessous, */ /* 'inverse_du_gradient_local' doit etre connu avant de calculer 'demi_largeur_du_noyau' et */ /* 'demi_hauteur_du_noyau'... */ EGAL(nombre_de_points_du_noyau,NOMBRE_DE_POINTS_POUR_LE_GRADIENT(demi_largeur_du_noyau,demi_hauteur_du_noyau)); /* Nombre total de points du noyau (y compris ceux qui ne sont pas utiles), et de facon a */ /* ce qu'il soit un carre de cote impair (il possede donc un centre...). ATTENTION : */ /* 'demi_largeur_du_noyau' et 'demi_hauteur_du_noyau' (et donc 'inverse_du_gradient_local') */ /* doivent etre connus avant de calculer 'nombre_de_points_du_noyau'... */ Test(IFGT(nombre_de_points_du_noyau,TAILLE_MAXIMALE_D_UN_NOYAU_DE_CONVOLUTION)) Bblock PRINT_ERREUR("la taille du noyau de convolution variable est trop grande (3)"); Eblock ATes Bblock Eblock ETes DoIn(index,PREMIER_POINT,LSTX(PREMIER_POINT,nombre_de_points_du_noyau),I) Bblock SPIRALE_INITIALISATION; /* Initialisation dynamique de 'spirale_nombre_de_points_a_traiter'. */ Test(IFET(IFINff(X_courant ,SOUS(X,demi_largeur_du_noyau) ,ADD2(X,demi_largeur_du_noyau) ) ,IFINff(Y_courant ,SOUS(Y,demi_hauteur_du_noyau) ,ADD2(Y,demi_hauteur_du_noyau) ) ) ) Bblock EGAL(ITb1(inhibition_du_noyau,INDX(index,PREMIER_POINT)),ACTIF); /* Tous ses elements etant actifs lorsque l'on se situe dans la partie active (voir le */ /* rectangle hachure ci-dessus). On notera qu'autrefois je faisais de plus : */ /* */ /* EGAL(ITb1(noyau,INDX(index,PREMIER_POINT)),FONCTION_DE_CONVOLUTION(FU)); */ /* */ /* mais que j'ai decide d'optimiser : l'ensemble du noyau possible est initialise au debut. */ Eblock ATes Bblock EGAL(ITb1(inhibition_du_noyau,INDX(index,PREMIER_POINT)),INACTIF); /* Tous ses elements etant inactifs lorsque l'on se situe hors de la partie active. On */ /* notera qu'autrefois je faisais de plus : */ /* */ /* EGAL(ITb1(noyau,INDX(index,PREMIER_POINT)),FONCTION_DE_CONVOLUTION(FZERO)); */ /* */ /* mais que j'ai decide d'optimiser : l'ensemble du noyau possible est initialise au debut. */ Eblock ETes SPIRALE_DEPLACEMENT(X_courant,Y_courant); /* Deplacement du point courant de la spirale... */ /* ATTENTION : on n'utilise pas 'SPIRALE_DEPLACEMENT_ET_PARCOURS(...)' afin de simplifier */ /* les tests qui precedent... */ SPIRALE_PARCOURS; /* Parcours de la spirale avec rotation eventuelle de PI/2 du bras courant... */ Eblock EDoI store_point(GENP(NIVA(MUL2(facteur_multiplicatif ,Pconvolution(imageA,imageA ,X,Y ,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ) ) ) ,imageR ,X,Y ,FVARIABLE ); /* Et on convolue point par point avec le noyau (1,1,1,...) de longueur variable donnee */ /* par le gradient local au point {X,Y}. */ Eblock ATes Bblock store_point(GENP(NIVA(MUL2(facteur_multiplicatif,NIVR(niveau_courant)))) ,imageR ,X,Y ,FVARIABLE ); /* Dans le cas ou le gradient est indefini, il n'y a pas de convolution. Ce sera par */ /* exemple le cas des zones uniformes (et d'un fond en particulier... */ Eblock ETes Eblock ATes Bblock store_point(GENP(NIVA(MUL2(facteur_multiplicatif,NIVR(niveau_courant)))) ,imageR ,X,Y ,FVARIABLE ); /* Et on ne convolue pas lorsque le niveau courant n'est pas "traitable"... */ Eblock ETes Eblock end_image RETI(imageR); Eblock #undef NOMBRE_DE_POINTS_POUR_LE_GRADIENT #undef NOMBRE_LINEAIRE_DE_POINTS #undef DEMI_TAILLE_MAXIMALE_DU_NOYAU #undef VALIDE_DEMI_TAILLE_DU_NOYAU EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D I S T A N C E E N T R E D E U X I M A G E S E V A L U E E P A R L A R E C H E R C H E */ /* D E N I V E A U X I D E N T I Q U E S S U R U N E S P I R A L E : */ /* */ /*************************************************************************************************************************************/ BFonctionF #define NIVEAU_POUR_LES_POINTS_OU_LA_DISTANCE_N_EST_PAS_CALCULEE \ FZERO \ /* Niveau a donner aux points inhibes par 'niveaux_a_traiter'... */ DEFV(Common,DEFV(FonctionF,POINTERF(IFdistance_aux_niveaux_identiques(imageR ,facteur_multiplicatif ,imageA1,imageA2 ,niveaux_a_traiter,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ,facteur_du_numero ,facteur_de_la_coordonnee_X ,facteur_de_la_coordonnee_Y ,facteur_de_la_distance_euclidienne ,facteur_du_maximum_de_X_et_de_Y ,facteur_du_niveau ) ) ) ) DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=distance du point imageA1[X][Y] au premier point */ /* imageA2[X][Y] de meme niveau ; cette distance est en fait un numero (0, 1, ...) evalue */ /* lors du parcours d'une spirale centree sur imageA1[X][Y]. On notera donc que {A1,A2} ne */ /* commutent pas ; en general, on prendra : */ /* */ /* A1 = une image uniforme (par exemple 'BLANC'), */ /* A2 = une image "pointillee" (par exemple un certain nombre de points */ /* sur fond 'NOIR). */ /* */ /* si 'IL_NE_FAUT_PAS(Pconvolution_____remplacer__meme_niveau__par__niveau_different)' et : */ /* */ /* A1 = une image uniforme (par exemple 'NOIR'), */ /* A2 = une image "pointillee" (par exemple un certain nombre de points */ /* sur fond 'NOIR). */ /* */ /* dans le cas 'IL_FAUT(Pconvolution_____remplacer__meme_niveau__par__niveau_different)'. */ DEFV(Argument,DEFV(Float,facteur_multiplicatif)); /* Facteur multiplicatif du produit de convolution en chaque point {X,Y}. */ DEFV(Argument,DEFV(image,imageA1)); DEFV(Argument,DEFV(image,imageA2)); /* Images Arguments. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_a_traiter,COULEURS))); /* Definit les niveaux sur lesquels on doit faire la convolution par 'Pconvolution()'. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_cumulables,COULEURS))); /* Definit les niveaux cumulables lors du calcul de 'Pconvolution_____cumul_courant'. */ DEFV(Argument,DEFV(Int,nombre_de_points_du_noyau)); /* Nombre de points contenus dans le noyau, y compris son centre. */ DEFV(Argument,DEFV(Float,DTb0(noyau))); /* Noyau de convolution : il est defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ DEFV(Argument,DEFV(Logical,DTb0(inhibition_du_noyau))); /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ DEFV(Argument,DEFV(Float,facteur_du_numero)); DEFV(Argument,DEFV(Float,facteur_de_la_coordonnee_X)); DEFV(Argument,DEFV(Float,facteur_de_la_coordonnee_Y)); DEFV(Argument,DEFV(Float,facteur_de_la_distance_euclidienne)); DEFV(Argument,DEFV(Float,facteur_du_maximum_de_X_et_de_Y)); DEFV(Argument,DEFV(Float,facteur_du_niveau)); /* Facteurs multiplicatifs permettant en particulier de selectionner ce qui est renvoye. */ /* On notera au passage, qu'en combinant les ccordonnees 'X' et 'Y' (qui sont utilisees */ /* relativement au point courant et en valeur absolue), on trouve alors la distance dite */ /* du "chauffeur de taxi new-yorkais"... */ /* */ /* Le 20060125095615 fut introduit 'facteur_du_niveau' destine a permettre la realisation */ /* de pavages colores... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Logical,INIT(la_spirale_est_elle_interruptible,Pconvolution_____la_spirale_est_interruptible)); /* Sauvegarde de l'etat anterieur de 'Pconvolution_____la_spirale_est_interruptible'. */ /*..............................................................................................................................*/ EGAL(Pconvolution_____la_spirale_est_interruptible,VRAI); /* Afin de pouvoir interrompre le parcours de la spirale dans 'Pconvolution(...)'... */ SPIRALE_VALIDATION; VALIDATION_DE_____nombre_de_points_du_noyau; /* Mis sous cette forme le 20211020181331... */ Test(IFLT(Pconvolution_____rang_du_n_ieme_point_de_meme_niveau,PCONVOLUTION_RANG_DU_N_IEME_POINT_DE_MEME_NIVEAU)) Bblock PRINT_ERREUR("le rang du n-ieme point recherche est mauvais"); Eblock ATes Bblock Eblock ETes begin_image_AvecEditionProgression /* ATTENTION, il est imperatif que 'begin_image' utilise la fonction 'DoIn(...)', ce qui */ /* signifie que les coordonnees sont traitees de facon croissante (de 'Xmin' a 'Xmax' et */ /* de 'Ymin' a 'Ymax'), car en effet, la fonction 'Pconvolution(...)' utilise cela pour */ /* desinitialiser si necessaire les spirales circulaires... */ /* */ /* Le 20170520104209 a ete introduit "_AvecEditionProgression"... */ Bblock DEFV(genere_p,INIT(niveau_courant_imageA1,load_point(imageA1,X,Y))); /* Niveau courant au point courant de 'imageA1'... */ Test(EST_VRAI(ITb1(niveaux_a_traiter,INDX(niveau_courant_imageA1,NOIR)))) Bblock /* Traitement des points a traiter... */ CALS(Pconvolution(imageA1,imageA2 ,X,Y ,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ); /* Convolution au point {X,Y}. Ce calcul permet d'evaluer la valeur de */ /* 'Pconvolution_____numero_du_n_ieme_point_de_meme_niveau' qui est une valeur d'une */ /* certaine distance entre l'image 'imageA1' et l'image 'imageA2'. */ storeF_point(MUL2(facteur_multiplicatif ,LIZ6(facteur_du_numero ,FLOT(Pconvolution_____numero_du_n_ieme_point_de_meme_niveau) ,facteur_de_la_coordonnee_X ,FLOT(ABSO(SOUS(X,Pconvolution_____X_du_n_ieme_point_de_meme_niveau))) ,facteur_de_la_coordonnee_Y ,FLOT(ABSO(SOUS(Y,Pconvolution_____Y_du_n_ieme_point_de_meme_niveau))) ,facteur_de_la_distance_euclidienne ,RdisF2D(FLOT(X) ,FLOT(Y) ,FLOT(Pconvolution_____X_du_n_ieme_point_de_meme_niveau) ,FLOT(Pconvolution_____Y_du_n_ieme_point_de_meme_niveau) ) ,facteur_du_maximum_de_X_et_de_Y ,FLOT(MAX2(ABSO(SOUS(X,Pconvolution_____X_du_n_ieme_point_de_meme_niveau)) ,ABSO(SOUS(Y,Pconvolution_____Y_du_n_ieme_point_de_meme_niveau)) ) ) ,facteur_du_niveau ,FLOT(Pconvolution_____niveau_du_n_ieme_point_de_meme_niveau) ) ) ,imageR ,X,Y ); /* Et on convolue point par point... */ /* */ /* Le 20060125095615 fut introduit 'facteur_du_niveau' destine a permettre la realisation */ /* de pavages colores... */ Eblock ATes Bblock storeF_point(MUL2(facteur_multiplicatif,NIVEAU_POUR_LES_POINTS_OU_LA_DISTANCE_N_EST_PAS_CALCULEE) ,imageR ,X,Y ); /* Et on ne convolue pas lorsque le niveau courant n'est pas "traitable"... */ Eblock ETes Eblock end_image_AvecEditionProgression /* Le 20170520104209 a ete introduit "_AvecEditionProgression"... */ EGAL(Pconvolution_____la_spirale_est_interruptible,la_spirale_est_elle_interruptible); /* Restauration de 'Pconvolution_____la_spirale_est_interruptible'... */ RETIF(imageR); Eblock #undef NIVEAU_POUR_LES_POINTS_OU_LA_DISTANCE_N_EST_PAS_CALCULEE EFonctionF #undef PCONVOLUTION_RANG_DU_N_IEME_POINT_DE_MEME_NIVEAU /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* E R O S I O N O U D I L A T A T I O N D ' U N E I M A G E " S T A N D A R D " : */ /* */ /*************************************************************************************************************************************/ #define NIVEAU_DILATE_OU_ERODE \ COND(IL_FAUT(NomDeLaFonctionCourante QD@@__ _____forcer_le_marquage_de_la_moyenne_dans_tous_les_cas) \ ,COND(IFEQ(niveau_courant,Pconvolution_____maximum_sur_la_spirale) \ ,Pconvolution_____moyenne_sur_la_spirale \ ,niveau_courant \ ) \ ,COND(IL_FAUT(dilater_l_image) \ ,COND(IFEQ(niveau_courant,Pconvolution_____maximum_sur_la_spirale) \ ,Pconvolution_____maximum_sur_la_spirale \ ,BARY(Pconvolution_____minimum_sur_la_spirale \ ,Pconvolution_____maximum_sur_la_spirale \ ,NomDeLaFonctionCourante QD@@__ _____ponderation_de_dilatation \ ) \ ) \ ,COND(IFEQ(niveau_courant,Pconvolution_____maximum_sur_la_spirale) \ ,COND(IL_FAUT(NomDeLaFonctionCourante QD@@__ _____conserver_le_maximum_local_lors_d_une_erosion) \ ,Pconvolution_____maximum_sur_la_spirale \ ,COND(IFGE(Pconvolution_____moyenne_sur_la_spirale \ ,NomDeLaFonctionCourante QD@@__ _____seuil_de_la_moyenne_sur_la_spirale_lors_d_une_erosion \ ) \ ,Pconvolution_____minimum_sur_la_spirale \ ,niveau_courant \ ) \ ) \ ,COND(IL_FAUT(NomDeLaFonctionCourante QD@@__ _____compatibilite_20140901) \ ,Pconvolution_____minimum_sur_la_spirale \ ,niveau_courant \ ) \ ) \ ) \ ) \ /* Definition introduite le 20140831165445 afin de simplifier les mises a jour... */ BFonctionP DEFV(Common,DEFV(Logical,SINT(Ierosion_ou_dilatation_____compatibilite_20140901,FAUX))); /* Permet de generer des images suivant la methode anterieure au 20140901083247... */ DEFV(Common,DEFV(Logical,SINT(Ierosion_ou_dilatation_____conserver_le_maximum_local_lors_d_une_erosion,FAUX))); /* Permet, lors d'une erosion, de conserver le maximum local. La valeur par defaut ('FAUX') */ /* permet de garantir la compatibilite anterieure au 20051207101243. */ DEFV(Common,DEFV(Logical,SINT(Ierosion_ou_dilatation_____forcer_le_marquage_de_la_moyenne_dans_tous_les_cas,FAUX))); /* Permet, pour l'erosion et la dilatation, de marquer le point courant avec la moyenne */ /* afin d'aider au choix des autres parametres (principalement le seuil de la moyenne */ /* 'seuil_de_la_moyenne_sur_la_spirale_lors_d_une_erosion'). Ceci a ete introduit le */ /* 20140831112231... */ DEFV(Common,DEFV(genere_Float,SINT(Ierosion_ou_dilatation_____seuil_de_la_moyenne_sur_la_spirale_lors_d_une_erosion,FLOT__NOIR))); /* Permet, lors d'une erosion, de n'eroder que si le point courant est environne par */ /* suffisamment de points (ce que l'on evalue grace au calcul de la moyenne locale). */ /* Ceci a ete introduit le 20140830175513... */ /* */ /* L'idee etait de bloquer par ce moyen l'erosion de zones "maigres" (ou fines,...). Or le */ /* 20140901100212, je note que cela ne peut pas fonctionner correctement a cause d'effets */ /* "de bord" : ainsi, par exemple, imaginons une zone carree de points BLANC. Aux quatre */ /* sommets du carre, la moyenne est faible et donc l'erosion peut-y etre alors bloquee... */ /* Voici quelques mesures utiles faites a partir d'un carre BLANC 7x7 centre (obtenu a */ /* partir de l'image 'v $xiio/SPIRALE' par une complementation '$xci/complement$X', puis */ /* un seuillage avec '$xci/seuil$X seuil=252') avec les parametres suivants : */ /* */ /* nombre_de_points_du_noyau=25 */ /* seuil_de_la_moyenne_sur_la_spirale_lors_d_une_erosion=195 */ /* */ /* soit : */ /* */ /* points=25 */ /* seuil_moyenne=195 */ /* */ /* ce qui donne : */ /* */ /* */ /* point(253,253) : niveau=255 min=0 max=255 moyenne= 91.8 --> 255 (*) */ /* point(254,253) : niveau=255 min=0 max=255 moyenne=122.4 --> 255 (*) */ /* point(255,253) : niveau=255 min=0 max=255 moyenne=153.0 --> 255 (*) */ /* point(256,253) : niveau=255 min=0 max=255 moyenne=153.0 --> 255 (*) */ /* point(257,253) : niveau=255 min=0 max=255 moyenne=153.0 --> 255 (*) */ /* point(258,253) : niveau=255 min=0 max=255 moyenne=122.4 --> 255 (*) */ /* point(259,253) : niveau=255 min=0 max=255 moyenne= 91.8 --> 255 (*) */ /* */ /* point(253,254) : niveau=255 min=0 max=255 moyenne=122.4 --> 255 (*) */ /* point(254,254) : niveau=255 min=0 max=255 moyenne=163.2 --> 255 (*) */ /* point(255,254) : niveau=255 min=0 max=255 moyenne=204.0 --> 0 */ /* point(256,254) : niveau=255 min=0 max=255 moyenne=204.0 --> 0 */ /* point(257,254) : niveau=255 min=0 max=255 moyenne=204.0 --> 0 */ /* point(258,254) : niveau=255 min=0 max=255 moyenne=163.2 --> 255 (*) */ /* point(259,254) : niveau=255 min=0 max=255 moyenne=122.4 --> 255 (*) */ /* */ /* point(253,255) : niveau=255 min=0 max=255 moyenne=153.0 --> 255 (*) */ /* point(254,255) : niveau=255 min=0 max=255 moyenne=204.0 --> 0 */ /* point(255,255) : niveau=255 min=255 max=255 moyenne=255.0 --> 255 */ /* point(256,255) : niveau=255 min=255 max=255 moyenne=255.0 --> 255 */ /* point(257,255) : niveau=255 min=255 max=255 moyenne=255.0 --> 255 */ /* point(258,255) : niveau=255 min=0 max=255 moyenne=204.0 --> 0 */ /* point(259,255) : niveau=255 min=0 max=255 moyenne=153.0 --> 255 (*) */ /* */ /* point(253,256) : niveau=255 min=0 max=255 moyenne=153.0 --> 255 (*) */ /* point(254,256) : niveau=255 min=0 max=255 moyenne=204.0 --> 0 */ /* point(255,256) : niveau=255 min=255 max=255 moyenne=255.0 --> 255 */ /* point(256,256) : niveau=255 min=255 max=255 moyenne=255.0 --> 255 */ /* point(257,256) : niveau=255 min=255 max=255 moyenne=255.0 --> 255 */ /* point(258,256) : niveau=255 min=0 max=255 moyenne=204.0 --> 0 */ /* point(259,256) : niveau=255 min=0 max=255 moyenne=153.0 --> 255 (*) */ /* */ /* point(253,257) : niveau=255 min=0 max=255 moyenne=153.0 --> 255 (*) */ /* point(254,257) : niveau=255 min=0 max=255 moyenne=204.0 --> 0 */ /* point(255,257) : niveau=255 min=255 max=255 moyenne=255.0 --> 255 */ /* point(256,257) : niveau=255 min=255 max=255 moyenne=255.0 --> 255 */ /* point(257,257) : niveau=255 min=255 max=255 moyenne=255.0 --> 255 */ /* point(258,257) : niveau=255 min=0 max=255 moyenne=204.0 --> 0 */ /* point(259,257) : niveau=255 min=0 max=255 moyenne=153.0 --> 255 (*) */ /* */ /* point(253,258) : niveau=255 min=0 max=255 moyenne=122.4 --> 255 (*) */ /* point(254,258) : niveau=255 min=0 max=255 moyenne=163.2 --> 255 (*) */ /* point(255,258) : niveau=255 min=0 max=255 moyenne=204.0 --> 0 */ /* point(256,258) : niveau=255 min=0 max=255 moyenne=204.0 --> 0 */ /* point(257,258) : niveau=255 min=0 max=255 moyenne=204.0 --> 0 */ /* point(258,258) : niveau=255 min=0 max=255 moyenne=163.2 --> 255 (*) */ /* point(259,258) : niveau=255 min=0 max=255 moyenne=122.4 --> 255 (*) */ /* */ /* point(253,259) : niveau=255 min=0 max=255 moyenne= 91.8 --> 255 (*) */ /* point(254,259) : niveau=255 min=0 max=255 moyenne=122.4 --> 255 (*) */ /* point(255,259) : niveau=255 min=0 max=255 moyenne=153.0 --> 255 (*) */ /* point(256,259) : niveau=255 min=0 max=255 moyenne=153.0 --> 255 (*) */ /* point(257,259) : niveau=255 min=0 max=255 moyenne=153.0 --> 255 (*) */ /* point(258,259) : niveau=255 min=0 max=255 moyenne=122.4 --> 255 (*) */ /* point(259,259) : niveau=255 min=0 max=255 moyenne= 91.8 --> 255 (*) */ /* */ /* */ /* soit : */ /* */ /* ******* ******* */ /* ******* ** ** */ /* ******* * *** * */ /* ******* --> * *** * */ /* ******* * *** * */ /* ******* ** ** */ /* ******* ******* */ /* */ /* */ /* Ainsi on voit des problemes sur la premiere (Y=253) et la derniere ligne (Y=259) ou le */ /* niveau resultant est BLANC (=255) et donc non erode, alors que les lignes Y=254 et Y=258 */ /* le sont (partiellement), ce qui n'est pas correct evidemment... Les points consideres */ /* comme n'ayant pas ete erodes, alors qu'ils auraient du l'etre, sont marques par '(*)'... */ DEFV(Common,DEFV(Float,SINT(Ierosion_ou_dilatation_____ponderation_de_dilatation,COORDONNEE_BARYCENTRIQUE_MAXIMALE))); /* Lorsque 'IL_FAUT(dilater_l_image)' donne la ponderation barycentrique entre les valeurs */ /* 'Pconvolution_____minimum_sur_la_spirale' et 'Pconvolution_____maximum_sur_la_spirale'. */ /* */ /* Le 20051207101243, le nom 'ponderation_de_dilatation_dans_Ierosion_ou_dilatation' a ete */ /* change en 'Ierosion_ou_dilatation_____ponderation_de_dilatation'... */ DEFV(Common,DEFV(FonctionP,POINTERp(Ierosion_ou_dilatation(imageR ,imageA ,niveaux_a_traiter,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ,dilater_l_image ) ) ) ) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] en prenant soit le minimum local */ /* (cas de l'erosion) ou le maximum local (cas de la dilatation) sur la spirale definie. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_a_traiter,COULEURS))); /* Definit les niveaux sur lesquels on doit faire la convolution par 'Pconvolution()'. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_cumulables,COULEURS))); /* Definit les niveaux cumulables lors du calcul de 'Pconvolution_____cumul_courant'. */ DEFV(Argument,DEFV(Int,nombre_de_points_du_noyau)); /* Nombre de points contenus dans le noyau, y compris son centre. */ DEFV(Argument,DEFV(Float,DTb0(noyau))); /* Noyau de convolution : il est defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ DEFV(Argument,DEFV(Logical,DTb0(inhibition_du_noyau))); /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ DEFV(Argument,DEFV(Logical,dilater_l_image)); /* Precise s'il faut dilater l'image ('VRAI') ou bien l'eroder ('FAUX')... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ SPIRALE_VALIDATION; VALIDATION_DE_____nombre_de_points_du_noyau; /* Mis sous cette forme le 20211020181331... */ begin_image /* ATTENTION, il est imperatif que 'begin_image' utilise la fonction 'DoIn(...)', ce qui */ /* signifie que les coordonnees sont traitees de facon croissante (de 'Xmin' a 'Xmax' et */ /* de 'Ymin' a 'Ymax'), car en effet, la fonction 'Pconvolution(...)' utilise cela pour */ /* desinitialiser si necessaire les spirales circulaires... */ Bblock DEFV(genere_p,INIT(niveau_courant,load_point(imageA,X,Y))); /* Niveau courant au point courant... */ Test(EST_VRAI(ITb1(niveaux_a_traiter,INDX(niveau_courant,NOIR)))) Bblock /* Traitement des points a traiter... */ DEFV(Float,INIT(niveau_convolue_courant ,Pconvolution(imageA,imageA ,X,Y ,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ) ); /* Convolution au point courant, cette valeur etant en fait inutilisee, puisque seuls */ /* comptent les extrema locaux calcules sur la spirale par 'Pconvolution(...)'... */ store_point(GENP(NIVEAU_DILATE_OU_ERODE) ,imageR ,X,Y ,FVARIABLE ); /* Et on recupere l'un des deux extrema sur la spirale courante. Le 19981109123910, la */ /* gestion de la dilation a ete etendue de la facon suivante : si le niveau courant est */ /* egal au maximum rencontre, il est conserve (ce qui correspond au fonctionnement */ /* anterieur) ; dans le cas contraire on prend comme niveau une valeur interpolee entre */ /* le minimum et le maximum rencontres (la ponderation est choisie telle que par defaut */ /* le comportement anterieur soit la aussi conserve...). */ Eblock ATes Bblock store_point(niveau_courant ,imageR ,X,Y ,FVARIABLE ); /* Et on ne convolue pas lorsque le niveau courant n'est pas "traitable"... */ Eblock ETes Eblock end_image RETI(imageR); Eblock EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* E R O S I O N O U D I L A T A T I O N D ' U N E I M A G E " N O N S T A N D A R D " */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Logical,SINT(IFerosion_ou_dilatation_____compatibilite_20140901,FAUX))); /* Permet de generer des images suivant la methode anterieure au 20140901083247... */ DEFV(Common,DEFV(Logical,SINT(IFerosion_ou_dilatation_____conserver_le_maximum_local_lors_d_une_erosion,FAUX))); /* Permet, lors d'une erosion, de conserver le maximum local. */ DEFV(Common,DEFV(Logical,SINT(IFerosion_ou_dilatation_____forcer_le_marquage_de_la_moyenne_dans_tous_les_cas,FAUX))); /* Permet, pour l'erosion et la dilatation, de marquer le point courant avec la moyenne */ /* afin d'aider au choix des autres parametres (principalement le seuil de la moyenne */ /* 'seuil_de_la_moyenne_sur_la_spirale_lors_d_une_erosion'). Ceci a ete introduit le */ /* 20140831112231... */ DEFV(Common,DEFV(genere_Float,SINT(IFerosion_ou_dilatation_____seuil_de_la_moyenne_sur_la_spirale_lors_d_une_erosion,FLOT__NOIR))); /* Permet, lors d'une erosion, de n'eroder que si le point courant est environne par */ /* suffisamment de points (ce que l'on evalue grace au calcul de la moyenne locale). */ /* Ceci a ete introduit le 20140830175513... */ DEFV(Common,DEFV(Float,SINT(IFerosion_ou_dilatation_____ponderation_de_dilatation,COORDONNEE_BARYCENTRIQUE_MAXIMALE))); /* Lorsque 'IL_FAUT(dilater_l_image)' donne la ponderation barycentrique entre les valeurs */ /* 'Pconvolution_____minimum_sur_la_spirale' et 'Pconvolution_____maximum_sur_la_spirale'. */ DEFV(Common,DEFV(FonctionF,POINTERF(IFerosion_ou_dilatation(imageR ,imageA ,niveaux_a_traiter,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ,dilater_l_image ) ) ) ) DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] en prenant soit le minimum local */ /* (cas de l'erosion) ou le maximum local (cas de la dilatation) sur la spirale definie. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_a_traiter,COULEURS))); /* Definit les niveaux sur lesquels on doit faire la convolution par 'Pconvolution()'. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_cumulables,COULEURS))); /* Definit les niveaux cumulables lors du calcul de 'Pconvolution_____cumul_courant'. */ DEFV(Argument,DEFV(Int,nombre_de_points_du_noyau)); /* Nombre de points contenus dans le noyau, y compris son centre. */ DEFV(Argument,DEFV(Float,DTb0(noyau))); /* Noyau de convolution : il est defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ DEFV(Argument,DEFV(Logical,DTb0(inhibition_du_noyau))); /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ DEFV(Argument,DEFV(Logical,dilater_l_image)); /* Precise s'il faut dilater l'image ('VRAI') ou bien l'eroder ('FAUX')... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ SPIRALE_VALIDATION; VALIDATION_DE_____nombre_de_points_du_noyau; /* Mis sous cette forme le 20211020181331... */ begin_image /* ATTENTION, il est imperatif que 'begin_image' utilise la fonction 'DoIn(...)', ce qui */ /* signifie que les coordonnees sont traitees de facon croissante (de 'Xmin' a 'Xmax' et */ /* de 'Ymin' a 'Ymax'), car en effet, la fonction 'PFconvolution(...)' utilise cela pour */ /* desinitialiser si necessaire les spirales circulaires... */ Bblock DEFV(genere_Float,INIT(niveau_courant,loadF_point(imageA,X,Y))); /* Niveau courant au point courant... */ Test(EST_VRAI(ITb1(niveaux_a_traiter,INDX(niveau_courant,NOIR)))) Bblock /* Traitement des points a traiter... */ DEFV(Float,INIT(niveau_convolue_courant ,PFconvolution(imageA,imageA ,X,Y ,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ) ); /* Convolution au point courant, cette valeur etant en fait inutilisee, puisque seuls */ /* comptent les extrema locaux calcules sur la spirale par 'PFconvolution(...)'... */ storeF_point(NIVEAU_DILATE_OU_ERODE ,imageR ,X,Y ); /* Et on recupere l'un des deux extrema sur la spirale courante. Le 19981109123910, la */ /* gestion de la dilation a ete etendue de la facon suivante : si le niveau courant est */ /* egal au maximum rencontre, il est conserve (ce qui correspond au fonctionnement */ /* anterieur) ; dans le cas contraire on prend comme niveau une valeur interpolee entre */ /* le minimum et le maximum rencontres (la ponderation est choisie telle que par defaut */ /* le comportement anterieur soit la aussi conserve...). */ Eblock ATes Bblock storeF_point(niveau_courant ,imageR ,X,Y ); /* Et on ne convolue pas lorsque le niveau courant n'est pas "traitable"... */ Eblock ETes Eblock end_image RETIF(imageR); Eblock EFonctionF #undef NIVEAU_DILATE_OU_ERODE /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* F I L T R A G E D E S P O I N T S I S O L E S D ' U N E I M A G E " S T A N D A R D " : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(Logical,SINT(Ifiltrage_des_points_isoles_____compatibilite_20140923,FAUX))); /* Permet de generer des images suivant la methode anterieure au 20140923104127 lors du */ /* test du niveau courant par rapport a son environnement... */ DEFV(Common,DEFV(Float,SINT(Ifiltrage_des_points_isoles_____ponderation_du____minimum,FZERO))); DEFV(Common,DEFV(Float,SINT(Ifiltrage_des_points_isoles_____ponderation_de_la_moyenne,FU))); DEFV(Common,DEFV(Float,SINT(Ifiltrage_des_points_isoles_____ponderation_du____maximum,FZERO))); /* Ponderations utiles pour filtrer les points isoles. */ DEFV(Common,DEFV(Float,SINT(Ifiltrage_des_points_isoles_____ponderation_du____minimum_pour_le_test,FZERO))); DEFV(Common,DEFV(Float,SINT(Ifiltrage_des_points_isoles_____ponderation_de_la_moyenne_pour_le_test,FU))); DEFV(Common,DEFV(Float,SINT(Ifiltrage_des_points_isoles_____ponderation_du____maximum_pour_le_test,FZERO))); /* Ponderations utiles pour filtrer les points isoles lors du test (introduit le */ /* 20140923104127). */ DEFV(Common,DEFV(FonctionP,POINTERp(Ifiltrage_des_points_isoles(imageR ,imageA ,niveaux_a_traiter,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ,seuil_difference_niveaux_normalises_par_rapport_a_leur_environnement ) ) ) ) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] en prenant la moyenne non */ /* ponderee dans le cas ou le point courant est considere comme "isole" (c'est-a-dire */ /* "trop different de la moyenne locale", la difference etant exprimee a l'aide du */ /* pourcentage 'seuil_difference_niveaux_normalises_par_rapport_a_leur_environnement'). */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_a_traiter,COULEURS))); /* Definit les niveaux sur lesquels on doit faire la convolution par 'Pconvolution()'. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_cumulables,COULEURS))); /* Definit les niveaux cumulables lors du calcul de 'Pconvolution_____cumul_courant'. */ DEFV(Argument,DEFV(Int,nombre_de_points_du_noyau)); /* Nombre de points contenus dans le noyau, y compris son centre. */ DEFV(Argument,DEFV(Float,DTb0(noyau))); /* Noyau de convolution : il est defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ DEFV(Argument,DEFV(Logical,DTb0(inhibition_du_noyau))); /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ DEFV(Argument,DEFV(Float,seuil_difference_niveaux_normalises_par_rapport_a_leur_environnement)); /* Seuil dans [0,1] au-dela duquel, un point est considere comme isole. Pour ce faire */ /* la "distance" du niveau du point courant au niveau moyen de son environnement est */ /* comparee a ce seuil. Si la distance est plus grande que le seuil, on considere que */ /* le point courant est different de son environnement ; il est alors dit "isole" et est */ /* donc filtre. Si la distance est plus petite ou egal au seuil, on considere que le point */ /* courant est homogene par rapport a son environnement ; il est donc conserve. On notera */ /* donc qu'un seuil egal a 1 ne permet donc pas de detecter de points isoles (car la */ /* distance ne peut pas etre superieure a 100%) et dans ces conditions, 'imageR' est */ /* identique a 'imageA'. Enfin, la valeur de ce seuil conditionne le nombre de points qui */ /* seront filtres : proche de 1, peu de points filtres, alors que proche de 0, beaucoup */ /* de points filtres... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ NE_PAS_UTILISER_LE_PREMIER_POINT_POUR_LA_RECHERCHE_DES_EXTREMA_DANS_Pconvolution_ET_DANS_PFconvolution; SPIRALE_VALIDATION; VALIDATION_DE_____nombre_de_points_du_noyau; /* Mis sous cette forme le 20211020181331... */ begin_image /* ATTENTION, il est imperatif que 'begin_image' utilise la fonction 'DoIn(...)', ce qui */ /* signifie que les coordonnees sont traitees de facon croissante (de 'Xmin' a 'Xmax' et */ /* de 'Ymin' a 'Ymax'), car en effet, la fonction 'Pconvolution(...)' utilise cela pour */ /* desinitialiser si necessaire les spirales circulaires... */ Bblock DEFV(genere_p,INIT(niveau_courant,load_point(imageA,X,Y))); /* Niveau courant au point courant... */ Test(EST_VRAI(ITb1(niveaux_a_traiter,INDX(niveau_courant,NOIR)))) Bblock /* Traitement des points a traiter... */ DEFV(Float,INIT(niveau_convolue_courant ,Pconvolution(imageA,imageA ,X,Y ,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ) ); /* Convolution au point courant, cette valeur etant en fait inutilisee, puisque seul */ /* compte la moyenne non ponderee calculee sur la spirale par 'Pconvolution(...)'... */ #define Ifiltrage_des_points_isoles_compatibilite_20140923 \ Ifiltrage_des_points_isoles_____compatibilite_20140923 #define ponderation_du____minimum_pour_le_test \ Ifiltrage_des_points_isoles_____ponderation_du____minimum_pour_le_test #define ponderation_de_la_moyenne_pour_le_test \ Ifiltrage_des_points_isoles_____ponderation_de_la_moyenne_pour_le_test #define ponderation_du____maximum_pour_le_test \ Ifiltrage_des_points_isoles_____ponderation_du____maximum_pour_le_test /* Afin de raccourcir quelques lignes qui suivent... */ store_point(GENP(COND(IFGT(______NORMALISE_NIVEAU(SOUA(niveau_courant ,COND(IL_FAUT(Ifiltrage_des_points_isoles_compatibilite_20140923) ,GENP(Pconvolution_____moyenne_sur_la_spirale) ,GENP(NIVA(LIZ3(ponderation_du____minimum_pour_le_test ,NIVR(Pconvolution_____minimum_sur_la_spirale) ,ponderation_de_la_moyenne_pour_le_test ,NIVR(Pconvolution_____moyenne_sur_la_spirale) ,ponderation_du____maximum_pour_le_test ,NIVR(Pconvolution_____maximum_sur_la_spirale) ) ) ) ) ) ) ,seuil_difference_niveaux_normalises_par_rapport_a_leur_environnement ) ,NIVA(LIZ3(Ifiltrage_des_points_isoles_____ponderation_du____minimum ,NIVR(Pconvolution_____minimum_sur_la_spirale) ,Ifiltrage_des_points_isoles_____ponderation_de_la_moyenne ,NIVR(Pconvolution_____moyenne_sur_la_spirale) ,Ifiltrage_des_points_isoles_____ponderation_du____maximum ,NIVR(Pconvolution_____maximum_sur_la_spirale) ) ) ,niveau_courant ) ) ,imageR ,X,Y ,FVARIABLE ); /* Et on recupere la moyenne non ponderee sur la spirale courante. Si le niveau courant en */ /* est trop eloigne ('seuil_difference_niveaux_normalises_par_rapport_a_leur_environnement' */ /* est en quelque sorte un pourcentage), le point courant est considere comme "isole" et */ /* donc filtre (c'est-a-dire remplace par une fonction de son environnement). */ #undef ponderation_du____maximum_pour_le_test #undef ponderation_de_la_moyenne_pour_le_test #undef ponderation_du____minimum_pour_le_test #undef Ifiltrage_des_points_isoles_compatibilite_20140923 Eblock ATes Bblock store_point(niveau_courant ,imageR ,X,Y ,FVARIABLE ); /* Et on ne convolue pas lorsque le niveau courant n'est pas "traitable"... */ Eblock ETes Eblock end_image COMMENT_UTILISER_LE_PREMIER_POINT_POUR_LA_RECHERCHE_DES_EXTREMA_DANS_Pconvolution_ET_DANS_PFconvolution; RETI(imageR); Eblock EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* F I L T R A G E D E S P O I N T S I S O L E S D ' U N E I M A G E F L O T T A N T E : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Logical,SINT(IFfiltrage_des_points_isoles_____compatibilite_20140923,FAUX))); /* Permet de generer des images suivant la methode anterieure au 20140923104127 lors du */ /* test du niveau courant par rapport a son environnement... */ DEFV(Common,DEFV(Float,SINT(IFfiltrage_des_points_isoles_____ponderation_du____minimum,FZERO))); DEFV(Common,DEFV(Float,SINT(IFfiltrage_des_points_isoles_____ponderation_de_la_moyenne,FU))); DEFV(Common,DEFV(Float,SINT(IFfiltrage_des_points_isoles_____ponderation_du____maximum,FZERO))); /* Ponderations utiles pour filtrer les points isoles. */ DEFV(Common,DEFV(Float,SINT(IFfiltrage_des_points_isoles_____ponderation_du____minimum_pour_le_test,FZERO))); DEFV(Common,DEFV(Float,SINT(IFfiltrage_des_points_isoles_____ponderation_de_la_moyenne_pour_le_test,FU))); DEFV(Common,DEFV(Float,SINT(IFfiltrage_des_points_isoles_____ponderation_du____maximum_pour_le_test,FZERO))); /* Ponderations utiles pour filtrer les points isoles lors du test (introduit le */ /* 20140923104127). */ DEFV(Common,DEFV(FonctionF,POINTERF(IFfiltrage_des_points_isoles(imageR ,imageA ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ,seuil_difference_niveaux_normalises_par_rapport_a_leur_environnement ) ) ) ) DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] en prenant la moyenne non */ /* ponderee dans le cas ou le point courant est considere comme "isole" (c'est-a-dire */ /* "trop different de la moyenne locale", la difference etant exprimee a l'aide du */ /* pourcentage 'seuil_difference_niveaux_normalises_par_rapport_a_leur_environnement'). */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Int,nombre_de_points_du_noyau)); /* Nombre de points contenus dans le noyau, y compris son centre. */ DEFV(Argument,DEFV(Float,DTb0(noyau))); /* Noyau de convolution : il est defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ DEFV(Argument,DEFV(Logical,DTb0(inhibition_du_noyau))); /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ DEFV(Argument,DEFV(Float,seuil_difference_niveaux_normalises_par_rapport_a_leur_environnement)); /* Seuil dans [0,1] au-dela duquel, un point est considere comme isole. Pour ce faire */ /* la "distance" du niveau du point courant au niveau moyen de son environnement est */ /* comparee a ce seuil. Si la distance est plus grande que le seuil, on considere que */ /* le point courant est different de son environnement ; il est alors dit "isole" et est */ /* donc filtre. Si la distance est plus petite ou egal au seuil, on considere que le point */ /* courant est homogene par rapport a son environnement ; il est donc conserve. On notera */ /* donc qu'un seuil egal a 1 ne permet donc pas de detecter de points isoles (car la */ /* distance ne peut pas etre superieure a 100%) et dans ces conditions, 'imageR' est */ /* identique a 'imageA'. Enfin, la valeur de ce seuil conditionne le nombre de points qui */ /* seront filtres : proche de 1, peu de points filtres, alors que proche de 0, beaucoup */ /* de points filtres... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Logical,INIT(POINTERl(niveaux_cumulables),ADRESSE_NON_DEFINIE)); /* Cette liste est impossible avec le type 'Float'... */ DEFV(genere_Float,INIT(niveau_minimum_dans_imageA,FLOT__UNDEF)); DEFV(genere_Float,INIT(niveau_maximum_dans_imageA,FLOT__UNDEF)); /* Afin de rechercher les niveaux minimal et maximal de 'imageA'. */ /*..............................................................................................................................*/ NE_PAS_UTILISER_LE_PREMIER_POINT_POUR_LA_RECHERCHE_DES_EXTREMA_DANS_Pconvolution_ET_DANS_PFconvolution; SPIRALE_VALIDATION; VALIDATION_DE_____nombre_de_points_du_noyau; /* Mis sous cette forme le 20211020181331... */ CALS(IFnivo_extrema(imageA ,ADRESSE(niveau_minimum_dans_imageA) ,ADRESSE(niveau_maximum_dans_imageA) ) ); /* Recherche des extrema de 'imageA' afin de pouvoir renormaliser la difference entre */ /* le niveau courant et la moyenne locale... */ begin_image /* ATTENTION, il est imperatif que 'begin_image' utilise la fonction 'DoIn(...)', ce qui */ /* signifie que les coordonnees sont traitees de facon croissante (de 'Xmin' a 'Xmax' et */ /* de 'Ymin' a 'Ymax'), car en effet, la fonction 'Pconvolution(...)' utilise cela pour */ /* desinitialiser si necessaire les spirales circulaires... */ Bblock DEFV(genere_Float,INIT(niveau_courant,loadF_point(imageA,X,Y))); /* Niveau courant au point courant... */ DEFV(Float,INIT(niveau_convolue_courant ,PFconvolution(imageA,imageA ,X,Y ,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ) ); /* Convolution au point courant, cette valeur etant en fait inutilisee, puisque seul */ /* compte la moyenne non ponderee calculee sur la spirale par 'PFconvolution(...)'... */ storeF_point(COND(IFGT(DIVZ(SOUA(niveau_courant ,COND(IL_FAUT(IFfiltrage_des_points_isoles_____compatibilite_20140923) ,Pconvolution_____moyenne_sur_la_spirale ,NIVA(LIZ3(IFfiltrage_des_points_isoles_____ponderation_du____minimum_pour_le_test ,NIVR(Pconvolution_____minimum_sur_la_spirale) ,IFfiltrage_des_points_isoles_____ponderation_de_la_moyenne_pour_le_test ,NIVR(Pconvolution_____moyenne_sur_la_spirale) ,IFfiltrage_des_points_isoles_____ponderation_du____maximum_pour_le_test ,NIVR(Pconvolution_____maximum_sur_la_spirale) ) ) ) ) ,SOUS(niveau_maximum_dans_imageA,niveau_minimum_dans_imageA) ) ,seuil_difference_niveaux_normalises_par_rapport_a_leur_environnement ) ,NIVA(LIZ3(IFfiltrage_des_points_isoles_____ponderation_du____minimum ,NIVR(Pconvolution_____minimum_sur_la_spirale) ,IFfiltrage_des_points_isoles_____ponderation_de_la_moyenne ,NIVR(Pconvolution_____moyenne_sur_la_spirale) ,IFfiltrage_des_points_isoles_____ponderation_du____maximum ,NIVR(Pconvolution_____maximum_sur_la_spirale) ) ) ,niveau_courant ) ,imageR ,X,Y ); /* Et on recupere la moyenne non ponderee sur la spirale courante. Si le niveau courant en */ /* est trop eloigne ('seuil_difference_niveaux_normalises_par_rapport_a_leur_environnement' */ /* est en quelque sorte un pourcentage), le point courant est considere comme "isole" et */ /* donc filtre (c'est-a-dire remplace par une fonction de son environnement). */ Eblock end_image COMMENT_UTILISER_LE_PREMIER_POINT_POUR_LA_RECHERCHE_DES_EXTREMA_DANS_Pconvolution_ET_DANS_PFconvolution; RETIF(imageR); Eblock EFonctionF #undef COMMENT_UTILISER_LE_PREMIER_POINT_POUR_LA_RECHERCHE_DES_EXTREMA_DANS_Pconvolution_ET_DANS_PFconvolution #undef NE_PAS_UTILISER_LE_PREMIER_POINT_POUR_LA_RECHERCHE_DES_EXTREMA_DANS_Pconvolution_ET_DANS_PFconvolution #undef UTILISER_LE_PREMIER_POINT_POUR_LA_RECHERCHE_DES_EXTREMA_DANS_Pconvolution_ET_DANS_PFconvolution /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* M O D E L E B I D I M E N S I O N N E L D E C O T E S A V E C E R O S I O N : */ /* */ /* */ /* Definition : */ /* */ /* Ce modele est tres inspire de celui de */ /* Andrea Baldassarri, Andrea Gabrielli et Bernard */ /* Sapoval. Il consiste en espace bidimensionnel */ /* de points P(x,y). Les points a valeurs negatives */ /* correspond a la terre et les points a valeurs */ /* positives a la mer. Les points de la terre qui */ /* sont proches de la mer s'affaiblissent au cours */ /* du temps et la force de la mer diminue lorsque */ /* la longueur de la cote augmente... */ /* */ /* */ /*************************************************************************************************************************************/ #define UN_POINT_D_ERODE______COTES_2D_EST_SUR_LA_TERRE(etat) \ IFLT(etat,NIVEAU______MEDIAN_DANS_Ierode__CoastLines_2D) #define UN_POINT_D_ERODE______COTES_2D_EST__INDETERMINE(etat) \ IFEQ(etat,NIVEAU______MEDIAN_DANS_Ierode__CoastLines_2D) #define UN_POINT_D_ERODE______COTES_2D_EST_SUR_LA___MER(etat) \ IFGT(etat,NIVEAU______MEDIAN_DANS_Ierode__CoastLines_2D) /* Pour connaitre le type de localisation du point courant... */ #define ACCES_A_UN_POINT_D_ERODE______COTES_2D(etat,x,dx,y,dy,ponderation_de_ce_point) \ Bblock \ EGAL(etat \ ,MUL2(ponderation_de_ce_point \ ,FFload_point(imageA \ ,ADD2(x,dx),ADD2(y,dy) \ ,Ierode__CoastLines_2D_____periodiser_X \ ,Ierode__CoastLines_2D_____periodiser_Y \ ,Ierode__CoastLines_2D_____symetriser_X \ ,Ierode__CoastLines_2D_____symetriser_Y \ ,Ierode__CoastLines_2D_____prolonger_X \ ,Ierode__CoastLines_2D_____prolonger_Y \ ,Ierode__CoastLines_2D_____niveau_hors_image \ ) \ ) \ ); \ \ INCR(nombre_d_etats_de_type_terre,COND(UN_POINT_D_ERODE______COTES_2D_EST_SUR_LA_TERRE(etat),I,ZERO)); \ INCR(nombre_d_etats__indetermines,COND(UN_POINT_D_ERODE______COTES_2D_EST__INDETERMINE(etat),I,ZERO)); \ INCR(nombre_d_etats_de_type___mer,COND(UN_POINT_D_ERODE______COTES_2D_EST_SUR_LA___MER(etat),I,ZERO)); \ /* Comptabilite des differents signes possibles de l'"etat". */ \ \ INCR(moyenne_des_etats_de_type_terre,COND(UN_POINT_D_ERODE______COTES_2D_EST_SUR_LA_TERRE(etat),etat,FZERO)); \ INCR(moyenne_des_etats__indetermines,COND(UN_POINT_D_ERODE______COTES_2D_EST__INDETERMINE(etat),etat,FZERO)); \ INCR(moyenne_des_etats_de_type___mer,COND(UN_POINT_D_ERODE______COTES_2D_EST_SUR_LA___MER(etat),etat,FZERO)); \ /* Comptabilite des differents "etat"s en vue de calculer leur moyenne. */ \ Eblock \ /* Acces a l'etat associe a un point {x,y}. */ #ifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_01 /* Common,DEFV(Fonction,) : avec 'VERSION_01'. */ DEFV(Common,DEFV(Logical,_____LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_01)); #Aifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_01 /* Common,DEFV(Fonction,) : avec 'VERSION_01'. */ #Eifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_01 /* Common,DEFV(Fonction,) : avec 'VERSION_01'. */ #ifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_02 /* Common,DEFV(Fonction,) : avec 'VERSION_02'. */ DEFV(Common,DEFV(Logical,_____LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_02)); #Aifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_02 /* Common,DEFV(Fonction,) : avec 'VERSION_02'. */ #Eifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_02 /* Common,DEFV(Fonction,) : avec 'VERSION_02'. */ #ifdef CONVOLUTION_DE_imageA_D_ERODE______COTES_2D_VERSION_01 /* Common,DEFV(Fonction,) : avec 'VERSION_01'. */ DEFV(Common,DEFV(Logical,_____CONVOLUTION_DE_imageA_D_ERODE______COTES_2D_VERSION_01)); #Aifdef CONVOLUTION_DE_imageA_D_ERODE______COTES_2D_VERSION_01 /* Common,DEFV(Fonction,) : avec 'VERSION_01'. */ #Eifdef CONVOLUTION_DE_imageA_D_ERODE______COTES_2D_VERSION_01 /* Common,DEFV(Fonction,) : avec 'VERSION_01'. */ #ifdef CONVOLUTION_DE_imageA_D_ERODE______COTES_2D_VERSION_02 /* Common,DEFV(Fonction,) : avec 'VERSION_02'. */ DEFV(Common,DEFV(Logical,_____CONVOLUTION_DE_imageA_D_ERODE______COTES_2D_VERSION_02)); #Aifdef CONVOLUTION_DE_imageA_D_ERODE______COTES_2D_VERSION_02 /* Common,DEFV(Fonction,) : avec 'VERSION_02'. */ #Eifdef CONVOLUTION_DE_imageA_D_ERODE______COTES_2D_VERSION_02 /* Common,DEFV(Fonction,) : avec 'VERSION_02'. */ #ifdef CONVOLUTION_DE_imageA_D_ERODE______COTES_2D_VERSION_01 #Aifdef CONVOLUTION_DE_imageA_D_ERODE______COTES_2D_VERSION_01 #Eifdef CONVOLUTION_DE_imageA_D_ERODE______COTES_2D_VERSION_01 #ifdef CONVOLUTION_DE_imageA_D_ERODE______COTES_2D_VERSION_02 /* Common,DEFV(Fonction,) : objets statiques. */ # ifdef GESTION_DES_IMAGES_STATIQUES_VERSION_01 DEFV(Local,DEFV(Statique,DEFV(imageF,Ierode__CoastLines_2D_____imageA_convoluee_initiale))); # Aifdef GESTION_DES_IMAGES_STATIQUES_VERSION_01 # Eifdef GESTION_DES_IMAGES_STATIQUES_VERSION_01 # ifdef GESTION_DES_IMAGES_STATIQUES_VERSION_02 /* Common,DEFV(Fonction,) : objets statiques. */ DEFV(Common,DEFV(Statique,DEFV(imageF,Ierode__CoastLines_2D_____imageA_convoluee_initiale))); /* Image Argument initiale apres la convolution. ATTENTION, elle doit etre 'Common' a cause */ /* de 'v $xcc/cpp$Z D_STATIK' (alors qu'en toute logique 'Local' serait preferable...). */ # Aifdef GESTION_DES_IMAGES_STATIQUES_VERSION_02 /* Common,DEFV(Fonction,) : objets statiques. */ # Eifdef GESTION_DES_IMAGES_STATIQUES_VERSION_02 /* Common,DEFV(Fonction,) : objets statiques. */ #Aifdef CONVOLUTION_DE_imageA_D_ERODE______COTES_2D_VERSION_02 /* Common,DEFV(Fonction,) : objets statiques. */ #Eifdef CONVOLUTION_DE_imageA_D_ERODE______COTES_2D_VERSION_02 /* Common,DEFV(Fonction,) : objets statiques. */ DEFV(Common,DEFV(Logical,ZINT(Ierode__CoastLines_2D_____utiliser_la_longueur_globale,VRAI))); /* Afin de savoir si l'on utilise la longueur globale (correspondant au fonctionnement */ /* anterieur au 20011218141239) ou bien la longueur au voisinage de chaque point... */ DEFV(Common,DEFV(Float,ZINT(Ierode__CoastLines_2D_____amplificateur_de_la_force,FU))); /* Amplificateur de la force de la mer (introduit le 20020116095643). */ DEFV(Common,DEFV(Logical,ZINT(Ierode__CoastLines_2D_____la_force_depend_du_niveau_local_de_la_mer,FAUX))); /* Afin de savoir si l'on fait un calcul "independant du temps" (correspondant au */ /* fonctionnement anterieur au 20020111161044), ou bien si le calcul de la force au */ /* point {X,Y} depend du niveau moyen de la mer dans le voisinage de ce point... */ DEFV(Common,DEFV(Logical,ZINT(Ierode__CoastLines_2D_____marquer_les_points_erodes_avec_la_force,VRAI))); DEFV(Common,DEFV(genere_Float,ZINT(Ierode__CoastLines_2D_____marqueur_des_points_erodes ,NIVEAU_DE_LA___MER_DANS_Ierode__CoastLines_2D ) ) ); /* Afin de pouvoir marquer les points erodes avec la valeur courante de la force de la mer */ /* ou bien a l'aide d'une valeur arbitraire... */ DEFV(Common,DEFV(Positive,ZINT(Ierode__CoastLines_2D_____demi_dimension_X_du_domaine_de_calcul_de_la_longueur_locale,CINQ))); DEFV(Common,DEFV(Positive,ZINT(Ierode__CoastLines_2D_____demi_dimension_Y_du_domaine_de_calcul_de_la_longueur_locale,CINQ))); /* Definition de la taille du domaine de calcul de la longueur locale dans le cas ou */ /* 'IL_FAUT(Ierode__CoastLines_2D_____utiliser_la_longueur_globale)'. On notera que cela ne */ /* devrait exister qu'en 'CONVOLUTION_DE_albumA_D_ERODE______COTES_2D_VERSION_02', mais que */ /* cela existe systematiquement pour simplifier 'v $xci/CoastL_2D.11$K'... */ DEFV(Common,DEFV(Float,ZINT(Ierode__CoastLines_2D_____agrandissement_du_domaine_de_calcul_de_la_longueur_locale,FDEUX))); /* Definition du facteur d'agrandissement du domaine de calcul de la longueur locale dans */ /* le cas ou l'on ne trouve pas de points de la cote initiale... */ #ifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_01 # define CONVOLUTION_DE_MESURE_DE_LA_LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D(imageA_convoluee) \ Bblock \ CALS(IFFconvolution(imageA_convoluee \ ,FU \ ,imageA \ ,Ierode__CoastLines_2D_____nombre_de_points_du_noyau_de_convolution \ ,Ierode__CoastLines_2D_____noyau_de_convolution \ ,Ierode__CoastLines_2D_____inhibition_du_noyau_de_convolution \ ) \ ); \ /* Convolution de 'imageA'. */ \ Eblock # define RENORMALISATEUR_DE_LA_LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D \ UN #Aifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_01 #Eifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_01 #ifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_02 # define CONVOLUTION_DE_MESURE_DE_LA_LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D(imageA_convoluee) \ Bblock \ CALS(IFFconvolution_de_seuillage(imageA_convoluee \ ,imageA \ ,Ierode__CoastLines_2D_____nombre_de_points_du_noyau_de_convolution \ ,Ierode__CoastLines_2D_____noyau_de_convolution \ ,Ierode__CoastLines_2D_____inhibition_du_noyau_de_convolution \ ,NIVEAU______MEDIAN_DANS_Ierode__CoastLines_2D \ ,MIN2(Ierode__CoastLines_2D_____niveau_de_la_terre \ ,Ierode__CoastLines_2D_____niveau_de_la___mer \ ) \ ,NIVEAU______MEDIAN_DANS_Ierode__CoastLines_2D \ ,MAX2(Ierode__CoastLines_2D_____niveau_de_la_terre \ ,Ierode__CoastLines_2D_____niveau_de_la___mer \ ) \ ) \ ); \ /* Convolution de 'imageA' avec seuillage. */ \ Eblock # define RENORMALISATEUR_DE_LA_LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D \ COND(IZGT(dimension_effective_du_noyau_de_convolution),dimension_effective_du_noyau_de_convolution,UN) #Aifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_02 #Eifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_02 DEFV(Local,DEFV(Positive,INIT(dimension_effective_du_noyau_de_convolution,FLOT__UNDEF))); /* Dimension effective du noyau de convolution utile pour renormaliser la longueur... */ DEFV(Common,DEFV(Positive,ZINT(Ierode__CoastLines_2D_____longueur_de_la_cote_courante,INFINI))); /* Longueur de la cote courante afin de pouvoir l'utiliser a l'exterieur (en particulier */ /* pour savoir si elle est nulle, auquel cas, le processus est termine...). On notera la */ /* valeur initiale 'INFINI' qui est choisie ainsi car elle n'est pas nulle... */ #define LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D(imageA_convoluee,niveau_minimum,niveau_maximum,epaisseur_cote,longueur_cote) \ Bblock \ EGAL(dimension_effective_du_noyau_de_convolution \ ,INTE(TRMU(RAC2(Ierode__CoastLines_2D_____nombre_de_points_du_noyau_de_convolution))) \ ); \ /* Dimension effective du noyau de convolution utile pour renormaliser la longueur... */ \ /* On notera au passage que ce calcul peut etre fait plusieurs fois de facon redondante... */ \ /* */ \ /* Le 20070227142447, 'PUIX(...,INVE(BI_DIMENSIONNEL))' fut remplace par 'RAC2(...)'. */ \ \ CALS(IFnivo_extrema(imageA \ ,ADRESSE(niveau_minimum) \ ,ADRESSE(niveau_maximum) \ ) \ ); \ /* Recherche des extrema de 'imageA'. */ \ EGAL(epaisseur_cote \ ,MUL2(Ierode__CoastLines_2D_____facteur_d_epaisseur_de_la_cote \ ,SOUS(niveau_maximum,niveau_minimum) \ ) \ ); \ /* Et evaluation d'une epaisseur de la cote. */ \ \ Test(IL_FAUT(Ierode__CoastLines_2D_____initialiser)) \ Bblock \ DEFV(Int,INIT(index,UNDEF)); \ /* Index d'initialisation du noyau. */ \ \ DoIn(index \ ,PREMIER_POINT \ ,LSTX(PREMIER_POINT,Ierode__CoastLines_2D_____nombre_de_points_du_noyau_de_convolution) \ ,I \ ) \ Bblock \ EGAL(ITb1(Ierode__CoastLines_2D_____noyau_de_convolution,INDX(index,PREMIER_POINT)) \ ,FU \ ); \ EGAL(ITb1(Ierode__CoastLines_2D_____inhibition_du_noyau_de_convolution,INDX(index,PREMIER_POINT)) \ ,ACTIF \ ); \ /* Initialisation du noyau de convolution... */ \ Eblock \ EDoI \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ CONVOLUTION_DE_MESURE_DE_LA_LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D(imageA_convoluee); \ /* Convolution de 'imageA'. */ \ \ EGAL(longueur_cote \ ,DIVI(IFcomptage_des_points_dans_un_intervalle(imageA_convoluee \ ,SOUS(NIVEAU______MEDIAN_DANS_Ierode__CoastLines_2D \ ,Ierode__CoastLines_2D_____epaisseur_de_la_cote_initiale \ ) \ ,ADD2(NIVEAU______MEDIAN_DANS_Ierode__CoastLines_2D \ ,Ierode__CoastLines_2D_____epaisseur_de_la_cote_initiale \ ) \ ) \ ,RENORMALISATEUR_DE_LA_LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D \ ) \ ); \ /* Evaluation de la longueur de la cote initiale exprimee par un nombre de points possedant */ \ /* "a epsilon" pres (definit par 'Ierode__CoastLines_2D_____epaisseur_de_la_cote_initiale') */ \ /* un niveau nul. ATTENTION : c'est bien l'epaisseur initiale de la cote qu'il faut utiliser */ \ /* ('Ierode__CoastLines_2D_____epaisseur_de_la_cote_initiale') et non pas l'epaisseur */ \ /* courante 'epaisseur_cote' afin d'etre sur de mesurer toujours la longeur de la */ \ /* meme facon... */ \ /* */ \ /* ATTENTION : j'ai note le 20020118085657 (c'est-a-dire avec pas mal de retard...) que ce */ \ /* n'etait pas longueur euclidienne que l'on evaluait ainsi. Le modele n'est donc pas */ \ /* invariant par rotation : par exemple, une cote rectiligne horizontale (ou verticale) */ \ /* de 'N' points mesure 'N' unites, de meme qu'une cote rectiligne incline de pi/4 composee */ \ /* elle-aussi de 'N' points ; elle mesure donc 'N' unites alors qu'elle devrait mesurer 'N' */ \ /* unites multiplie par racine de 2. Ce phenomene est la cause du probleme decrit longuement */ \ /* en 'v _____xivPdf_14_1/$Fnota 20020117135014'... */ \ Eblock \ /* Acces a l'etat associe a un point {x,y}. */ DEFV(Common,DEFV(genere_Float,ZINT(Ierode__CoastLines_2D_____niveau_de_la___mer,NIVEAU_DE_LA___MER_DANS_Ierode__CoastLines_2D))); DEFV(Common,DEFV(genere_Float,ZINT(Ierode__CoastLines_2D_____niveau_de_la_terre,NIVEAU_DE_LA_TERRE_DANS_Ierode__CoastLines_2D))); #define NIVEAU______MEDIAN_DANS_Ierode__CoastLines_2D \ MOYE(Ierode__CoastLines_2D_____niveau_de_la___mer,Ierode__CoastLines_2D_____niveau_de_la_terre) #define NIVEAU_HORS_IMAGE_DANS_Ierode__CoastLines_2D \ NIVEAU_DE_LA_TERRE_DANS_Ierode__CoastLines_2D /* Niveaux "speciaux"... */ DEFV(Common,DEFV(Logical,ZINT(Ierode__CoastLines_2D_____initialiser,VRAI))); /* Faut-il initialiser le modele ? */ DEFV(Local,DEFV(genere_Float,INIT(Ierode__CoastLines_2D_____niveau_minimum_initial,FLOT__NIVEAU_UNDEF))); DEFV(Local,DEFV(genere_Float,INIT(Ierode__CoastLines_2D_____niveau_maximum_initial,FLOT__NIVEAU_UNDEF))); /* Extrema du champ initial ('imageA'). */ #ifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_01 # define NOMBRE_DE_POINTS_DU_NOYAU_DE_CONVOLUTION_D_ERODE______COTES_2D \ EXP2(DOUP(UN)) #Aifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_01 #Eifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_01 #ifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_02 # define NOMBRE_DE_POINTS_DU_NOYAU_DE_CONVOLUTION_D_ERODE______COTES_2D \ EXP2(DOUB(UN)) #Aifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_02 #Eifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_02 DEFV(Common,DEFV(Int,ZINT(Ierode__CoastLines_2D_____nombre_de_points_du_noyau_de_convolution ,NOMBRE_DE_POINTS_DU_NOYAU_DE_CONVOLUTION_D_ERODE______COTES_2D ) ) ); /* Nombre de points du noyau. */ DEFV(Local,DEFV(Float,DTb1(Ierode__CoastLines_2D_____noyau_de_convolution ,TAILLE_MAXIMALE_D_UN_NOYAU_DE_CONVOLUTION ) ) ); /* Noyau de la convolution, */ DEFV(Local,DEFV(Logical,DTb1(Ierode__CoastLines_2D_____inhibition_du_noyau_de_convolution ,TAILLE_MAXIMALE_D_UN_NOYAU_DE_CONVOLUTION ) ) ); /* Et sa liste d'activite. */ #define RESISTANCE_NULLE_D_UN_POINT_DE_LA_COTE_DANS_Ierode__CoastLines_2D \ FZERO DEFV(Common,DEFV(Positive,ZINT(Ierode__CoastLines_2D_____nombre_de_voisins_mer_d_un_point_terre_amorcant_l_erosion,UN))); /* Nombre de voisins de type "mer" d'un point de "terre" a partir duquel ce point de "terre" */ /* va etre erode. Cela a ete introduit le 20020117153753 a cause d'un probleme recontre dans */ /* 'v _____xivPdf_14_1/$Fnota 20020117135014'. */ DEFV(Common,DEFV(Positive,ZINT(Ierode__CoastLines_2D_____nombre_minimal_de_voisins_mer_d_un_point_terre_forcant_l_erosion,TROIS))); /* Nombre minimal de voisins de type "mer" d'un point de "terre" qui provoque la mise a */ /* zero de 'resistance_du_point_courant_de_la_terre' de ce point "terre"... */ DEFV(Common,DEFV(Float,ZINT(Ierode__CoastLines_2D_____facteur_du_nombre_d_etats_de_type___mer,FU))); DEFV(Common,DEFV(Float,ZINT(Ierode__CoastLines_2D_____translateur_du_nombre_d_etats_de_type___mer,FZERO))); /* Facteur et "translateur" de 'nombre_d_etats_de_type___mer' lors du calcul de la */ /* resistance du point courant {X,Y}. Le facteur a ete introduit le 20020108105626, */ /* alors que le "translateur" a ete introduit le 20020117134323. */ #ifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_01 # define FACTEUR_D_EPAISSEUR_DE_LA_COTE_DANS_Ierode__CoastLines_2D \ GRO8(FRA10(FRA10(FU))) #Aifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_01 #Eifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_01 #ifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_02 # define FACTEUR_D_EPAISSEUR_DE_LA_COTE_DANS_Ierode__CoastLines_2D \ FZERO #Aifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_02 #Eifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_02 DEFV(Common,DEFV(Float,ZINT(Ierode__CoastLines_2D_____facteur_d_epaisseur_de_la_cote ,FACTEUR_D_EPAISSEUR_DE_LA_COTE_DANS_Ierode__CoastLines_2D ) ) ); /* Afin d'evaluer la longueur de la cote. On notera que ce parametre (de meme que la notion */ /* d'epaisseur) n'a de sens que pour 'LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_01', */ /* mais est conserve pour des raisons de compatibilite et de simplicite... */ DEFV(Local,DEFV(Float,INIT(Ierode__CoastLines_2D_____epaisseur_de_la_cote_initiale,FLOT__UNDEF))); DEFV(Local,DEFV(Positive,INIT(Ierode__CoastLines_2D_____longueur_de_la_cote_initiale,FLOT__UNDEF))); /* "Epaisseur" et longueur de la cote initiale. */ DEFV(Common,DEFV(Logical,ZINT(Ierode__CoastLines_2D_____periodiser_X,FAUX))); DEFV(Common,DEFV(Logical,ZINT(Ierode__CoastLines_2D_____periodiser_Y,FAUX))); /* Options par defaut de periodisation des axes. */ DEFV(Common,DEFV(Logical,ZINT(Ierode__CoastLines_2D_____symetriser_X,FAUX))); DEFV(Common,DEFV(Logical,ZINT(Ierode__CoastLines_2D_____symetriser_Y,FAUX))); /* Options par defaut de symetrisation des axes (introduites le 20050721103950). */ DEFV(Common,DEFV(Logical,ZINT(Ierode__CoastLines_2D_____prolonger_X,FAUX))); DEFV(Common,DEFV(Logical,ZINT(Ierode__CoastLines_2D_____prolonger_Y,FAUX))); /* Options par defaut de prolongement des axes. */ DEFV(Common,DEFV(genere_Float,ZINT(Ierode__CoastLines_2D_____niveau_hors_image,NIVEAU_HORS_IMAGE_DANS_Ierode__CoastLines_2D))); /* Options par defaut du niveau "hors-image". */ DEFV(Common,DEFV(Logical,ZINT(Ierode__CoastLines_2D_____utiliser_un_noyau,FAUX))); /* Options par defaut de choix entre la methode "des quatre plus proches voisins" ('FAUX') */ /* et la methode dite "a noyau" ('VRAI'). */ DEFV(Common,DEFV(Float,ZINT(Ierode__CoastLines_2D_____ponderation_du_point_sX__Y ,PONDERATION_D_UN_POINT_DANS_Ierode__CoastLines_2D ) ) ); DEFV(Common,DEFV(Float,ZINT(Ierode__CoastLines_2D_____ponderation_du_point__X_sY ,PONDERATION_D_UN_POINT_DANS_Ierode__CoastLines_2D ) ) ); DEFV(Common,DEFV(Float,ZINT(Ierode__CoastLines_2D_____ponderation_du_point_pX__Y ,PONDERATION_D_UN_POINT_DANS_Ierode__CoastLines_2D ) ) ); DEFV(Common,DEFV(Float,ZINT(Ierode__CoastLines_2D_____ponderation_du_point__X_pY ,PONDERATION_D_UN_POINT_DANS_Ierode__CoastLines_2D ) ) ); /* Definition des facteurs des points du voisinage du point courant {X,Y}. */ DEFV(Common,DEFV(Logical,ZINT(Ierode__CoastLines_2D_____initialiser_le_noyau,VRAI))); DEFV(Common,DEFV(Int,ZINT(Ierode__CoastLines_2D_____demi_dimension_effective_du_noyau ,DEMI_DIMENSION_STANDARD_DU_NOYAU_DANS_Ierode__CoastLines_2D ) ) ); DEFV(Common,DEFV(Float,DTb2(Ierode__CoastLines_2D_____noyau,DimNo_Ierode__CoastLines_2D,DimNo_Ierode__CoastLines_2D))); DEFV(Common,DEFV(Float,INIT(POINTERf(PIerode__CoastLines_2D_____noyau) ,ADRESSE(ACCES_NOYAU_DANS_Ierode__CoastLines_2D(Ierode__CoastLines_2D_____XYmin ,Ierode__CoastLines_2D_____XYmin ) ) ) ) ); /* Definition du noyau a utiliser dans 'Ierode__CoastLines_2D(...)', ainsi que d'un */ /* indicateur disant si l'initialisation doit etre faite et de la demi-dimension effective */ /* (inferieure ou egale a 'DEMI_DIMENSION_MAXIMALE_DU_NOYAU_DANS_Ierode__CoastLines_2D') */ /* de ce dernier. */ /* */ /* ATTENTION, la ligne relative a 'DTb2(...)' doit tenir sur une seule ligne a cause de */ /* '$xcg/gen.ext$Z'... */ /* */ /* Le pointeur 'PIerode__CoastLines_2D_____noyau' a ete introduit le 20010222110806 pour */ /* permettre des acces de type 'IloadF_image(...)' au noyau... */ DEFV(Common,DEFV(Int,ZINT(Ierode__CoastLines_2D_____delta_X,ZERO))); DEFV(Common,DEFV(Int,ZINT(Ierode__CoastLines_2D_____delta_Y,ZERO))); /* Translation des points du voisinage du point courant {X,Y}. */ DEFV(Common,DEFV(Positive,INIT(Ierode__CoastLines_2D_____nombre_de_points_erodes_a_l_iteration_courante,UNDEF))); /* Afin de savoir combien de points de "terre" ont ete erodes par la "mer" au cours de */ /* l'iteration courante... */ #define TAUX_D_AFFAIBLISSEMENT_DE_LA_DURETE_DE_LA_TERRE(x,y) \ loadF_point(taux_d_affaiblissement_de_la_durete_de_la_terre_local,x,y) #define FACTEUR_D_ANTI_CORROSITE_DE_LA_MER(x,y) \ loadF_point(facteur_d_anti_corrosite_de_la_mer_local,x,y) /* Acces aux caracteristiques de la terre et de la mer associees a un point {x,y}. */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* M O D E L E B I D I M E N S I O N N E L D E C O T E S A V E C E R O S I O N */ /* A T A U X D ' A F F A I B L I S S E M E N T D E L A T E R R E E T A C O R R O S I T E */ /* L O C A U X : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(Ierode__CoastLines_2D_a_taux_facteur_locaux(imageR ,imageA ,imageA_convoluee_initiale ,taux_d_affaiblissement_de_la_durete_de_la_terre_local ,facteur_d_anti_corrosite_de_la_mer_local ,editer_la_longueur_de_la_cote_courante ) ) ) ) DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR=CoastLines(imageA). */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument a traiter par le modele Lignes de Cotes bidimensionnel. */ DEFV(Argument,DEFV(imageF,imageA_convoluee_initiale)); /* Image Argument initiale convoluee. En fait cela a ete introduit le 20011222183235 afin */ /* de faciliter son allocation memoire dans 'v $xcc/cpp$Z D_STATIK' car, en effet, */ /* 'Ierode__CoastLines_2D_____imageA_convoluee_initiale' apparait bien dans la liste des */ /* objets de type 'D_STATIK(...)', mais pour que son allocation soit faire a la suite de */ /* 'G_STATIK(...)' il faut qu'il soit utilise au moins une fois, ce qui est le cas depuis */ /* qu'il est argument de la fonction 'Ierode__CoastLines_2D(...)'. */ DEFV(Argument,DEFV(imageF,taux_d_affaiblissement_de_la_durete_de_la_terre_local)); DEFV(Argument,DEFV(imageF,facteur_d_anti_corrosite_de_la_mer_local)); /* Caracteristiques de la terre et de la mer respectivement. */ /* */ /* ATTENTION, on notera que le 20020208093402, la "corrosite" est devenue "anti-corrosite" */ /* (il s'agit juste d'une modification dans la terminologie), lorsque je me suis rendu */ /* compte, en mettant au point la sequence 'v _____xivPdf_14_1/$Fnota 019535_020046', qu'en */ /* fait plus ce parametre avait une valeur proche de 0, plus la mer etait corrosive et */ /* que plus cette valeur etait proche de 1, moins elle l'etait. Il s'agit donc bien alors */ /* de la propriete complementaire de celle de la "corrosite"... */ DEFV(Argument,DEFV(Logical,editer_la_longueur_de_la_cote_courante)); /* Afin de permettre l'edition de la longueur de la cote courante... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(genere_Float,INIT(niveau_minimum_courant,FLOT__UNDEF)); DEFV(genere_Float,INIT(niveau_maximum_courant,FLOT__UNDEF)); DEFV(Float,INIT(epaisseur_de_la_cote_courante,FLOT__UNDEF)); /* Caracteristiques de la cote courante... */ BDEFV(imageF,imageA_convoluee_courante); /* Image Argument courante apres la convolution. */ /*..............................................................................................................................*/ #ifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_01 #Aifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_01 #Eifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_01 #ifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_02 Test(IFNE(Ierode__CoastLines_2D_____facteur_d_epaisseur_de_la_cote,FACTEUR_D_EPAISSEUR_DE_LA_COTE_DANS_Ierode__CoastLines_2D)) Bblock PRINT_ATTENTION("le parametre 'Ierode__CoastLines_2D_____facteur_d_epaisseur_de_la_cote' n'a plus de sens"); EGAL(Ierode__CoastLines_2D_____facteur_d_epaisseur_de_la_cote,FACTEUR_D_EPAISSEUR_DE_LA_COTE_DANS_Ierode__CoastLines_2D); Eblock ATes Bblock Eblock ETes #Aifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_02 #Eifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_02 CLIR(Ierode__CoastLines_2D_____nombre_de_points_erodes_a_l_iteration_courante); /* A priori aucun points de "terre" n'a encore ete erode par la "mer" au cours de */ /* l'iteration courante... */ Test(IL_FAUT(Ierode__CoastLines_2D_____initialiser)) Bblock LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D(imageA_convoluee_initiale ,Ierode__CoastLines_2D_____niveau_minimum_initial ,Ierode__CoastLines_2D_____niveau_maximum_initial ,Ierode__CoastLines_2D_____epaisseur_de_la_cote_initiale ,Ierode__CoastLines_2D_____longueur_de_la_cote_initiale ); /* Evaluation de la longueur de la cote initiale... */ #ifdef CONVOLUTION_DE_imageA_D_ERODE______COTES_2D_VERSION_01 #Aifdef CONVOLUTION_DE_imageA_D_ERODE______COTES_2D_VERSION_01 #Eifdef CONVOLUTION_DE_imageA_D_ERODE______COTES_2D_VERSION_01 #ifdef CONVOLUTION_DE_imageA_D_ERODE______COTES_2D_VERSION_02 CALS(IFmove(imageA_convoluee_courante,imageA_convoluee_initiale)); /* Et on conserve les conditions initiales de 'imageA' convoluee. */ #Aifdef CONVOLUTION_DE_imageA_D_ERODE______COTES_2D_VERSION_02 #Eifdef CONVOLUTION_DE_imageA_D_ERODE______COTES_2D_VERSION_02 EGAL(niveau_minimum_courant,Ierode__CoastLines_2D_____niveau_minimum_initial); EGAL(niveau_maximum_courant,Ierode__CoastLines_2D_____niveau_maximum_initial); EGAL(epaisseur_de_la_cote_courante,Ierode__CoastLines_2D_____epaisseur_de_la_cote_initiale); EGAL(Ierode__CoastLines_2D_____longueur_de_la_cote_courante,Ierode__CoastLines_2D_____longueur_de_la_cote_initiale); /* Et quelques mises a jour au cas ou... */ EGAL(Ierode__CoastLines_2D_____initialiser,FAUX); /* L'initialisation est faite... */ Eblock ATes Bblock LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D(imageA_convoluee_courante ,niveau_minimum_courant ,niveau_maximum_courant ,epaisseur_de_la_cote_courante ,Ierode__CoastLines_2D_____longueur_de_la_cote_courante ); /* Evaluation de la longueur de la cote courante... */ Eblock ETes Test(IL_FAUT(editer_la_longueur_de_la_cote_courante)) Bblock CAL3(Prme1("longueur de la cote courante avant l'evolution=%d\n",Ierode__CoastLines_2D_____longueur_de_la_cote_courante)); /* Ainsi, on edite bien 'Ierode__CoastLines_2D_____longueur_de_la_cote_initiale' apres */ /* l'initialisation du modele (mais pas la longueur de la cote obtenue apres la derniere */ /* iteration, mais c'est bien ainsi car cette derniere est beaucoup moins importante que */ /* la longueur initiale (par exemple pour la valider par rapport a 'dimX'...). */ Eblock ATes Bblock Eblock ETes INITIALISATION_EVENTUELLE_DU_NOYAU_DANS_Ierode__CoastLines_2D; /* Initialisation si necessaire du noyau (dans le cas ou il est de plus utilise...). */ begin_image Bblock DEFV(Positive,INIT(nombre_d_etats_de_type_terre,ZERO)); DEFV(Positive,INIT(nombre_d_etats__indetermines,ZERO)); DEFV(Positive,INIT(nombre_d_etats_de_type___mer,ZERO)); /* Comptabilite des differents signes possibles de l'"etat". */ DEFV(genere_Float,INIT(moyenne_des_etats_de_type_terre,FZERO)); DEFV(genere_Float,INIT(moyenne_des_etats__indetermines,FZERO)); DEFV(genere_Float,INIT(moyenne_des_etats_de_type___mer,FZERO)); /* Moyenne des differents "etat"s. */ DEFV(genere_Float,INIT(etat__X__Y,FLOT__UNDEF)); DEFV(genere_Float,INIT(nouvel_etat__X__Y,FLOT__UNDEF)); /* Etat du point courant {X,Y} et son etat futur... */ Test(IL_FAUT(Ierode__CoastLines_2D_____utiliser_un_noyau)) Bblock #define Xc \ EnTete_de_sauvegardM ## X #define Yc \ EnTete_de_sauvegardM ## Y /* Memorisation du point courant {Xc,Yc} (on notera que la procedure 'begin_imageQ(...)' */ /* permet d'y acceder via '{SavM_____X,SavM_____Y}). */ DEFV(genere_Float,INIT(etat_iX_jY,FLOT__UNDEF)); /* Etat du point courant du voisinage du point {Xc,Yc}. */ begin_imageQ(DoIn,Ierode__CoastLines_2D_____XYmin_effectif,Ierode__CoastLines_2D_____XYmax_effectif,PasY ,DoIn,Ierode__CoastLines_2D_____XYmin_effectif,Ierode__CoastLines_2D_____XYmax_effectif,PasX ) Bblock /* ATTENTION : dans cette boucle {X,Y} designent l'element courant du noyau, alors que */ /* {Xc,Yc} designent le point courant dont on etudie le voisinage... */ Test(IFET(IZEQ(X),IZEQ(Y))) Bblock ACCES_A_UN_POINT_D_ERODE______COTES_2D(etat__X__Y ,NEUT(Xc),ZERO ,NEUT(Yc),ZERO ,PONDERATION_D_UN_POINT_DANS_Ierode__CoastLines_2D ); /* Traitement du point courant {Xc,Yc}. */ Eblock ATes Bblock ACCES_A_UN_POINT_D_ERODE______COTES_2D(etat_iX_jY ,ADD2(Xc,X),Ierode__CoastLines_2D_____delta_X ,ADD2(Yc,Y),Ierode__CoastLines_2D_____delta_Y ,ACCES_NOYAU_DANS_Ierode__CoastLines_2D(X,Y) ); /* Traitement du point courant {Xc+X,Yc+Y} du voisinage du point {Xc,Yc}. */ Eblock ETes Eblock end_imageQ(EDoI,EDoI) #undef Yc #undef Xc Eblock ATes Bblock DEFV(genere_Float,INIT(etat_sX__Y,FLOT__UNDEF)); DEFV(genere_Float,INIT(etat__X_sY,FLOT__UNDEF)); DEFV(genere_Float,INIT(etat_pX__Y,FLOT__UNDEF)); DEFV(genere_Float,INIT(etat__X_pY,FLOT__UNDEF)); /* Etats des voisins du point {X,Y}. */ ACCES_A_UN_POINT_D_ERODE______COTES_2D(etat__X__Y ,NEUT(X),ZERO ,NEUT(Y),ZERO ,PONDERATION_D_UN_POINT_DANS_Ierode__CoastLines_2D ); ACCES_A_UN_POINT_D_ERODE______COTES_2D(etat_sX__Y ,SUCX(X),Ierode__CoastLines_2D_____delta_X ,NEUT(Y),Ierode__CoastLines_2D_____delta_Y ,Ierode__CoastLines_2D_____ponderation_du_point_sX__Y ); ACCES_A_UN_POINT_D_ERODE______COTES_2D(etat__X_sY ,NEUT(X),Ierode__CoastLines_2D_____delta_X ,SUCY(Y),Ierode__CoastLines_2D_____delta_Y ,Ierode__CoastLines_2D_____ponderation_du_point__X_sY ); ACCES_A_UN_POINT_D_ERODE______COTES_2D(etat_pX__Y ,PREX(X),Ierode__CoastLines_2D_____delta_X ,NEUT(Y),Ierode__CoastLines_2D_____delta_Y ,Ierode__CoastLines_2D_____ponderation_du_point_pX__Y ); ACCES_A_UN_POINT_D_ERODE______COTES_2D(etat__X_pY ,NEUT(X),Ierode__CoastLines_2D_____delta_X ,PREY(Y),Ierode__CoastLines_2D_____delta_Y ,Ierode__CoastLines_2D_____ponderation_du_point__X_pY ); /* Etats des points utiles avec ponderation eventuelle. */ Eblock ETes EGAL(moyenne_des_etats_de_type_terre,DIVZ(moyenne_des_etats_de_type_terre,FLOT(nombre_d_etats_de_type_terre))); EGAL(moyenne_des_etats__indetermines,DIVZ(moyenne_des_etats__indetermines,FLOT(nombre_d_etats__indetermines))); EGAL(moyenne_des_etats_de_type___mer,DIVZ(moyenne_des_etats_de_type___mer,FLOT(nombre_d_etats_de_type___mer))); /* Moyenne des differents "etat"s. */ EGAL(nouvel_etat__X__Y,etat__X__Y); /* A priori, l'etat du point courant {X,Y} est inchange... */ Test(UN_POINT_D_ERODE______COTES_2D_EST_SUR_LA_TERRE(etat__X__Y)) /* Cas ou l'on est sur la terre : */ Bblock Test(IFGT(ABSO(etat__X__Y),ABSO(Ierode__CoastLines_2D_____niveau_de_la_terre))) Bblock PRINT_ERREUR("un niveau de la terre est incorrect, il vaut :"); CAL1(Prer3("niveau(%d,%d) = %g\n",X,Y,etat__X__Y)); Eblock ATes Bblock Eblock ETes Test(IZGT(nombre_d_etats_de_type___mer)) Bblock DEFV(Float,INIT(longueur_effective_de_la_cote_initiale,Ierode__CoastLines_2D_____longueur_de_la_cote_initiale)); DEFV(Float,INIT(longueur_effective_de_la_cote_courante,Ierode__CoastLines_2D_____longueur_de_la_cote_courante)); /* Longueurs de la cote (initiale et courante) a utiliser a priori pour le calcul */ /* de 'force_de_la_mer_au_point_courant'. */ DEFV(Float,INIT(resistance_du_point_courant_de_la_terre,FLOT__UNDEF)); /* Resistance du point courant de la terre... */ DEFV(Float,INIT(force_de_la_mer_au_point_courant,FLOT__UNDEF)); /* Force de la mer au point courant... */ EGAL(nouvel_etat__X__Y ,MUL2(COMP(TAUX_D_AFFAIBLISSEMENT_DE_LA_DURETE_DE_LA_TERRE(X,Y)),nouvel_etat__X__Y) ); /* Le point courant {X,Y} de la terre s'affaiblit au cours du temps et reste de la terre */ /* (provisoirement peut-etre...). Pour respecter le modele original, il conviendrait de */ /* n'appliquer cet affaiblissement que lorsque la cote a atteint un etat stable. Cela peut */ /* etre realise de deux facons presque equivalentes : d'une part, il est possible de donner */ /* a ce taux 'taux_d_affaiblissement_de_la_durete_de_la_terre' une valeur tres faible (par */ /* exemple 'GRO5(FRA10(FRA10(FRA10(FRA10(FRA10(FU))))))') ; d'autre part, faire plusieurs */ /* simulations successives : une premiere, longue avec un taux nul, une seconde tres courte */ /* avec un taux non nul, une troisieme, longue avec un taux nul, une quatrieme tres courte */ /* avec un taux non nul, etc... */ EGAL(resistance_du_point_courant_de_la_terre ,COND(IFLT(nombre_d_etats_de_type___mer ,Ierode__CoastLines_2D_____nombre_de_voisins_mer_d_un_point_terre_amorcant_l_erosion ) ,ABSO(nouvel_etat__X__Y) ,COND(IFLT(nombre_d_etats_de_type___mer ,Ierode__CoastLines_2D_____nombre_minimal_de_voisins_mer_d_un_point_terre_forcant_l_erosion ) ,PUIX(ABSO(nouvel_etat__X__Y) ,AXPB(Ierode__CoastLines_2D_____facteur_du_nombre_d_etats_de_type___mer ,nombre_d_etats_de_type___mer ,Ierode__CoastLines_2D_____translateur_du_nombre_d_etats_de_type___mer ) ) ,RESISTANCE_NULLE_D_UN_POINT_DE_LA_COTE_DANS_Ierode__CoastLines_2D ) ) ); /* Etude de la resistance du point courant {X,Y} par rapport a son environnement : cette */ /* resistance est d'autant plus faible que le point courant {X,Y} est davantage entoure */ /* par la mer. On notera que cette resistance est une valeur positive (ou nulle afin de */ /* forcer l'erosion, ce qui a ete introduit le 20011210161803). */ #ifdef CONVOLUTION_DE_imageA_D_ERODE______COTES_2D_VERSION_01 #Aifdef CONVOLUTION_DE_imageA_D_ERODE______COTES_2D_VERSION_01 #Eifdef CONVOLUTION_DE_imageA_D_ERODE______COTES_2D_VERSION_01 #ifdef CONVOLUTION_DE_imageA_D_ERODE______COTES_2D_VERSION_02 Test(IL_FAUT(Ierode__CoastLines_2D_____utiliser_la_longueur_globale)) Bblock Eblock ATes Bblock DEFV(Int,INIT(demi_dimension_X_effective ,Ierode__CoastLines_2D_____demi_dimension_X_du_domaine_de_calcul_de_la_longueur_locale ) ); DEFV(Int,INIT(demi_dimension_Y_effective ,Ierode__CoastLines_2D_____demi_dimension_Y_du_domaine_de_calcul_de_la_longueur_locale ) ); DEFV(Int,INIT(Xmin_domaine,UNDEF)); DEFV(Int,INIT(Xmax_domaine,UNDEF)); DEFV(Int,INIT(Ymin_domaine,UNDEF)); DEFV(Int,INIT(Ymax_domaine,UNDEF)); /* Definition du domaine local ou faire le calcul de la longueur au voisinage de {X,Y}. */ EGAL(longueur_effective_de_la_cote_initiale,FZERO); /* Afin d'etre sur de faire le 'Tant(...)' suivant au moins une fois... */ Tant(IZEQ(longueur_effective_de_la_cote_initiale)) Bblock EGAL(Xmin_domaine,SOUS(X,demi_dimension_X_effective)); EGAL(Xmax_domaine,ADD2(X,demi_dimension_X_effective)); EGAL(Ymin_domaine,SOUS(Y,demi_dimension_Y_effective)); EGAL(Ymax_domaine,ADD2(Y,demi_dimension_Y_effective)); /* Definition du domaine local ou faire le calcul de la longueur au voisinage de {X,Y}. */ EGAL(longueur_effective_de_la_cote_initiale ,DIVI(IFdomaine_comptage_des_points_dans_un_intervalle (imageA_convoluee_initiale ,Xmin_domaine,Xmax_domaine ,Ymin_domaine,Ymax_domaine ,SOUS(NIVEAU______MEDIAN_DANS_Ierode__CoastLines_2D ,Ierode__CoastLines_2D_____epaisseur_de_la_cote_initiale ) ,ADD2(NIVEAU______MEDIAN_DANS_Ierode__CoastLines_2D ,Ierode__CoastLines_2D_____epaisseur_de_la_cote_initiale ) ) ,RENORMALISATEUR_DE_LA_LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D ) ); Test(IZEQ(longueur_effective_de_la_cote_initiale)) Bblock EGAL(demi_dimension_X_effective ,MUL2(Ierode__CoastLines_2D_____agrandissement_du_domaine_de_calcul_de_la_longueur_locale ,demi_dimension_X_effective ) ); EGAL(demi_dimension_Y_effective ,MUL2(Ierode__CoastLines_2D_____agrandissement_du_domaine_de_calcul_de_la_longueur_locale ,demi_dimension_Y_effective ) ); /* Tant que l'on a pas trouve de points de la cote initiale (ce qui se traduit par une */ /* longueur nulle), on double la taille du domaine... */ Eblock ATes Bblock Eblock ETes Eblock ETan EGAL(longueur_effective_de_la_cote_courante ,DIVI(IFdomaine_comptage_des_points_dans_un_intervalle (imageA_convoluee_courante ,Xmin_domaine,Xmax_domaine ,Ymin_domaine,Ymax_domaine ,SOUS(NIVEAU______MEDIAN_DANS_Ierode__CoastLines_2D ,Ierode__CoastLines_2D_____epaisseur_de_la_cote_initiale ) ,ADD2(NIVEAU______MEDIAN_DANS_Ierode__CoastLines_2D ,Ierode__CoastLines_2D_____epaisseur_de_la_cote_initiale ) ) ,RENORMALISATEUR_DE_LA_LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D ) ); /* Longueurs de la cote (initiale et courante) calculees localement dans le voisinage */ /* du point courant {X,Y}. On notera que le domaine de calcul est celui qui correspond */ /* a la derniere etape de calcul de 'longueur_effective_de_la_cote_initiale'... */ Eblock ETes #Aifdef CONVOLUTION_DE_imageA_D_ERODE______COTES_2D_VERSION_02 #Eifdef CONVOLUTION_DE_imageA_D_ERODE______COTES_2D_VERSION_02 EGAL(force_de_la_mer_au_point_courant ,MUL2(Ierode__CoastLines_2D_____amplificateur_de_la_force ,DIVI(MUL2(COND(EST_VRAI(Ierode__CoastLines_2D_____la_force_depend_du_niveau_local_de_la_mer) ,ABSO(moyenne_des_etats_de_type___mer) ,ABSO(Ierode__CoastLines_2D_____niveau_de_la___mer) ) ,ABSO(Ierode__CoastLines_2D_____niveau_de_la_terre) ) ,ADD2(FU ,SCAL(FACTEUR_D_ANTI_CORROSITE_DE_LA_MER(X,Y) ,FLOT(longueur_effective_de_la_cote_initiale) ,FLOT(longueur_effective_de_la_cote_courante) ) ) ) ) ); /* Calcul de la force de la mer au point courant : celle-ci decroit au fur et a mesure */ /* que la longueur de la cote augmente. On notera que d'une part cette force est inferieure */ /* (ou egale apres initialisation) au niveau (maximal) de la terre en valeur absolue, et */ /* que d'autre part elle est independante en fait de {X,Y} a la date du 20011205093935. */ /* Ce dernier point signifie que le calcul de 'force_de_la_mer_au_point_courant' pourrait */ /* etre effectue en dehors de {begin_image,end_image}, mais qu'il n'est pas impossible que */ /* dans le futur, cette force depende reellement de {X,Y}. Cette dependance en {X,Y} */ /* a ete mise en place le 20011219110000... */ /* */ /* Cette force est donc de la forme : */ /* */ /* A */ /* force = ------------ */ /* L */ /* c */ /* 1 + F.---- */ /* L */ /* 0 */ /* */ /* ou 'F', 'Lc' et 'L0' designent respectivement l'anti-corrosite de la mer, la longueur */ /* courante de la cote et sa longueur initiale. */ Test(IFLE(resistance_du_point_courant_de_la_terre,force_de_la_mer_au_point_courant)) /* Le test 'IFLT(...)' a ete remplace par un 'IFLE(...)' le 20011210161803 depuis que */ /* 'resistance_du_point_courant_de_la_terre' peut etre mis a zero explicitement... */ Bblock EGAL(nouvel_etat__X__Y ,MEME_SIGNE_QUE(Ierode__CoastLines_2D_____niveau_de_la___mer ,COND(IL_FAUT(Ierode__CoastLines_2D_____marquer_les_points_erodes_avec_la_force) ,force_de_la_mer_au_point_courant ,Ierode__CoastLines_2D_____marqueur_des_points_erodes ) ) ); /* Le point courant {X,Y} est trop faible par rapport a la force de la mer, il disparait */ /* en devenant de la mer... */ INCR(Ierode__CoastLines_2D_____nombre_de_points_erodes_a_l_iteration_courante,I); /* Un point supplementaire de "terre" a ete erode par la "mer" au cours de l'iteration */ /* courante... */ Eblock ATes Bblock Eblock ETes Eblock ATes Bblock Eblock ETes Eblock ATes Bblock Eblock ETes storeF_point(nouvel_etat__X__Y ,imageR ,X,Y ); /* Nouvel etat du point courant {X,Y}... */ Eblock end_image EDEFV(imageF,imageA_convoluee_courante); /* Image Argument courante apres la convolution. */ RETIF(imageR); Eblock EFonctionF #undef FACTEUR_D_ANTI_CORROSITE_DE_LA_MER #undef TAUX_D_AFFAIBLISSEMENT_DE_LA_DURETE_DE_LA_TERRE #ifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_01 # undef FACTEUR_D_EPAISSEUR_DE_LA_COTE_DANS_Ierode__CoastLines_2D #Aifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_01 #Eifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_01 #ifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_02 # undef FACTEUR_D_EPAISSEUR_DE_LA_COTE_DANS_Ierode__CoastLines_2D #Aifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_02 #Eifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_02 #undef RESISTANCE_NULLE_D_UN_POINT_DE_LA_COTE_DANS_Ierode__CoastLines_2D #ifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_01 # undef NOMBRE_DE_POINTS_DU_NOYAU_DE_CONVOLUTION_D_ERODE______COTES_2D #Aifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_01 #Eifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_01 #ifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_02 # undef NOMBRE_DE_POINTS_DU_NOYAU_DE_CONVOLUTION_D_ERODE______COTES_2D #Aifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_02 #Eifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_02 #undef NIVEAU_HORS_IMAGE_DANS_Ierode__CoastLines_2D #undef NIVEAU______MEDIAN_DANS_Ierode__CoastLines_2D #undef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D #ifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_01 # undef RENORMALISATEUR_DE_LA_LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D # undef CONVOLUTION_DE_MESURE_DE_LA_LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D #Aifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_01 #Eifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_01 #ifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_02 # undef RENORMALISATEUR_DE_LA_LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D # undef CONVOLUTION_DE_MESURE_DE_LA_LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D #Aifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_02 #Eifdef LONGUEUR_DE_LA_COTE_D_ERODE______COTES_2D_VERSION_02 #undef ACCES_A_UN_POINT_D_ERODE______COTES_2D #undef UN_POINT_D_ERODE______COTES_2D_EST_SUR_LA___MER #undef UN_POINT_D_ERODE______COTES_2D_EST__INDETERMINE #undef UN_POINT_D_ERODE______COTES_2D_EST_SUR_LA_TERRE /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* M O D E L E B I D I M E N S I O N N E L D E C O T E S A V E C E R O S I O N */ /* A T A U X D ' A F F A I B L I S S E M E N T D E L A T E R R E E T A C O R R O S I T E */ /* G L O B A U X : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(Ierode__CoastLines_2D(imageR ,imageA ,imageA_convoluee_initiale ,taux_d_affaiblissement_de_la_durete_de_la_terre ,facteur_d_anti_corrosite_de_la_mer ,editer_la_longueur_de_la_cote_courante ) ) ) ) DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR=CoastLines(imageA). */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument a traiter par le modele Lignes de Cotes bidimensionnel. */ DEFV(Argument,DEFV(imageF,imageA_convoluee_initiale)); /* Image Argument initiale convoluee. En fait cela a ete introduit le 20011222183235 afin */ /* de faciliter son allocation memoire dans 'v $xcc/cpp$Z D_STATIK' car, en effet, */ /* 'Ierode__CoastLines_2D_____imageA_convoluee_initiale' apparait bien dans la liste des */ /* objets de type 'D_STATIK(...)', mais pour que son allocation soit faire a la suite de */ /* 'G_STATIK(...)' il faut qu'il soit utilise au moins une fois, ce qui est le cas depuis */ /* qu'il est argument de la fonction 'Ierode__CoastLines_2D(...)'. */ DEFV(Argument,DEFV(Float,taux_d_affaiblissement_de_la_durete_de_la_terre)); DEFV(Argument,DEFV(Float,facteur_d_anti_corrosite_de_la_mer)); /* Caracteristiques de la terre et de la mer respectivement. */ DEFV(Argument,DEFV(Logical,editer_la_longueur_de_la_cote_courante)); /* Afin de permettre l'edition de la longueur de la cote courante... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock BDEFV(imageF,taux_d_affaiblissement_de_la_durete_de_la_terre_local); /* Image flottante donnant le taux d'affaiblissement de la terre en chaque point {X,Y}. */ BDEFV(imageF,facteur_d_anti_corrosite_de_la_mer_local); /* Image flottante donnant le facteur d'anti-corrosite de la mer en chaque point {X,Y}. */ /*..............................................................................................................................*/ CALS(IFinitialisation(taux_d_affaiblissement_de_la_durete_de_la_terre_local,taux_d_affaiblissement_de_la_durete_de_la_terre)); /* Initialisation du taux d'affaiblissement de la terre de facon uniforme. */ CALS(IFinitialisation(facteur_d_anti_corrosite_de_la_mer_local,facteur_d_anti_corrosite_de_la_mer)); /* Initialisation du facteur d'anti-corrosite de la mer de facon uniforme. */ CALS(Ierode__CoastLines_2D_a_taux_facteur_locaux(imageR ,imageA ,imageA_convoluee_initiale ,taux_d_affaiblissement_de_la_durete_de_la_terre_local ,facteur_d_anti_corrosite_de_la_mer_local ,editer_la_longueur_de_la_cote_courante ) ); /* Et calcul avec le meme taux d'affaiblissement de la terre et le meme facteur */ /* d'anti-corrosite de la mer en chaque point {X,Y}. */ EDEFV(imageF,facteur_d_anti_corrosite_de_la_mer_local); /* Image flottante donnant le facteur d'anti-corrosite de la mer en chaque point {X,Y}. */ EDEFV(imageF,taux_d_affaiblissement_de_la_durete_de_la_terre_local); /* Image flottante donnant le taux d'affaiblissement de la terre en chaque point {X,Y}. */ RETIF(imageR); Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* C A L C U L D U N O M B R E D E P O I N T S " G E N E R A L I S E " */ /* D A N S L E V O I S I N A G E D E S P O I N T S D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ BFonctionF #define APPLIQUER_UNE_DYNAMIQUE_LOGARITHMIQUE \ VRAI #define NE_PAS_APPLIQUER_UNE_DYNAMIQUE_LOGARITHMIQUE \ NOTL(APPLIQUER_UNE_DYNAMIQUE_LOGARITHMIQUE) DEFV(Common,DEFV(Float,SINT(IFnombre_de_points_generalise_dans_un_voisinage_____evitement_des_zones_noires,NEGA(FU)))); /* Anti-translation pour 'IFdynamique_logarithmique_sans_translation_dynamique(...)' */ /* destinee a eviter des calculs du type 'log(0)' possibles dans les zones NOIRes... */ DEFV(Common,DEFV(Float,SINT(IFnombre_de_points_generalise_dans_un_voisinage_____ponderation_du_cumul_courant____________,FU))); DEFV(Common,DEFV(Float,SINT(IFnombre_de_points_generalise_dans_un_voisinage_____ponderation_de_la_dispersion_des_niveaux,FZERO))); /* A compter du 20151105104641 en plus du cumul courant, la dispersion des niveaux peut */ /* etre utilisee. Les valeurs par defaut garantissent la compatibilite anterieure... */ DEFV(Common,DEFV(FonctionF,POINTERF(IFnombre_de_points_generalise_dans_un_voisinage(imageR ,imageA ,niveaux_a_traiter,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ,normaliser_le_cumul_courant ,appliquer_une_dynamique_logarithmique ) ) ) ) DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] convoluee par le noyau. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_a_traiter,COULEURS))); /* Definit les niveaux sur lesquels on doit faire la convolution par 'Pconvolution()'. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_cumulables,COULEURS))); /* Definit les niveaux cumulables lors du calcul de 'Pconvolution_____cumul_courant'. */ DEFV(Argument,DEFV(Int,nombre_de_points_du_noyau)); /* Nombre de points contenus dans le noyau, y compris son centre. */ DEFV(Argument,DEFV(Float,DTb0(noyau))); /* Noyau de convolution : il est defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ DEFV(Argument,DEFV(Logical,DTb0(inhibition_du_noyau))); /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ DEFV(Argument,DEFV(Logical,normaliser_le_cumul_courant)); /* Indique si 'Pconvolution_____cumul_courant' doit etre normalise ('VRAI') ou bien laisse */ /* tel quel ('FAUX'). */ DEFV(Argument,DEFV(Logical,appliquer_une_dynamique_logarithmique)); /* Indique si 'imageR' doit etre transforme par une dynamique logarithmique ('VRAI') ou */ /* laissee tel quel... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ SPIRALE_VALIDATION; VALIDATION_DE_____nombre_de_points_du_noyau; /* Mis sous cette forme le 20211020181331... */ begin_image_AvecEditionProgression /* ATTENTION, il est imperatif que 'begin_image' utilise la fonction 'DoIn(...)', ce qui */ /* signifie que les coordonnees sont traitees de facon croissante (de 'Xmin' a 'Xmax' et */ /* de 'Ymin' a 'Ymax'), car en effet, la fonction 'Pconvolution(...)' utilise cela pour */ /* desinitialiser si necessaire les spirales circulaires... */ /* */ /* Le 20170520104209 a ete introduit "_AvecEditionProgression"... */ Bblock DEFV(genere_p,INIT(niveau_courant,load_point(imageA,X,Y))); /* Niveau courant au point courant... */ Test(EST_VRAI(ITb1(niveaux_a_traiter,INDX(niveau_courant,NOIR)))) Bblock /* Traitement des points a traiter... */ CALS(Pconvolution(imageA,imageA ,X,Y ,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ); /* Convolution au point {X,Y}. Ce calcul permet d'evaluer 'Pconvolution_____cumul_courant' */ /* qui definit le nombre de points "generalise" 'N' a l'interieur de la boule definie */ /* par le noyau de convolution... */ Test(IZGE(Pconvolution_____cumul_courant)) Bblock storeF_point(LIZ2(IFnombre_de_points_generalise_dans_un_voisinage_____ponderation_du_cumul_courant____________ ,COND(IL_FAUT(normaliser_le_cumul_courant) ,______NORMALISE_NIVEAU(Pconvolution_____cumul_courant) ,Pconvolution_____cumul_courant ) ,IFnombre_de_points_generalise_dans_un_voisinage_____ponderation_de_la_dispersion_des_niveaux ,Pconvolution_____dispersion_des_niveaux_sur_la_spirale ) ,imageR ,X,Y ); /* Memorisation du nombre de points "generalise" a l'interieur de la boule definie par le */ /* noyau de convolution, et donne par 'Pconvolution_____cumul_courant'... On notera que l'on */ /* ne peut ecrire : */ /* */ /* CALS(IFconvolution(imageR */ /* ,facteur_multiplicatif */ /* ,imageA */ /* ,niveaux_a_traiter,niveaux_cumulables */ /* ,nombre_de_points_du_noyau */ /* ,noyau,inhibition_du_noyau */ /* ) */ /* ); */ /* */ /* car en effet 'IFconvolution(...)' utilise la valeur renvoyee par 'Pconvolution(...)' */ /* qui ne correspond pas directement a 'Pconvolution_____cumul_courant' puisqu'il a en plus */ /* une division par la somme des ponderations... */ Eblock ATes Bblock PRINT_ERREUR("le resultat de la convolution est negatif"); Eblock ETes Eblock ATes Bblock storeF_point(FLOT(NIVR(niveau_courant)) ,imageR ,X,Y ); /* Et on ne convolue pas lorsque le niveau courant n'est pas "traitable"... */ Eblock ETes Eblock end_image_AvecEditionProgression /* Le 20170520104209 a ete introduit "_AvecEditionProgression"... */ Test(IL_FAUT(appliquer_une_dynamique_logarithmique)) Bblock CALS(IFdynamique_logarithmique_sans_translation_dynamique (imageR,imageR,IFnombre_de_points_generalise_dans_un_voisinage_____evitement_des_zones_noires) ); /* Calcul du logarithme avec une anti-translation fixe 'evitement_des_zones_noires' destinee */ /* au cas ou plusieurs appels a 'IFnombre_de_points_generalise_dans_un_voisinage(...)' */ /* seraient effectues a la suite (voir 'IFdimension_fractale_convolution(...)' ou il est */ /* imperatif d'avoir la meme translation pour chacun d'eux...). On notera qu'une deuxieme */ /* translation egale a 'EXPB(FZERO)' est appliquee ; elle est destinee a eviter les nombres */ /* inferieurs a 1 et donc les logarithmes negatifs. Finalement, la translation totale est */ /* egale a : */ /* */ /* (-evitement_des_zones_noires) + EXPB(FZERO) */ /* */ /* soit 2... */ Eblock ATes Bblock Eblock ETes RETIF(imageR); Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* C A L C U L D E L A D I M E N S I O N F R A C T A L E */ /* D ' U N E I M A G E P A R C O N V O L U T I O N G E N E R A L I S E E */ /* E T P E R M E T T A N T S I M U L T A N E M E N T L ' E X T R A C T I O N D E C O N T O U R S : */ /* */ /*************************************************************************************************************************************/ BFonctionI DEFV(Common,DEFV(FonctionI,IFdimension_fractale_convolution(coefficient_de_d2_ou_pente_p3 ,coefficient_de_d1_ou_pente_p2 ,coefficient_de_d0_ou_pente_p1 ,imageA ,niveaux_a_traiter,niveaux_cumulables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ,methode_lineaire ,normaliser_le_nombre_de_points_generalise ,en_vue_d_extraire_des_contours ) ) ) DEFV(Argument,DEFV(imageF,coefficient_de_d2_ou_pente_p3)); DEFV(Argument,DEFV(imageF,coefficient_de_d1_ou_pente_p2)); DEFV(Argument,DEFV(imageF,coefficient_de_d0_ou_pente_p1)); /* Images flottantes contenant les pentes des trois droites calculees pour chaque point ou */ /* les trois coefficient 'c2', 'c1' et 'c0', ceci etant fonction de 'methode_lineaire'... */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_a_traiter,COULEURS))); /* Definit les niveaux sur lesquels on doit faire la convolution par 'Pconvolution()'. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_cumulables,COULEURS))); /* Definit les niveaux cumulables lors du calcul de 'Pconvolution_____cumul_courant'. */ DEFV(Argument,DEFV(Int,nombre_de_points_du_noyau)); /* Nombre de points contenus dans le noyau, y compris son centre. */ DEFV(Argument,DEFV(Float,DTb0(noyau))); /* Noyau de convolution : il est defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ DEFV(Argument,DEFV(Logical,DTb0(inhibition_du_noyau))); /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ DEFV(Argument,DEFV(Logical,methode_lineaire)); /* Cet indicateur precise si l'on doit utiliser la methode lineaire ('VRAI') qui consiste */ /* a regarder les pentes des droites formees par les couples de points, ou a ajuster une */ /* courbe parabolique passant par les trois points calcules... */ DEFV(Argument,DEFV(Logical,normaliser_le_nombre_de_points_generalise)); /* Indique si 'Pconvolution_____cumul_courant' doit etre normalise ('VRAI') ou bien laisse */ /* quel ('FAUX') lors des appels a 'IFnombre_de_points_generalise_dans_un_voisinage(...)'. */ DEFV(Argument,DEFV(Logical,en_vue_d_extraire_des_contours)); /* Option destinee a assurer (lorsque sa valeur est 'VRAI') la compatibilite avec le */ /* fonctionnement anterieur au 20020226095028 ('v $xiio/LENA_CONT.11'). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock INIT_ERROR; /* ATTENTION : 'INIT_ERROR' est mis en tete des variables locales au cas ou des couples */ /* ('BDEFV','EDEFV') suivraient... */ DEFV(Int,INIT(nombre_de_points_du_noyau_1,INTE(GRO1(FRA3(FLOT(nombre_de_points_du_noyau)))))); DEFV(Int,INIT(nombre_de_points_du_noyau_2,INTE(GRO2(FRA3(FLOT(nombre_de_points_du_noyau)))))); DEFV(Int,INIT(nombre_de_points_du_noyau_3,INTE(GRO3(FRA3(FLOT(nombre_de_points_du_noyau)))))); /* Nombre de points contenus dans les trois noyaux utilises. On notera le 'FLOT(...)' */ /* introduit le 20020225151050 qui est destine a garantir que : */ /* */ /* GRO3(FRA3(nombre_de_points_du_noyau)) = nombre_de_points_du_noyau */ /* */ /* meme si 'nombre_de_points_du_noyau' n'est pas un multiple de 3 (c'est par exemple le */ /* cas de 25 avec lequel un defaut a ete mis en evidence avant cette modification...). */ BDEFV(imageF,population_1); BDEFV(imageF,population_2); BDEFV(imageF,population_3); /* Valeur des logarithmes des nombres de points generalises du voisinage de chaque point. */ DEFV(Float,INIT(logarithme_du_rayon_du_noyau_1,FLOT__UNDEF)); DEFV(Float,INIT(logarithme_du_rayon_du_noyau_2,FLOT__UNDEF)); DEFV(Float,INIT(logarithme_du_rayon_du_noyau_3,FLOT__UNDEF)); /* Rayon "generalise" des trois noyaux utilises. */ DEFV(Float,INIT(determinant,FLOT__UNDEF)); /* Determinant du systeme lineaire de trois equations a trois inconnues que l'on va */ /* resoudre pour calculer la dimension fractale de l'image... */ DEFV(Float,INIT(determinant_2,FLOT__UNDEF)); DEFV(Float,INIT(determinant_1,FLOT__UNDEF)); DEFV(Float,INIT(determinant_0,FLOT__UNDEF)); /* Determinants "partiels"... */ /*..............................................................................................................................*/ SPIRALE_VALIDATION; VALIDATION_DE_____nombre_de_points_du_noyau; /* Mis sous cette forme le 20211020181331... */ CALS(IFnombre_de_points_generalise_dans_un_voisinage(population_1 ,imageA ,niveaux_a_traiter,niveaux_cumulables ,nombre_de_points_du_noyau_1 ,noyau,inhibition_du_noyau ,normaliser_le_nombre_de_points_generalise ,APPLIQUER_UNE_DYNAMIQUE_LOGARITHMIQUE ) ); CALS(IFnombre_de_points_generalise_dans_un_voisinage(population_2 ,imageA ,niveaux_a_traiter,niveaux_cumulables ,nombre_de_points_du_noyau_2 ,noyau,inhibition_du_noyau ,normaliser_le_nombre_de_points_generalise ,APPLIQUER_UNE_DYNAMIQUE_LOGARITHMIQUE ) ); CALS(IFnombre_de_points_generalise_dans_un_voisinage(population_3 ,imageA ,niveaux_a_traiter,niveaux_cumulables ,nombre_de_points_du_noyau_3 ,noyau,inhibition_du_noyau ,normaliser_le_nombre_de_points_generalise ,APPLIQUER_UNE_DYNAMIQUE_LOGARITHMIQUE ) ); /* Calcul des logarithmes des nombres de points generalises (voir les commentaires de */ /* 'IFnombre_de_points_generalise_dans_un_voisinage(...)') : */ /* */ /* Log(N) */ /* */ /* pour trois tailles differentes du noyau... */ EGAL(logarithme_du_rayon_du_noyau_1,LOGX(RAC2(nombre_de_points_du_noyau_1))); EGAL(logarithme_du_rayon_du_noyau_2,LOGX(RAC2(nombre_de_points_du_noyau_2))); EGAL(logarithme_du_rayon_du_noyau_3,LOGX(RAC2(nombre_de_points_du_noyau_3))); /* Le rayon "generalise" 'R' de la boule definie par le noyau de convolution est defini */ /* logiquement par : */ /* __ */ /* / */ /* R = \/ L */ /* */ /* ou 'L' designe une fraction de 'nombre_de_points_du_noyau'. On notera que pour des */ /* raisons de comprehension, on n'exploite pas ci-dessus le fait que : */ /* */ /* LOGX(RACX(x)) = MOIT(LOGX(x)) */ /* */ /* */ /* Le 20070227132913, la fonction 'RACX(...)' fut remplacee par 'RAC2(...)' plus logique */ /* (meme si le resultat est le meme...). */ Test(IL_FAUT(methode_lineaire)) Bblock /* Methode lineaire : */ /* */ /* on sait que si l'hypothese fractale est verifiee, alors les trois points : */ /* */ /* [Log(R1),Log(N1)] */ /* [Log(R2),Log(N2)] */ /* [Log(R3),Log(N3)] */ /* */ /* sont alignes, et la pente de la droite est la dimension fractale de la texture : */ /* */ /* d */ /* N = k.R */ /* */ /* soit : */ /* */ /* Log(N) = d.Log(R) + Log(k) */ /* */ /* ou 'k' est une constante. Les contours de l'image (qui sont des objets lineaires) ont */ /* comme dimension fractale 1 (s'ils ne sont pas trop tourmentes...). */ begin_image Bblock DEFV(genere_Float,INIT(population_1_au_point_courant,loadF_point(population_1,X,Y))); DEFV(genere_Float,INIT(population_2_au_point_courant,loadF_point(population_2,X,Y))); DEFV(genere_Float,INIT(population_3_au_point_courant,loadF_point(population_3,X,Y))); /* Definition des trois poupulations au point courant {X,Y}. */ Test(EST_VRAI(en_vue_d_extraire_des_contours)) Bblock storeF_point(DIVZ(SOUS(population_1_au_point_courant,population_2_au_point_courant) ,SOUS(logarithme_du_rayon_du_noyau_1,logarithme_du_rayon_du_noyau_2) ) ,coefficient_de_d2_ou_pente_p3 ,X,Y ); storeF_point(DIVZ(SOUS(population_2_au_point_courant,population_3_au_point_courant) ,SOUS(logarithme_du_rayon_du_noyau_2,logarithme_du_rayon_du_noyau_3) ) ,coefficient_de_d1_ou_pente_p2 ,X,Y ); storeF_point(DIVZ(SOUS(population_3_au_point_courant,population_1_au_point_courant) ,SOUS(logarithme_du_rayon_du_noyau_3,logarithme_du_rayon_du_noyau_1) ) ,coefficient_de_d0_ou_pente_p1 ,X,Y ); /* Calcul des pentes des trois droites joignant les trois points calcules. D'apres ce qui */ /* a ete dit ci-dessus, ces trois pentes, si la texture est fractale, doivent etre egales */ /* entre elles et egales a la dimension fractale : */ /* */ /* Log(N) = d.Log(R) + Log(k) */ /* */ /* soit, par exemple, avec les points '1' et '2' : */ /* */ /* Log(N2) - Log(N1) */ /* d = ------------------- */ /* Log(R2) - Log(R1) */ /* */ /* les trois pentes {p1,p2,p3} devant donc etre egales (a epsilon pres...). */ /* */ /* ATTENTION, jusqu'au 20020220110846 c'etait 'ABSO(DIVZ(...))' qui etait utilise et qui */ /* a donc ete remplace a partir de cette date par 'DIVZ(...)'. En fait, cela simplifie les */ /* choses sans changer la semantique car, en effet, les denominateurs et les numerateurs */ /* sont de meme signe (puisqu'en augmentant le rayon du noyau, il est evident que l'on */ /* augmente la population -ou qu'a la limite, elle reste la meme ; mais en tout cas, elle */ /* ne peut pas diminuer...-). */ Eblock ATes Bblock DEFV(Float,INIT(pente_p1,DIVZ(population_1_au_point_courant,logarithme_du_rayon_du_noyau_1))); DEFV(Float,INIT(pente_p2,DIVZ(population_2_au_point_courant,logarithme_du_rayon_du_noyau_2))); DEFV(Float,INIT(pente_p3,DIVZ(population_3_au_point_courant,logarithme_du_rayon_du_noyau_3))); /* Definition des trois pentes au point courant {X,Y}. */ storeF_point(NEUT(pente_p3) ,coefficient_de_d2_ou_pente_p3 ,X,Y ); storeF_point(SOUS(pente_p2,pente_p3) ,coefficient_de_d1_ou_pente_p2 ,X,Y ); storeF_point(SOUS(pente_p1,pente_p3) ,coefficient_de_d0_ou_pente_p1 ,X,Y ); /* Calcul des pentes des trois droites joignant les trois points calcules. D'apres ce qui */ /* a ete dit ci-dessus, ces trois pentes, si la texture est fractale, doivent etre egales */ /* entre elles et egales a la dimension fractale : */ /* */ /* Log(N) = d.Log(R) + Log(k) */ /* */ /* soit, par exemple, avec le point '3' : */ /* */ /* Log(N3) */ /* d = --------- = p3 */ /* Log(R3) */ /* */ /* sachant qu'on renvoie donc {p3,p2-p3,p1-p3} et que les deux differences doivent etre */ /* nulles (a epsilon pres...). */ Eblock ETes Eblock end_image Eblock ATes Bblock /* Methode non lineaire : */ /* */ /* on se trouve donc en presence de trois logarithmes 'Log(N1)', 'Log(N2)' et 'Log(N3)'. */ /* On va ajuster une parabole passant par les trois points calcules pour les trois rayons */ /* 'R1, ' R2' et 'R3' : */ /* */ /* 2 1 0 */ /* Log(N) = c2.[Log(R)] + c1.[Log(R)] + c0.[Log(R)] */ /* */ /* On doit donc resoudre le systeme : */ /* */ /* 2 1 0 */ /* c2.[Log(R1)] + c1.[Log(R1)] + c0.[Log(R1)] = Log(N1) */ /* */ /* 2 1 0 */ /* c2.[Log(R2)] + c1.[Log(R2)] + c0.[Log(R2)] = Log(N2) */ /* */ /* 2 1 0 */ /* c2.[Log(R3)] + c1.[Log(R3)] + c0.[Log(R3)] = Log(N3) */ /* */ /* Si les trois points sont alignes, le coefficient 'c2' doit etre nul (a epsilon pres...). */ EGAL(determinant ,DET3(EXP2(logarithme_du_rayon_du_noyau_1),EXP1(logarithme_du_rayon_du_noyau_1),EXP0(logarithme_du_rayon_du_noyau_1) ,EXP2(logarithme_du_rayon_du_noyau_2),EXP1(logarithme_du_rayon_du_noyau_2),EXP0(logarithme_du_rayon_du_noyau_2) ,EXP2(logarithme_du_rayon_du_noyau_3),EXP1(logarithme_du_rayon_du_noyau_3),EXP0(logarithme_du_rayon_du_noyau_3) ) ); /* Calcul du determinant : */ /* */ /* | | */ /* | 2 1 0 | */ /* | [Log(R1)] [Log(R1)] [Log(R1)] | */ /* | | */ /* | 2 1 0 | */ /* | [Log(R2)] [Log(R2)] [Log(R2)] | */ /* | | */ /* | 2 1 0 | */ /* | [Log(R3)] [Log(R3)] [Log(R3)] | */ /* | | */ /* */ Test(IZNE(determinant)) Bblock /* Cas ou le determinant est non nul ; le systeme peut donc etre resolu : */ begin_image Bblock DEFV(genere_Float,INIT(population_1_au_point_courant,loadF_point(population_1,X,Y))); DEFV(genere_Float,INIT(population_2_au_point_courant,loadF_point(population_2,X,Y))); DEFV(genere_Float,INIT(population_3_au_point_courant,loadF_point(population_3,X,Y))); /* Definition des trois poupulations au point courant {X,Y}. */ EGAL(determinant_2 ,DET3(population_1_au_point_courant,EXP1(logarithme_du_rayon_du_noyau_1),EXP0(logarithme_du_rayon_du_noyau_1) ,population_2_au_point_courant,EXP1(logarithme_du_rayon_du_noyau_2),EXP0(logarithme_du_rayon_du_noyau_2) ,population_3_au_point_courant,EXP1(logarithme_du_rayon_du_noyau_3),EXP0(logarithme_du_rayon_du_noyau_3) ) ); /* Calcul du determinant (2) : */ /* */ /* | | */ /* | 1 0 | */ /* | [Log(N1)] [Log(R1)] [Log(R1)] | */ /* | | */ /* | 1 0 | */ /* | [Log(N2)] [Log(R2)] [Log(R2)] | */ /* | | */ /* | 1 0 | */ /* | [Log(N3)] [Log(R3)] [Log(R3)] | */ /* | | */ /* */ EGAL(determinant_1 ,DET3(EXP2(logarithme_du_rayon_du_noyau_1),population_1_au_point_courant,EXP0(logarithme_du_rayon_du_noyau_1) ,EXP2(logarithme_du_rayon_du_noyau_2),population_2_au_point_courant,EXP0(logarithme_du_rayon_du_noyau_2) ,EXP2(logarithme_du_rayon_du_noyau_3),population_3_au_point_courant,EXP0(logarithme_du_rayon_du_noyau_3) ) ); /* Calcul du determinant (1) : */ /* */ /* | | */ /* | 2 0 | */ /* | [Log(R1)] [Log(N1)] [Log(R1)] | */ /* | | */ /* | 2 0 | */ /* | [Log(R2)] [Log(N2)] [Log(R2)] | */ /* | | */ /* | 2 0 | */ /* | [Log(R3)] [Log(N3)] [Log(R3)] | */ /* | | */ /* */ EGAL(determinant_0 ,DET3(EXP2(logarithme_du_rayon_du_noyau_1),EXP1(logarithme_du_rayon_du_noyau_1),population_1_au_point_courant ,EXP2(logarithme_du_rayon_du_noyau_2),EXP1(logarithme_du_rayon_du_noyau_2),population_2_au_point_courant ,EXP2(logarithme_du_rayon_du_noyau_3),EXP1(logarithme_du_rayon_du_noyau_3),population_3_au_point_courant ) ); /* Calcul du determinant (0) : */ /* */ /* | | */ /* | 2 1 | */ /* | [Log(R1)] [Log(R1)] [Log(N1)] | */ /* | | */ /* | 2 1 | */ /* | [Log(R2)] [Log(R2)] [Log(N2)] | */ /* | | */ /* | 2 1 | */ /* | [Log(R3)] [Log(R3)] [Log(N3)] | */ /* | | */ /* */ storeF_point(DIVI(determinant_2,determinant),coefficient_de_d2_ou_pente_p3,X,Y); storeF_point(DIVI(determinant_1,determinant),coefficient_de_d1_ou_pente_p2,X,Y); storeF_point(DIVI(determinant_0,determinant),coefficient_de_d0_ou_pente_p1,X,Y); /* Calcul des trois parametres de la courbe d'ajustement parabolique. */ Eblock end_image Eblock ATes Bblock /* Cas ou le determinant est nul ; le systeme ne peut donc pas etre resolu : */ CALS(IFinitialisation(coefficient_de_d2_ou_pente_p3,FZERO)); CALS(IFinitialisation(coefficient_de_d1_ou_pente_p2,FZERO)); CALS(IFinitialisation(coefficient_de_d0_ou_pente_p1,FZERO)); /* Lorsque le systeme ne peut etre resolu, trois valeurs nulles sont renvoyees... */ PRINT_ATTENTION("la dimension fractale n'a pu etre approximee, des valeurs nulles sont renvoyees"); Eblock ETes Eblock ETes EDEFV(imageF,population_3); EDEFV(imageF,population_2); EDEFV(imageF,population_1); /* Valeur des logarithmes des nombres de points generalises du voisinage de chaque point. */ RETU_ERROR; Eblock EFonctionI #undef APPLIQUER_UNE_DYNAMIQUE_LOGARITHMIQUE #undef NE_PAS_APPLIQUER_UNE_DYNAMIQUE_LOGARITHMIQUE /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* R E C H E R C H E D E S E X T R E M A L O C A U X : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,Pextrema_locaux(imageA ,X,Y ,rechercher_le_maximum ,niveaux_testables ,nombre_de_points_du_voisinage ,inhibition_des_voisins ) ) ) /* Le resultat est egal au minimum ou au maximum local de imageA[X][Y]. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Int,X)); DEFV(Argument,DEFV(Int,Y)); /* Coordonnees entieres 'X' et 'Y' du point dont le voisinage est a tester. */ DEFV(Argument,DEFV(Logical,rechercher_le_maximum)); /* Indique s'il faut calculer le maximum ('VRAI') ou le minimum ('FAUX') autour de chaque */ /* point de l'image Argument. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_testables,COULEURS))); /* Definit les niveaux qui sont testables lors du calcul de 'extremum_courant'. */ DEFV(Argument,DEFV(Int,nombre_de_points_du_voisinage)); /* Nombre de voisins, y compris le point central (celui dont on teste le voisinage). */ DEFV(Argument,DEFV(Logical,DTb0(inhibition_des_voisins))); /* Precise pour chaque voisin s'il est 'ACTIF' (a utiliser dans la recherche) ou 'INACTIF' */ /* (a ignorer et a ne pas tester...). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Int,INIT(X_courant,X)); /* Abscisse courante initialisee sur le point argument, */ DEFV(Int,INIT(Y_courant,Y)); /* Ordonnee courante initialisee sur le point argument. */ DEFV(genere_p,INIT(extremum_courant ,COND(IL_FAUT(rechercher_le_maximum) ,MIN2(NOIR,BLANC) ,MAX2(NOIR,BLANC) ) ) ); /* Extremum courant lors du parcours de la spirale et initialise correctement au cas ou */ /* aucun point ne serait teste... */ SPIRALE_DEFINITION /* Donnees de generation d'une spirale de parcours d'une image. */ DEFV(Int,INIT(numero_courant_de_point,UNDEF)); /* Numero du point courant sur une spirale lors de son parcours. */ DEFV(Int,INIT(nombre_reel_de_points,ZERO)); /* Nombre reel (a cause des sorties d'ecran) de points traites sur la spirale. On notera que */ /* 'nombre_reel_de_points' n'est pas utilise actuellement... */ /*..............................................................................................................................*/ SPIRALE_VALIDATION; /* Validation des pas de parcours (pasX,pasY) des images. */ Test(IFEXff(nombre_de_points_du_voisinage,UN,TAILLE_MAXIMALE_D_UN_NOYAU_DE_CONVOLUTION)) Bblock PRINT_ERREUR("le nombre de points a tester est bizarre"); Eblock ATes Bblock Eblock ETes DoIn(numero_courant_de_point,PREMIER_POINT,LSTX(PREMIER_POINT,nombre_de_points_du_voisinage),I) Bblock SPIRALE_INITIALISATION; /* Initialisation dynamique de 'spirale_nombre_de_points_a_traiter'. */ Test(IFET(TEST_DANS_L_IMAGE(X_courant,Y_courant) ,EST_ACTIF(ITb0(inhibition_des_voisins,INDX(numero_courant_de_point,PREMIER_POINT))) ) ) Bblock DEFV(genere_p,INIT(niveau_courant,load_point(imageA,X_courant,Y_courant))); /* Niveau courant sur la spirale... */ Test(EST_VRAI(ITb1(niveaux_testables,INDX(niveau_courant,NOIR)))) Bblock /* Traitement des points qui sont testables... */ INCR(nombre_reel_de_points,I); /* On compte les points traites. */ EGAL(extremum_courant ,COND(IL_FAUT(rechercher_le_maximum) ,MAX2(extremum_courant,niveau_courant) ,MIN2(extremum_courant,niveau_courant) ) ); /* Et on recherche l'extremum provisoire. */ Eblock ATes Bblock Eblock ETes Eblock ATes Bblock Eblock ETes SPIRALE_DEPLACEMENT(X_courant,Y_courant); /* Deplacement du point courant de la spirale... */ /* ATTENTION : on n'utilise pas 'SPIRALE_DEPLACEMENT_ET_PARCOURS(...)' afin de garantir la */ /* recherche des veritables extremaux... */ SPIRALE_PARCOURS; /* Parcours de la spirale avec rotation eventuelle de PI/2 du bras courant... */ Eblock EDoI RETU(extremum_courant); Eblock EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* R E C H E R C H E D E S E X T R E M A L O C A U X D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(Logical,SINT(Iextrema_locaux_____compatibilite_20060606,FAUX))); /* Permet de generer des images suivant la methode anterieure au 20060606110600... */ DEFV(Common,DEFV(FonctionP,POINTERp(Iextrema_locaux(imageR ,imageA ,rechercher_le_maximum ,niveaux_a_traiter,niveaux_testables ,nombre_de_points_du_voisinage,inhibition_des_voisins ) ) ) ) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=extrema(imageA[X][Y]) au voisinage de chaque */ /* point. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Logical,rechercher_le_maximum)); /* Indique s'il faut calculer le maximum ('VRAI') ou le minimum ('FAUX') autour du point */ /* argument. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_a_traiter,COULEURS))); /* Definit les niveaux sur lesquels on doit faire la convolution par 'Pextrema_locaux()'. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_testables,COULEURS))); /* Definit les niveaux qui sont testables lors du calcul de 'extremum_courant'. */ DEFV(Argument,DEFV(Int,nombre_de_points_du_voisinage)); /* Nombre de voisins, y compris le point central (celui dont on teste le voisinage). */ DEFV(Argument,DEFV(Logical,DTb0(inhibition_des_voisins))); /* Precise pour chaque voisin s'il est 'ACTIF' (a utiliser dans la recherche) ou 'INACTIF' */ /* (a ignorer et a ne pas tester...). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Float,DTb1(noyau_de_voisinage,TAILLE_MAXIMALE_D_UN_NOYAU_DE_CONVOLUTION)); /* Noyau de convolution : il est defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ /*..............................................................................................................................*/ SPIRALE_VALIDATION; Test(IFEXff(NOMBRE_DE_POINTS_EFFECTIF_D_UN_NOYAU_DE_CONVOLUTION_PARCOURU_CIRCULAIREMENT(nombre_de_points_du_voisinage) ,UN ,TAILLE_MAXIMALE_D_UN_NOYAU_DE_CONVOLUTION ) ) Bblock PRINT_ERREUR("le nombre de points du noyau de voisinage est bizarre"); Eblock ATes Bblock Eblock ETes Test(IL_NE_FAUT_PAS(Iextrema_locaux_____compatibilite_20060606)) Bblock IDoIn(index ,PREMIER_POINT ,LSTX(PREMIER_POINT ,MIN2(NOMBRE_DE_POINTS_EFFECTIF_D_UN_NOYAU_DE_CONVOLUTION_PARCOURU_CIRCULAIREMENT(nombre_de_points_du_voisinage) ,TAILLE_MAXIMALE_D_UN_NOYAU_DE_CONVOLUTION ) ) ,I ) Bblock EGAL(ITb1(noyau_de_voisinage,INDX(index,PREMIER_POINT)),FONCTION_DE_CONVOLUTION(FU)); /* Initialisation du noyau de convolution (1,1,1,...) sur le maximum possible, sachant que */ /* 'inhibition_du_noyau' fera ensuite la difference entre les elements actifs et les autres. */ Eblock EIDoI Eblock ATes Bblock Eblock ETes begin_image_AvecEditionProgression /* Le 20170520104209 a ete introduit "_AvecEditionProgression"... */ Bblock DEFV(genere_p,INIT(niveau_courant,load_point(imageA,X,Y))); /* Niveau courant au point courant... */ Test(EST_VRAI(ITb1(niveaux_a_traiter,INDX(niveau_courant,NOIR)))) Bblock /* Traitement des points a traiter... */ DEFV(genere_p,INIT(extremum_local,NIVEAU_UNDEF)); /* Extremum local dans le voisinage du point courant... */ Test(IL_NE_FAUT_PAS(Iextrema_locaux_____compatibilite_20060606)) Bblock CALS(Pconvolution(imageA,imageA ,X,Y ,niveaux_testables ,nombre_de_points_du_voisinage ,noyau_de_voisinage,inhibition_des_voisins ) ); /* Convolution au point {X,Y}. Ce calcul permet d'evaluer les extrema locaux... */ EGAL(extremum_local ,COND(IL_FAUT(rechercher_le_maximum) ,Pconvolution_____maximum_sur_la_spirale ,Pconvolution_____minimum_sur_la_spirale ) ); Eblock ATes Bblock EGAL(extremum_local ,Pextrema_locaux(imageA ,X,Y ,rechercher_le_maximum ,niveaux_testables ,nombre_de_points_du_voisinage ,inhibition_des_voisins ) ); Eblock ETes store_point(extremum_local ,imageR ,X,Y ,FVARIABLE ); /* Et on recherche l'un des deux extrema point par point... */ Eblock ATes Bblock store_point(niveau_courant ,imageR ,X,Y ,FVARIABLE ); /* Et on ne convolue pas lorsque le niveau courant n'est pas "traitable"... */ Eblock ETes Eblock end_image_AvecEditionProgression /* Le 20170520104209 a ete introduit "_AvecEditionProgression"... */ RETI(imageR); Eblock EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* J E U D E L A V I E G E N E R A L I S E : */ /* */ /* */ /* Definition : */ /* */ /* Dans le jeu de la vie "classique", en notant */ /* 'PC' le point courant, on a les regles suivantes : */ /* */ /* 1 - si PC est NOIR, et s'il a exactement 3 voisins (N=3), alors : PC <-- BLANC, */ /* 2 - si PC est BLANC, et s'il a plus de 4 voisins (N>4) ou moins de 3 voisins (N<=2), alors : PC <-- NOIR. */ /* */ /* On generalise ces regles : on calcule par */ /* 'Iconvolution' le niveau "moyen" (suivant un 'NOYAU') */ /* du point courant ; ce niveau "moyen" dans [NOIR,BLANC] remplace */ /* le nombre de voisins sur 8 (n/8 dans [0,1]) dans la formulation */ /* classique. Ensuite, ce niveau "moyen" qui traduit */ /* donc l'environnement du point courant 'PC', en "integrant" */ /* aussi bien le nombre 'N' de voisins, que leur niveau, passe */ /* par une liste de substitution avant d'etre marque. Cette */ /* liste de substitution est en fait une gaussienne presentant */ /* un pic pour le niveau 3xBLANC/8 (8 et 3 etant deux valeurs */ /* particulieres du nombre de voisins. */ /* */ /* On notera le 20190804095120 que ce rapport 3/8 est la valeur */ /* par defaut de 'Ijeu_de_la_vie_generalise_____rapport_critique'... */ /* */ /* */ /*************************************************************************************************************************************/ #define MAXIMUM_DE_LA_VIE \ NIVA(MUL2(FLOT(NIVR(BLANC)) \ ,NomDeLaFonctionCourante QD@@__ _____rapport_critique \ ) \ ) \ /* Definit l'emplacement du pic dans l'echelle [NOIR,BLANC]. */ #define RAPPORT_CRITIQUE(increment) \ DIVI(FLOT(ADD2(TROIS,increment)) \ ,FLOT(ADD2(HUIT,increment)) \ ) \ /* Definit le rapport critique qui pour le cas 'Ijeu_de_la_vie_generalise_variable(...)' */ \ /* doit prendre en compte que le point central du noyau est utilise contrairement au cas */ \ /* 'Ijeu_de_la_vie_generalise(...)'. */ #define FACTEUR_MULTIPLICATIF_DE_CONVOLUTION \ FU \ /* Facteur multiplicatif du produit de convolution en chaque point {X,Y}. */ #define DEBUT_DU_NOYAU \ PREMIER_POINT \ /* Premier element du noyau. */ #define FIN_DU_NOYAU \ LSTX(DEBUT_DU_NOYAU,volume_du_noyau_de_convolution) \ /* Dernier element du noyau. */ #define NOYAU_DE_CONVOLUTION(numero,valeur) \ Bblock \ EGAL(IdTb1(noyau_de_convolution,INDX(numero,DEBUT_DU_NOYAU),volume_du_noyau_de_convolution) \ ,valeur \ ); \ EGAL(IdTb1(inhibition_du_noyau_de_convolution,INDX(numero,DEBUT_DU_NOYAU),volume_du_noyau_de_convolution) \ ,ACTIF \ ); \ Eblock \ /* Definition des elements du noyau de convolution. */ #define VARIABLES_DU_JEU_DE_LA_VIE_GENERALISE \ DEFV(Int,INIT(index,UNDEF)); \ /* Pour parcourir le noyau de convolution. */ \ DEFV(Int,INIT(volume_du_noyau_de_convolution,VOLUME_DU_NOYAU)); \ /* Nombre de points du noyau de convolution. */ \ \ DEFV(Logical,DTb1(niveaux_a_traiter,COULEURS)); \ /* Definit les niveaux sur lesquels on doit faire la convolution par 'Pconvolution()'. */ \ DEFV(Logical,DTb1(niveaux_cumulables,COULEURS)); \ /* Definit les niveaux cumulables lors du calcul de 'Pconvolution_____cumul_courant'. */ \ \ DEFV(Float,DdTb1(POINTERf \ ,noyau_de_convolution \ ,volume_du_noyau_de_convolution \ ,fMalo(MUL2(volume_du_noyau_de_convolution,size_Float)) \ ) \ ); \ /* Noyau de convolution memorise par un vecteur contenant en fait une spirale */ \ /* carree des coefficients de ponderation. */ \ DEFV(Logical,DdTb1(POINTERl \ ,inhibition_du_noyau_de_convolution \ ,volume_du_noyau_de_convolution \ ,lMalo(MUL2(volume_du_noyau_de_convolution,size_Logical)) \ ) \ ); \ /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ \ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ #define JEU_DE_LA_VIE_GENERALISE(definition_du_noyau,convolution) \ Bblock \ PUSH_FILTRAGE; \ /* Sauvegarde de l'etat courant du filtrage des niveaux. */ \ SET_FILTRAGE(ACTIF); \ /* On autorise tous les filtrages afin d'avoir la 'SUBSTITUTION'. */ \ PUSH_SUBSTITUTION; \ /* Sauvegarde de la substitution courante. */ \ \ BoIn(niveau,NOIR,BLANC,PAS_COULEURS) \ Bblock \ EGAL(ITb1(niveaux_a_traiter,INDX(niveau,NOIR)),VRAI); \ EGAL(ITb1(niveaux_cumulables,INDX(niveau,NOIR)),VRAI); \ /* Initialisation telle que tous les niveaux soient a la fois "traitables" et "cumulables". */ \ Eblock \ EBoI \ \ BLOC(definition_du_noyau); \ \ BoIn(niveau,NOIR,BLANC,PAS_COULEURS) \ Bblock \ MODIFICATION_LISTE_DE_SUBSTITUTION \ (niveau \ ,GENP(NIVA(MUL2(NIVR(BLANC) \ ,EXPB(NEGA(MUL2(MUL2(NomDeLaFonctionCourante QD@@__ _____force_de_la_vie \ ,DOUB(LOGX(BLANC)) \ ) \ ,EXP2(DIVI(SOUS(FLOT(niveau),MAXIMUM_DE_LA_VIE) \ ,FLOT__BLANC \ ) \ ) \ ) \ ) \ ) \ ) \ ) \ ) \ ); \ /* On notera que l'on utilise 'EXPB(...)' et non pas 'EXPX(...)' a cause du bug */ \ /* 'BUG_SYSTEME_SG_C_exp'... */ \ Eblock \ EBoI \ \ SUBSTITUTION(L_SUBSTITUTION_VARIABLE); \ \ BLOC(convolution); \ /* Et generation de l'image transformee suivant le jeu de la vie generalise... */ \ \ PULL_SUBSTITUTION; \ PULL_FILTRAGE; \ /* Et restauration des conditions initiales... */ \ \ FdTb1(inhibition_du_noyau_de_convolution,volume_du_noyau_de_convolution,Logical,ADRESSE_PLUS_DEFINIE); \ /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ \ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ \ /* */ \ /* Le 'ADRESSE_PLUS_DEFINIE' a ete introduit le 20050221164113... */ \ FdTb1(noyau_de_convolution,volume_du_noyau_de_convolution,Float,ADRESSE_PLUS_DEFINIE); \ /* Noyau de convolution memorise par un vecteur contenant en fait une spirale */ \ /* carree des coefficients de ponderation. */ \ /* */ \ /* Le 'ADRESSE_PLUS_DEFINIE' a ete introduit le 20050221164113... */ \ Eblock \ /* Definition du jeu de la vie generalise introduit sous cette forme le 20190805101432... */ #define TAILLE_DU_NOYAU \ NOMBRE_DE_POINTS_EFFECTIF_D_UN_NOYAU_DE_CONVOLUTION_PARCOURU_CIRCULAIREMENT \ (DOUP(NomDeLaFonctionCourante QD@@__ _____demi_taille_du_noyau)) \ /* Taille du noyau de convolution suivant les deux axes. */ #define VOLUME_DU_NOYAU \ EXP2(TAILLE_DU_NOYAU) \ /* Nombre d'elements contenus dans le noyau de convolution. */ BFonctionP DEFV(Common,DEFV(Float,SINT(Ijeu_de_la_vie_generalise_____force_de_la_vie,FU))); /* Plus cette constante sera grande, plus le pic de la liste de substitution */ /* sera pointu et etroit (mis sous la forme d'un 'Float' le 20090125100415). */ DEFV(Common,DEFV(Float,SINT(Ijeu_de_la_vie_generalise_____rapport_critique,RAPPORT_CRITIQUE(ZERO)))); /* Rapport critique introduit le 20090125100415... */ DEFV(Common,DEFV(Int,SINT(Ijeu_de_la_vie_generalise_____demi_taille_du_noyau,UN))); /* "Demi-taille" du noyau de convolution suivant les deux axes. */ DEFV(Common,DEFV(FonctionP,POINTERp(Ijeu_de_la_vie_generalise(imageR,imageA)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=VIE(imageA[X][Y]), ou 'VIE' */ /* designe une fonction de transformation du niveau d'un point. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Float,INIT(facteur_multiplicatif,FACTEUR_MULTIPLICATIF_DE_CONVOLUTION)); /* Facteur multiplicatif du produit de convolution en chaque point {X,Y}. */ VARIABLES_DU_JEU_DE_LA_VIE_GENERALISE; /*..............................................................................................................................*/ JEU_DE_LA_VIE_GENERALISE(BLOC(Bblock NOYAU_DE_CONVOLUTION(DEBUT_DU_NOYAU,FONCTION_DE_CONVOLUTION(FZERO)); DoIn(index,SUCC(DEBUT_DU_NOYAU),FIN_DU_NOYAU,I) Bblock NOYAU_DE_CONVOLUTION(index,FONCTION_DE_CONVOLUTION(FU)); /* Initialisation du noyau de convolution, element par element, et de telle */ /* facon que le point courant ne soit pas pris en compte ('FZERO') alors */ /* que ses 8 voisins aient tous la meme contribution ('FU'). */ Eblock EDoI Eblock ) ,BLOC(Bblock CALS(Iconvolution(imageR ,facteur_multiplicatif ,imageA ,niveaux_a_traiter,niveaux_cumulables ,volume_du_noyau_de_convolution ,noyau_de_convolution ,inhibition_du_noyau_de_convolution ) ); Eblock ) ); RETI(imageR); Eblock EFonctionP BFonctionF DEFV(Common,DEFV(Float,SINT(IFjeu_de_la_vie_generalise_____force_de_la_vie,FU))); /* Plus cette constante sera grande, plus le pic de la liste de substitution */ /* sera pointu et etroit... */ DEFV(Common,DEFV(Float,SINT(IFjeu_de_la_vie_generalise_____rapport_critique,RAPPORT_CRITIQUE(ZERO)))); /* Rapport critique introduit le 20090125100415... */ DEFV(Common,DEFV(Int,SINT(IFjeu_de_la_vie_generalise_____demi_taille_du_noyau,UN))); /* "Demi-taille" du noyau de convolution suivant les deux axes. */ DEFV(Common,DEFV(FonctionF,POINTERF(IFjeu_de_la_vie_generalise(imageR,imageA)))) /* Fonction introduite le 20240826120244... */ DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=VIE(imageA[X][Y]), ou 'VIE' */ /* designe une fonction de transformation du niveau d'un point. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Float,INIT(facteur_multiplicatif,FACTEUR_MULTIPLICATIF_DE_CONVOLUTION)); /* Facteur multiplicatif du produit de convolution en chaque point {X,Y}. */ VARIABLES_DU_JEU_DE_LA_VIE_GENERALISE; /*..............................................................................................................................*/ JEU_DE_LA_VIE_GENERALISE(BLOC(Bblock NOYAU_DE_CONVOLUTION(DEBUT_DU_NOYAU,FONCTION_DE_CONVOLUTION(FZERO)); DoIn(index,SUCC(DEBUT_DU_NOYAU),FIN_DU_NOYAU,I) Bblock NOYAU_DE_CONVOLUTION(index,FONCTION_DE_CONVOLUTION(FU)); /* Initialisation du noyau de convolution, element par element, et de telle */ /* facon que le point courant ne soit pas pris en compte ('FZERO') alors */ /* que ses 8 voisins aient tous la meme contribution ('FU'). */ Eblock EDoI Eblock ) ,BLOC(Bblock CALS(IFFconvolution(imageR ,facteur_multiplicatif ,imageA ,volume_du_noyau_de_convolution ,noyau_de_convolution ,inhibition_du_noyau_de_convolution ) ); Eblock ) ); RETIF(imageR); Eblock EFonctionF #undef VOLUME_DU_NOYAU #undef TAILLE_DU_NOYAU #define VOLUME_DU_NOYAU \ TAILLE_MAXIMALE_D_UN_NOYAU_DE_CONVOLUTION \ /* Taille du noyau de convolution suivant les deux axes. */ BFonctionP DEFV(Common,DEFV(Float,SINT(Ijeu_de_la_vie_generalise_variable_____force_de_la_vie,FU))); /* Plus cette constante sera grande, plus le pic de la liste de substitution */ /* sera pointu et etroit (mis sous la forme d'un 'Float' le 20090125100415). */ DEFV(Common,DEFV(Float,SINT(Ijeu_de_la_vie_generalise_variable_____rapport_critique,RAPPORT_CRITIQUE(UN)))); /* Rapport critique introduit le 20090125100415... */ DEFV(Common,DEFV(FonctionP,POINTERp(Ijeu_de_la_vie_generalise_variable(imageR ,facteur_multiplicatif ,imageA ,facteur_du_nombre_de_points ,image_donnant_le_nombre_de_points_du_noyau ,image_definissant_la_valeur_du_noyau ,image_inhibant_la_valeur_du_noyau ,seuil_d_inhibition_du_noyau ) ) ) ) /* Fonction introduite le 20190805104131... */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=VIE(imageA[X][Y]), ou 'VIE' */ /* designe une fonction de transformation du niveau d'un point. */ DEFV(Argument,DEFV(Float,facteur_multiplicatif)); /* Facteur multiplicatif du produit de convolution en chaque point {X,Y}. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Float,facteur_du_nombre_de_points)); /* Pour calculer le nombre de points contenus dans le noyau, y compris */ /* son centre, au point courant {X,Y}. */ DEFV(Argument,DEFV(image,image_donnant_le_nombre_de_points_du_noyau)); /* Image dont le point courant {X,Y} donne au facteur 'facteur_du_nombre_de_points' */ /* le nombre d'elements du noyau de convolution courant pour le point {X,Y}. */ DEFV(Argument,DEFV(image,image_definissant_la_valeur_du_noyau)); /* Image dont le centre va definir la valeur du noyau de convolution. */ DEFV(Argument,DEFV(image,image_inhibant_la_valeur_du_noyau)); DEFV(Argument,DEFV(genere_p,seuil_d_inhibition_du_noyau)); /* Image dont le centre va inhiber (eventuellement) le noyau de convolution, en fonction */ /* du seuil correspondant... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock VARIABLES_DU_JEU_DE_LA_VIE_GENERALISE; /*..............................................................................................................................*/ JEU_DE_LA_VIE_GENERALISE(BLOC(VIDE;) ,BLOC(Bblock CALS(Iconvolution_variable(imageR ,facteur_multiplicatif ,imageA ,niveaux_a_traiter,niveaux_cumulables ,facteur_du_nombre_de_points ,image_donnant_le_nombre_de_points_du_noyau ,image_definissant_la_valeur_du_noyau ,image_inhibant_la_valeur_du_noyau ,seuil_d_inhibition_du_noyau ) ); Eblock ) ); /* On notera le 20190805151602 que contrairement a 'Ijeu_de_la_vie_generalise(...)' on */ /* ne force pas a zero le premier point point du noyau via quelque chose du type : */ /* */ /* NOYAU_DE_CONVOLUTION(DEBUT_DU_NOYAU,FONCTION_DE_CONVOLUTION(FZERO)); */ /* */ /* En effet, via 'image_donnant_le_nombre_de_points_du_noyau', il est tout a fait possible */ /* que des noyaux n'aient qu'un seul point (le premier...) et il ne faut pas que cet */ /* element soit nul a cause de 'v $xiii/di_image$FON IZEQ.cumul_de_l_ensemble_des_pond...'. */ /* */ /* C'est cela qui le 20190806091503 a motive l'introduction de 'RAPPORT_CRITIQUE(UN)' */ /* ci-dessus (qui prend donc en compte LE point central du noyau via le 'UN'...). */ RETI(imageR); Eblock EFonctionP BFonctionF DEFV(Common,DEFV(Float,SINT(IFjeu_de_la_vie_generalise_variable_____force_de_la_vie,FU))); /* Plus cette constante sera grande, plus le pic de la liste de substitution */ /* sera pointu et etroit... */ DEFV(Common,DEFV(Float,SINT(IFjeu_de_la_vie_generalise_variable_____rapport_critique,RAPPORT_CRITIQUE(UN)))); /* Rapport critique... */ DEFV(Common,DEFV(FonctionF,POINTERF(IFjeu_de_la_vie_generalise_variable(imageR ,facteur_multiplicatif ,imageA ,facteur_du_nombre_de_points ,image_donnant_le_nombre_de_points_du_noyau ,image_definissant_la_valeur_du_noyau ,image_inhibant_la_valeur_du_noyau ,seuil_d_inhibition_du_noyau ) ) ) ) /* Fonction introduite le 20240826120244... */ DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=VIE(imageA[X][Y]), ou 'VIE' */ /* designe une fonction de transformation du niveau d'un point. */ DEFV(Argument,DEFV(Float,facteur_multiplicatif)); /* Facteur multiplicatif du produit de convolution en chaque point {X,Y}. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Float,facteur_du_nombre_de_points)); /* Pour calculer le nombre de points contenus dans le noyau, y compris */ /* son centre, au point courant {X,Y}. */ DEFV(Argument,DEFV(image,image_donnant_le_nombre_de_points_du_noyau)); /* Image dont le point courant {X,Y} donne au facteur 'facteur_du_nombre_de_points' */ /* le nombre d'elements du noyau de convolution courant pour le point {X,Y}. */ DEFV(Argument,DEFV(image,image_definissant_la_valeur_du_noyau)); /* Image dont le centre va definir la valeur du noyau de convolution. */ DEFV(Argument,DEFV(image,image_inhibant_la_valeur_du_noyau)); DEFV(Argument,DEFV(genere_p,seuil_d_inhibition_du_noyau)); /* Image dont le centre va inhiber (eventuellement) le noyau de convolution, en fonction */ /* du seuil correspondant... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock VARIABLES_DU_JEU_DE_LA_VIE_GENERALISE; /*..............................................................................................................................*/ JEU_DE_LA_VIE_GENERALISE(BLOC(VIDE;) ,BLOC(Bblock CALS(IFFconvolution_variable(imageR ,facteur_multiplicatif ,imageA ,niveaux_a_traiter,niveaux_cumulables ,facteur_du_nombre_de_points ,image_donnant_le_nombre_de_points_du_noyau ,image_definissant_la_valeur_du_noyau ,image_inhibant_la_valeur_du_noyau ,seuil_d_inhibition_du_noyau ) ); Eblock ) ); /* On notera que contrairement a 'Ijeu_de_la_vie_generalise(...)' on ne force pas a zero */ /* le premier point point du noyau via quelque chose du type : */ /* */ /* NOYAU_DE_CONVOLUTION(DEBUT_DU_NOYAU,FONCTION_DE_CONVOLUTION(FZERO)); */ /* */ /* En effet, via 'image_donnant_le_nombre_de_points_du_noyau', il est tout a fait possible */ /* que des noyaux n'aient qu'un seul point (le premier...) et il ne faut pas que cet */ /* element soit nul a cause de 'v $xiii/di_image$FON IZEQ.cumul_de_l_ensemble_des_pond...'. */ RETIF(imageR); Eblock EFonctionF #undef VOLUME_DU_NOYAU #undef JEU_DE_LA_VIE_GENERALISE #undef VARIABLES_DU_JEU_DE_LA_VIE_GENERALISE #undef NOYAU_DE_CONVOLUTION #undef FIN_DU_NOYAU #undef DEBUT_DU_NOYAU #undef FACTEUR_MULTIPLICATIF_DE_CONVOLUTION #undef RAPPORT_CRITIQUE #undef MAXIMUM_DE_LA_VIE #undef NOMBRE_DE_POINTS #undef CALCUL_D_UN_NOYAU_DE_CONVOLUTION_VARIABLE #undef FONCTION_DE_CONVOLUTION /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* A U T O M A T E S C E L L U L A I R E S B I D I M E N S I O N N E L S P A R C O N V O L U T I O N : */ /* */ /*************************************************************************************************************************************/ BFonctionP #define DEBUT_DE_LA_FORME \ PREMIER_POINT \ /* Premier element de la forme. */ #define FIN_DE_LA_FORME \ LSTX(DEBUT_DE_LA_FORME,longueur_des_regles) \ /* Dernier element de la forme. */ #define DEFINITION_DE_LA_FORME(numero,valeur) \ Bblock \ EGAL(IdTb1(regle_courante,INDX(numero,DEBUT_DE_LA_FORME),longueur_des_regles) \ ,FLOT(valeur) \ ); \ EGAL(IdTb1(inhibition_des_regles,INDX(numero,DEBUT_DE_LA_FORME),longueur_des_regles) \ ,ACTIF \ ); \ Eblock \ /* Definition des elements de la forme. */ DEFV(Common,DEFV(Logical,SINT(Iautomate_cellulaire_bidimensionnel_par_convolution_____effacer_points_non_traites,VRAI))); /* Les points pour lesquels aucune regle n'aura ete reconnue seront effaces a 'NOIR' */ /* ('VRAI') ou bien conserves en l'etat ('FAUX')... */ DEFV(Common,DEFV(FonctionP,POINTERp(Iautomate_cellulaire_bidimensionnel_par_convolution(imageR ,imageA ,nombre_de_regles ,longueur_des_regles ,automate_cellulaire ,nombre_d_iterations ,ne_tester_que_le_nombre_de_points ,susbtituer_les_niveaux_a_l_instant_precedent ) ) ) ) /* Cette fonction a ete introduite le 20030116093638. */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=Evolution(imageA[X][Y]). */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Positive,nombre_de_regles)); DEFV(Argument,DEFV(Positive,longueur_des_regles)); DEFV(Argument,DEFV(automate_cellulaire_bidimensionnel,automate_cellulaire)); /* Image donnant l'automate cellulaire courant et nombre de regles (de longueur precisee) */ /* qu'il contient... */ DEFV(Argument,DEFV(Positive,nombre_d_iterations)); /* Nombre d'iterations a effectuer. */ DEFV(Argument,DEFV(Logical,ne_tester_que_le_nombre_de_points)); /* Si 'FAUX', la forme exacte est testee ; si 'VRAI', seul le nombre de points importe */ /* (argument introduit le 20030120163418). On notera que la terminologie "nombre de points" */ /* constitue en toute generalite un abus de langage ; cette procedure n'evalue en fait */ /* rellement des nombres de point que si les points (de l'image 'imageA' et de l'automate */ /* cellulaire 'automate_cellulaire') n'utilisent que deux niveaux : le NOIR et un autre */ /* niveau quelconque (le BLANC en general) ; de plus ce nombre de points non NOIRs est */ /* alors connu a un facteur pres (egal au deuxieme niveau...). */ DEFV(Argument,DEFV(Logical,susbtituer_les_niveaux_a_l_instant_precedent)); /* Indique si lors du 'iMOVE(etat_a_l_instant_precedent,etat_a_l_instant_courant)' */ /* les niveaux doivent etre substitues ('VRAI') ou pas ('FAUX'). Cet indicateur a ete */ /* introduit le 20030124163128. Ceci a ete introduit en vue de manipuler plus facilement */ /* des automates cellulaires bidimensionnels non binaires ; en effet, dans le cas, ou il */ /* a beaucoup de niveaux, il y a alors trop de regles et cela devient vite ingerable et */ /* non maitrise. Grace aux substitutions, il est possible de "regrouper", par exemple, */ /* des niveaux voisins par paquet grace a une liste de SUBSTITUTION en forme de marches */ /* d'escalier... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock BDEFV(image,etat_a_l_instant_precedent); BDEFV(image,etat_substitue_a_l_instant_precedent); BDEFV(image,etat_a_l_instant_courant); /* Images destinees a contenir l'etat de l'automate cellulaire aux instants 't-1' et 't'. */ /* L'image 'etat_substitue_a_l_instant_precedent' a ete introduite le 20030124163128 et */ /* n'est utile que si 'IL_FAUT(susbtituer_les_niveaux_a_l_instant_precedent)'. */ /*..............................................................................................................................*/ SPIRALE_VALIDATION; iMOVE(etat_a_l_instant_courant,imageA); /* Initialisation de l'evolution (voir les commentaires relatifs a la procedure */ /* 'iMOVE(...)' dans 'v $xiii/di_image$DEF')... */ Test(IFGT(longueur_des_regles,PRED(dimX))) /* Le 'PRED(...)' traduit le fait que le premier point de chaque ligne de la definition */ /* de l'automate cellulaire ('automate_cellulaire') contient le niveau a donner au point */ /* courant {X,Y} si la regle s'applique, sachant que cette derniere est contenue dans les */ /* points qui suivent qui ne peuvent donc etre plus nombreux que 'PRED(dimX)'... */ Bblock PRINT_ERREUR("les regles sont trop longues, rien ne peut etre fait"); CAL1(Prer2("%d est la longueur demandee alors que la limite est %d\n" ,longueur_des_regles ,PRED(dimX) ) ); Eblock ATes Bblock DEFV(Float,DdTb1(POINTERf ,regle_courante ,longueur_des_regles ,fMalo(MUL2(longueur_des_regles,size_Float)) ) ); /* Definition de la forme recherchee courante. */ /* */ /* On notera que la logique voudrait que 'regle_courante' soit une structure locale a */ /* 'Repe(nombre_de_regles)', mais ainsi, on optimise en reduisant le nombre de 'fMalo(...)'. */ DEFV(Logical,DdTb1(POINTERl ,inhibition_des_regles ,longueur_des_regles ,lMalo(MUL2(longueur_des_regles,size_Logical)) ) ); /* Precise pour chaque point de la forme s'il est 'ACTIF' (a utiliser dans */ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ /* */ /* On notera que la logique voudrait que 'inhibition_des_regles' soit une structure locale a */ /* 'Repe(nombre_de_regles)', mais ainsi, on optimise en reduisant le nombre de 'lMalo(...)'. */ Repe(nombre_d_iterations) Bblock iMOVE(etat_a_l_instant_precedent,etat_a_l_instant_courant); /* Changement de l'etat precedent (voir les commentaires relatifs a la procedure */ /* 'iMOVE(...)' dans 'v $xiii/di_image$DEF') sans substitution... */ Test(IL_FAUT(susbtituer_les_niveaux_a_l_instant_precedent)) Bblock PUSH_FILTRAGE; /* Sauvegarde de l'etat courant du filtrage des niveaux. */ SET_FILTRAGE(ACTIF); /* On autorise tous les filtrages afin d'avoir la 'SUBSTITUTION'. */ iMOVE(etat_substitue_a_l_instant_precedent,etat_a_l_instant_precedent); /* Changement de l'etat precedent avec substitution en vue de manipuler plus facilement */ /* des automates cellulaires bidimensionnels non binaires ; en effet, dans le cas, ou il */ /* a beaucoup de niveaux, il y a alors trop de regles et cela devient vite ingerable et */ /* non maitrise. Grace aux substitutions, il est possible de "regrouper", par exemple, */ /* des niveaux voisins par paquet grace a une liste de SUBSTITUTION en forme de marches */ /* d'escalier... */ PULL_FILTRAGE; /* Et restauration des conditions initiales... */ Eblock ATes Bblock Eblock ETes CALS(Inoir(etat_a_l_instant_courant)); /* Et nettoyage de l'etat courant. */ begin_image_AvecEditionProgression /* Le 20170520104209 a ete introduit "_AvecEditionProgression"... */ Bblock DEFV(Logical,INIT(iterer_les_regles,VRAI)); DEFV(Positive,INIT(nombre_de_regles_encore_a_appliquer,nombre_de_regles)); /* Afin de gerer l'iteration des regles. */ DEFV(Int,INIT(numero_de_la_regle_courante,Ymin)); /* Definition de la regle courante initialisee sur la premiere, definie comme la */ /* coordonnee 'Y' de l'automate cellulaire bidimensionnel. */ Tant(IL_FAUT(iterer_les_regles)) Bblock DEFV(Int,INIT(index,UNDEF)); /* Pour parcourir la forme. */ DEFV(Int,INIT(numero_du_point_courant_de_la_regle_courante,Xmin)); /* Definition du point courant de la regle courante initialise sur le premier, defini */ /* comme la coordonnee 'X' de l'automate cellulaire bidimensionnel. */ DEFV(genere_p,INIT(nouveau_niveau_si_la_regle_courante_est_satisfaite,NIVEAU_UNDEF)); EGAL(nouveau_niveau_si_la_regle_courante_est_satisfaite ,GENP(AUTOMATE_CELLULAIRE_BIDIMENSIONNEL(automate_cellulaire ,numero_du_point_courant_de_la_regle_courante ,numero_de_la_regle_courante ) ) ); /* Valeur du point courant {X,Y} si la regle courante s'applique. */ DoIn(index,DEBUT_DE_LA_FORME,FIN_DE_LA_FORME,I) Bblock INCR(numero_du_point_courant_de_la_regle_courante,PasX); DEFINITION_DE_LA_FORME(index ,AUTOMATE_CELLULAIRE_BIDIMENSIONNEL(automate_cellulaire ,numero_du_point_courant_de_la_regle_courante ,numero_de_la_regle_courante ) ); /* Initialisation de la forme courante. */ Eblock EDoI begin_nouveau_block Bblock BSaveModifyVariable(Logical,Pconvolution_____recherche_d_une_forme_sur_la_spirale,VRAI); /* Afin de rechercher une forme grace a 'Pconvolution(...)'. */ /* */ /* Sauvegarde de l'etat initial de 'Pconvolution_____recherche_d_une_forme_sur_la_spirale'. */ /* Cette operation a ete rendue "locale" a la boucle {begin_image,end_image} le */ /* 20030124091522, alors qu'avant elle etait "globale" et faite une fois pour toute, */ /* afin de prevoir de futures evolutions... */ /* */ /* Mis sous cette forme le 20101115152408... */ CALS(Pconvolution(COND(IL_NE_FAUT_PAS(susbtituer_les_niveaux_a_l_instant_precedent) ,etat_a_l_instant_precedent ,etat_substitue_a_l_instant_precedent ) ,COND(IL_NE_FAUT_PAS(susbtituer_les_niveaux_a_l_instant_precedent) ,etat_a_l_instant_precedent ,etat_substitue_a_l_instant_precedent ) ,X,Y ,ADRESSE_UNDEF ,longueur_des_regles ,regle_courante,inhibition_des_regles ) ); /* Etude de la presence de la forme courante au point {X,Y}. */ ESaveModifyVariable(Logical,Pconvolution_____recherche_d_une_forme_sur_la_spirale); /* Restauration etat initial de 'Pconvolution_____recherche_d_une_forme_sur_la_spirale'. */ /* */ /* Mis sous cette forme le 20101115152408... */ Eblock end_nouveau_block Test(IFOU(IFET(EST_FAUX(ne_tester_que_le_nombre_de_points) ,EST_VRAI(Pconvolution_____la_forme_cherchee_a_ete_trouvee_sur_la_spirale) ) ,I4ET(EST_VRAI(ne_tester_que_le_nombre_de_points) ,IFEQ(Pconvolution_____nombre_des_ponderations_lors_de_la_recherche_d_une_forme_sur_la_spirale ,Pconvolution_____nombre_courant_lors_de_la_recherche_d_une_forme_sur_la_spirale ) ,IFEQ(Pconvolution_____cumul_des_ponderations_lors_de_la_recherche_d_une_forme_sur_la_spirale ,Pconvolution_____cumul_courant_lors_de_la_recherche_d_une_forme_sur_la_spirale ) ,IFEQ(Pconvolution_____nombre_des_ponderations_lors_de_la_recherche_d_une_forme_sur_la_spirale ,Pconvolution_____nombre_courant_lors_de_la_recherche_d_une_forme_sur_la_spirale ) ) ) ) /* 'Pconvolution_____cumul_des_ponderations_lors_de_la_recherche_d_une_forme_sur_la_spirale' */ /* donne le cumul des points de la forme cherchee et */ /* 'Pconvolution_____cumul_courant_lors_de_la_recherche_d_une_forme_sur_la_spirale' le cumul */ /* cumul des niveaux rencontres (le test correspondant fut introduit le 20030120163418 et */ /* modifie le 20030127101035). On notera que la terminologie "nombre de points" */ /* constitue en toute generalite un abus de langage ; cette procedure n'evalue en fait */ /* rellement des nombres de point que si les points (de l'image 'imageA' et de l'automate */ /* cellulaire 'automate_cellulaire') n'utilisent que deux niveaux : le NOIR et un autre */ /* niveau quelconque (le BLANC en general) ; de plus ce nombre de points non NOIRs est */ /* alors connu a un facteur pres (egal au deuxieme niveau...). */ /* */ /* Le test sur les nombres et les produits a ete introduit le 20030126120532 afin de */ /* permettre une bonne utilisation des listes de SUBSTITUTION... */ Bblock store_point(nouveau_niveau_si_la_regle_courante_est_satisfaite ,etat_a_l_instant_courant ,X,Y ,FVARIABLE ); /* La forme courante a ete reconnue, on applique donc la regle courante... */ EGAL(iterer_les_regles,FAUX); /* Et on arrete d'iterer... */ Eblock ATes Bblock Eblock ETes DECR(nombre_de_regles_encore_a_appliquer,I); Test(EST_VRAI(iterer_les_regles)) /* Cas ou aucune forme n'a ete reconnue : */ Bblock Test(IZEQ(nombre_de_regles_encore_a_appliquer)) Bblock Test(IL_FAUT(Iautomate_cellulaire_bidimensionnel_par_convolution_____effacer_points_non_traites)) Bblock Eblock ATes Bblock store_point(load_point(etat_a_l_instant_precedent,X,Y) ,etat_a_l_instant_courant ,X,Y ,FVARIABLE ); /* Dans ce cas, le point courant {X,Y} garde son etat anterieur, ce qui est finalement */ /* assez arbitraire... */ Eblock ETes EGAL(iterer_les_regles,FAUX); /* Il n'y a plus de regles a appliquer, on arrete... */ Eblock ATes Bblock INCR(numero_de_la_regle_courante,PasY); /* Passage a la regle suivante... */ Eblock ETes Eblock ATes Bblock /* Cas ou une forme a ete reconnue : on a deja decide de s'arreter... */ Eblock ETes Eblock ETan Eblock end_image_AvecEditionProgression /* Le 20170520104209 a ete introduit "_AvecEditionProgression"... */ Eblock ERep Eblock ETes iMOVE(imageR,etat_a_l_instant_courant); /* Initialisation de l'evolution (voir les commentaires relatifs a la procedure */ /* 'iMOVE(...)' dans 'v $xiii/di_image$DEF')... */ EDEFV(image,etat_a_l_instant_courant); EDEFV(image,etat_substitue_a_l_instant_precedent); EDEFV(image,etat_a_l_instant_precedent); /* Images destinees a contenir l'etat de l'automate cellulaire aux instants 't-1' et 't'. */ /* L'image 'etat_substitue_a_l_instant_precedent' a ete introduite le 20030124163128 et */ /* n'est utile que si 'IL_FAUT(susbtituer_les_niveaux_a_l_instant_precedent)'. */ RETI(imageR); Eblock #undef DEFINITION_DE_LA_FORME #undef FIN_DE_LA_FORME #undef DEBUT_DE_LA_FORME EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E F O R M A T I O N " I N V E R S E " B I - E T T R I D I M E N S I O N N E L L E */ /* D I R E C T E O U I N D I R E C T E */ /* D ' U N E I M A G E " F L O T T A N T E " : */ /* */ /*************************************************************************************************************************************/ #define ACCES_A_UNE_VALEUR_INTERPOLEE_DANS_UNE_IMAGE(valeur,image) \ Bblock \ gACCES_A_UNE_VALEUR_INTERPOLEE_DANS_UNE_IMAGE(valeur,image); \ /* L'eventuelle matrice de transformation de 'FFload_point_coordonnees_01(...)' sera */ \ /* utilisee pour les images, contrairement aux deformations... */ \ Eblock /* Procedures introduites le 20081029091241. Elles sont destinees a alleger l'ecriture de */ /* la procedure 'DEFORMATION_INVERSE_BI_ET_TRIDIMENSIONNELLE(...)'. */ #define TRANSFORMATION_GEOMETRIQUE_2D_Xf(Xf,Yf) \ gTRANSFORMATION_GEOMETRIQUE_3D_Fxyz \ (NomDeLaFonctionCourante QD@@__ _____matrice_de_transformation_2D \ ,SOUS(Xf_itere,NomDeLaFonctionCourante QD@@__ _____PreAntiTranslation_Xf) \ ,SOUS(Yf_itere,NomDeLaFonctionCourante QD@@__ _____PreAntiTranslation_Yf) \ ,FZERO \ ,cx \ ,NomDeLaFonctionCourante QD@@__ _____Post___Translation_Xf \ ) #define TRANSFORMATION_GEOMETRIQUE_2D_Yf(Xf,Yf) \ gTRANSFORMATION_GEOMETRIQUE_3D_Fxyz \ (NomDeLaFonctionCourante QD@@__ _____matrice_de_transformation_2D \ ,SOUS(Xf_itere,NomDeLaFonctionCourante QD@@__ _____PreAntiTranslation_Xf) \ ,SOUS(Yf_itere,NomDeLaFonctionCourante QD@@__ _____PreAntiTranslation_Yf) \ ,FZERO \ ,cy \ ,NomDeLaFonctionCourante QD@@__ _____Post___Translation_Yf \ ) /* Procedures introduites le 20081029094605 par "symetrie" avec ce qui a ete fait dans */ /* 'v $xiipf/fonction.2$FON TRANSFORMATION_GEOMETRIQUE_2D_.f'. */ #define Xc \ EnTete_de_sauvegardM ## X #define Yc \ EnTete_de_sauvegardM ## Y /* Memorisation du point courant {Xc,Yc} (on notera que la procedure 'begin_imageQ(...)' */ /* permet d'y acceder via '{SavM_____X,SavM_____Y}). */ #define coordonnees_X_sont_normalisees \ _____les_coordonnees_X_sont_normalisees #define coordonnees_Y_sont_normalisees \ _____les_coordonnees_Y_sont_normalisees #define nombre_iterations_calcul_des_coordonnees \ _____nombre_d_iterations_du_calcul_des_coordonnees #define matrice_transformation_2D \ _____appliquer_une_matrice_de_transformation_2D /* Afin de raccourcir certaines lignes ci-apres... */ #define DEFORMATION_INVERSE_BI_ET_TRIDIMENSIONNELLE(calcul_de_la_coordonnee_Z,diX,diY) \ /* Les arguments {diX,diY} ont ete introduits le 20090510115427 afin de faciliter une */ \ /* permutation (eventuelle) des roles de {diX,diY} et de {imageIX,imageIY}. Mais attention, */ \ /* cela ne serait pas tres coherent a cause de l'usage qui est fait de 'diZ' dans le cas de */ \ /* la definition de 'IFdeformation_inverse_indirecte_tridimensionnelle(...)'. */ \ Bblock \ begin_image \ Bblock \ DEFV(Logical,INIT(deformer_le_point_courant,VRAI)); \ /* A priori, le point courant {X,Y} va etre deforme... */ \ \ Test(IL_FAUT(NomDeLaFonctionCourante QD@@__ _____ignorer_un_couple_diX_diY)) \ /* Test introduit le 20120620121228... */ \ Bblock \ Test(IFET(IFEQ(loadF_point(diX,X,Y),NomDeLaFonctionCourante QD@@__ _____ignorer_cette_valeur_de_diX) \ ,IFEQ(loadF_point(diY,X,Y),NomDeLaFonctionCourante QD@@__ _____ignorer_cette_valeur_de_diY) \ ) \ ) \ Bblock \ EGAL(deformer_le_point_courant,FAUX); \ /* Le point courant {X,Y} doit etre ignore... */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ Test(IL_FAUT(deformer_le_point_courant)) \ /* Test introduit le 20120620121228... */ \ Bblock \ DEFV(Float,INIT(cumul_du_niveau_courant,FZERO)); \ DEFV(Positive,INIT(nombre_de_niveaux_cumules,ZERO)); \ /* Introduits le 20090106120525 afin de permettre de prendre en compte le voisinage du */ \ /* point courant {X,Y} si besoin est... */ \ \ begin_imageQ(DoIn \ ,COYA(SOUS(COYR(Yc),NomDeLaFonctionCourante QD@@__ _____demi_taille_Y_du_pave)) \ ,COYA(ADD2(COYR(Yc),NomDeLaFonctionCourante QD@@__ _____demi_taille_Y_du_pave)) \ ,PasY \ ,DoIn \ ,COXA(SOUS(COXR(Xc),NomDeLaFonctionCourante QD@@__ _____demi_taille_X_du_pave)) \ ,COXA(ADD2(COXR(Xc),NomDeLaFonctionCourante QD@@__ _____demi_taille_X_du_pave)) \ ,PasX \ ) \ /* On notera le 20090106143945 qu'il serait surement preferable que le voisinage du point */ \ /* {Xc,Yc} soit defini dynamiquement (par exemple en fonction des gradients dans les champs */ \ /* {diX,diY} plutot que de maniere statique comme cela est fait a cette date. En tout cas, */ \ /* cela donne de bons resultats a condition de calculer les images avec une resolution */ \ /* superieure (par exemple 'Puq' pour 'Pal') comme cela se voit avec 'v $xiirv/STRU.j3' */ \ /* (a condition donc de choisir un pave de taille -ici 2x3+1=7- legerement superieure au */ \ /* facteur de passage de 'Pal' a 'Puq' -ici 4-)... */ \ Bblock \ Test(TEST_DANS_L_IMAGE(X,Y)) \ Bblock \ DEFV(Float,INIT(Xf \ ,OPC1(EST_VRAI(NomDeLaFonctionCourante QD@@__ coordonnees_X_sont_normalisees) \ ,NEUT \ ,_____cNORMALISE_OX \ ,loadF_point(diX,X,Y) \ ) \ ) \ ); \ DEFV(Float,INIT(Yf \ ,OPC1(EST_VRAI(NomDeLaFonctionCourante QD@@__ coordonnees_Y_sont_normalisees) \ ,NEUT \ ,_____cNORMALISE_OY \ ,loadF_point(diY,X,Y) \ ) \ ) \ ); \ /* Coordonnees flottantes de deformation "inverse"... */ \ /* */ \ /* On notera le 20080903145930 qu'il pourrait etre souhaitable de calculer 'Xf' et 'Yf' */ \ /* en calculant une 'LIN2(...)' des coordonnees 'X' et 'Y' normalisees et des translations */ \ /* calculees ci-dessus a partir des images 'diX' et 'diY'. Malgre l'interet de cela, je ne */ \ /* le fait pas pour deux raisons. D'une part si les coordonnees 'X' et 'Y' existent bien */ \ /* (via {begin_image,end_image}), la coordonnee 'Z' n'existe pas en ce qui concerne la */ \ /* version tridimensionnelle 'IFdeformation_inverse_tridimensionnelle(...)'. D'autre part, */ \ /* cela est facile a "simuler" en utilisant des images 'diX' et 'diY' definies d'une */ \ /* certaine facon (suivant le probleme a traiter) et en leur ajoutant respectivement les */ \ /* deux champs suivants : */ \ /* */ \ /* $xci/lineaire$X \ */ \ /* standard=FAUX \ */ \ /* A=1 B=0 C=0 \ */ \ /* $formatI | \ */ \ /* $xci/normalise.01$X \ */ \ /* R=$xTV/CHAMP$COORD_X \ */ \ /* $formatI */ \ /* */ \ /* pour 'diX' et : */ \ /* */ \ /* $xci/lineaire$X \ */ \ /* standard=FAUX \ */ \ /* A=0 B=1 C=0 \ */ \ /* $formatI | \ */ \ /* $xci/normalise.01$X \ */ \ /* R=$xTV/CHAMP$COORD_Y \ */ \ /* $formatI */ \ /* */ \ /* pour 'diY'... */ \ DEFV(genere_Float,INIT(niveau_courant,FLOT__NIVEAU_UNDEF)); \ /* Donne le niveau flottant courant apres deformation "inverse"... */ \ \ BLOC(calcul_de_la_coordonnee_Z); \ /* Introduit le 20080901140231, en notant que cette coordonnee 'Z' n'a d'utilite que si */ \ /* l'indicateur 'v $xiipf/fonction.2$FON FFload_point_coordonnees_01_____applique...' est */ \ /* 'VRAI'... */ \ \ Test(IL_FAUT(NomDeLaFonctionCourante QD@@__ _____iterer_le_calcul_des_coordonnees)) \ Bblock \ Test(IFET(EST_VRAI(NomDeLaFonctionCourante QD@@__ coordonnees_X_sont_normalisees) \ ,EST_VRAI(NomDeLaFonctionCourante QD@@__ coordonnees_Y_sont_normalisees) \ ) \ ) \ Bblock \ Repe(NomDeLaFonctionCourante QD@@__ nombre_iterations_calcul_des_coordonnees) \ Bblock \ DEFV(Float,INIT(Xf_itere,FLOT__UNDEF)); \ DEFV(Float,INIT(Yf_itere,FLOT__UNDEF)); \ \ ACCES_A_UNE_VALEUR_INTERPOLEE_DANS_UNE_IMAGE_DEFORMATION(Xf_itere,diX); \ ACCES_A_UNE_VALEUR_INTERPOLEE_DANS_UNE_IMAGE_DEFORMATION(Yf_itere,diY); \ /* Je note le 20081028113002 que tous les appels a 'FFload_point_coordonnees_01(...)' faits */ \ /* ici (dans 'DEFORMATION_INVERSE_BI_ET_TRIDIMENSIONNELLE(...)') vont utiliser les memes */ \ /* valeurs d'arguments implicites ('FFload_point_coordonnees_01_____*') et en particulier */ \ /* la meme matrice 'FFload_point_coordonnees_01_____matrice_de_transformation' si cette */ \ /* derniere est activee. Cela fut corrige par 'v $xiii/di_image$FON 20081029122749', mais */ \ /* de facon partielle et arbitraire... */ \ \ Test(IL_FAUT(NomDeLaFonctionCourante QD@@__ matrice_transformation_2D)) \ Bblock \ DEFV(Float,INIT(Xf_itere_transforme,FLOT__UNDEF)); \ DEFV(Float,INIT(Yf_itere_transforme,FLOT__UNDEF)); \ \ EGAL(Xf_itere_transforme,TRANSFORMATION_GEOMETRIQUE_2D_Xf(Xf,Yf)); \ EGAL(Yf_itere_transforme,TRANSFORMATION_GEOMETRIQUE_2D_Yf(Xf,Yf)); \ \ EGAL(Xf,Xf_itere_transforme); \ EGAL(Yf,Yf_itere_transforme); \ /* Cette possibilite de transformation fut introduite le 20081028143608 afin d'introduire */ \ /* une "difference" entre les deux 'FFload_point_coordonnees_01(...)'s qui precedent et */ \ /* celui qui suit suite a la remarque 'v $xiii/di_image$FON 20081028113002'... */ \ Eblock \ ATes \ Bblock \ \ EGAL(Xf,Xf_itere); \ EGAL(Yf,Yf_itere); \ /* Cette possibilite d'iteration fut introduite le 20081024094410... */ \ Eblock \ ETes \ Eblock \ ERep \ Eblock \ ATes \ Bblock \ PRINT_ATTENTION("l'iteration de coordonnees non normalisees ne peut avoir lieu"); \ Eblock \ ETes \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ ACCES_A_UNE_VALEUR_INTERPOLEE_DANS_UNE_IMAGE(niveau_courant,imageA); \ /* Avant le 20080525105311, il y avait ici : */ \ /* */ \ /* loadF_point_continu(niveau_courant,imageA,Xf,Yf); */ \ /* */ \ /* moins general que la nouvelle solution... */ \ /* */ \ /* Je note le 20081028113002 que tous les appels a 'FFload_point_coordonnees_01(...)' faits */ \ /* ici (dans 'DEFORMATION_INVERSE_BI_ET_TRIDIMENSIONNELLE(...)') vont utiliser les memes */ \ /* valeurs d'arguments implicites ('FFload_point_coordonnees_01_____*') et en particulier */ \ /* la meme matrice 'FFload_point_coordonnees_01_____matrice_de_transformation' si cette */ \ /* derniere est activee. Cela fut corrige par 'v $xiii/di_image$FON 20081029122749', mais */ \ /* de facon partielle et arbitraire... */ \ \ INCR(cumul_du_niveau_courant,niveau_courant); \ INCR(nombre_de_niveaux_cumules,I); \ /* Cumul dans le pave courant de centre {Xc,Yc}. */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ end_imageQ(EDoI,EDoI) \ \ storeF_point(DIVI(cumul_du_niveau_courant,FLOT(nombre_de_niveaux_cumules)) \ ,imageR \ ,X,Y \ ); \ /* Et on met a jour l'image Resultat flottante. */ \ /* */ \ /* On notera que l'on ne teste pas la nullite de 'nombre_de_niveaux_cumules' car, en effet, */ \ /* ce nombre ne peut etre nul puisque les coordonnees {Xc,Yc} sont definies par la procedure */ \ /* 'begin_image' qui garantit donc que les coordonnees {X,Y} sont dans l'image... */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ end_image \ Eblock \ /* Definition des transformations inverses (introduit le 20080901142313)... */ /* Introduit afin d'ameliorer la presentation de la valeur par defaut des matrices de */ /* transformation 'IFdeformation_inverse_bidimensionnelle_____matrice_de_transformation' */ /* et 'IFdeformation_inverse_tridimensionnelle_____matrice_de_transformation'. */ /* */ /* Le 20120520122707, 'FU___' a ete mise dans 'v $xil/defi_K2$vv$DEF 20120520122554'... */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E F O R M A T I O N " I N V E R S E " B I - E T T R I D I M E N S I O N N E L L E */ /* D ' U N E I M A G E " F L O T T A N T E " : */ /* */ /* */ /* Definition des deformations inverses bidimensionnelles : */ /* */ /* Deux images {DX,DY} servent */ /* a acceder a l'image 'A' suivant */ /* le principe suivant : */ /* */ /* */ /* ------------------ ------------------ */ /* |DX | |DY | */ /* | | | | */ /* | | | | */ /* Y |------[X'] . . | Y |------[Y'] . . | */ /* | | . | | | . | */ /* | | . | | | . | */ /* ------------------ ------------------ */ /* X . X . */ /* . . */ /* . . */ /* . . */ /* . . */ /* . . . . . . . . . . */ /* . . */ /* . . */ /* X' . */ /* ------------------ . */ /* |A | . */ /* Y' |--------[N] | Y' < . . . . . */ /* | | | */ /* | | | */ /* | | | */ /* | | | */ /* ------------------ */ /* X' */ /* */ /* */ /* Definition des deformations inverses tridimensionnelles : */ /* */ /* Le principe est le meme que dans le */ /* cas bidimensionnel, sauf que les coordonnees */ /* {X,Y} sont soit les memes que ci-dessus (dans */ /* le cas ou une matrice de transformation n'est */ /* pas utilisee), soit le resultat d'une transformation */ /* du type 'TRANSFORMATION_GEOMETRIQUE_2D_?f(...)' */ /* ('v $xiipf/fonction.2$FON TRANSFORMATION_GEOMETRIQUE_2D_.f.Xf.Yf.') */ /* qui permet de passer d'un triplet {X,Y,Z} a un */ /* doublet {X,Y} (dans le cas ou une matrice de */ /* transformation est utilisee). */ /* */ /* */ /*************************************************************************************************************************************/ #define gACCES_A_UNE_VALEUR_INTERPOLEE_DANS_UNE_IMAGE(valeur,image) \ Bblock \ FFload_point_coordonnees_01_matrice(valeur \ ,image \ ,Xf,Yf \ ,NomDeLaFonctionCourante QD@@__ _____periodiser_X \ ,NomDeLaFonctionCourante QD@@__ _____periodiser_Y \ ,NomDeLaFonctionCourante QD@@__ _____symetriser_X \ ,NomDeLaFonctionCourante QD@@__ _____symetriser_Y \ ,NomDeLaFonctionCourante QD@@__ _____prolonger_X \ ,NomDeLaFonctionCourante QD@@__ _____prolonger_Y \ ,NomDeLaFonctionCourante QD@@__ _____niveau_flottant_hors_image \ ,CONSERVER_LA_MATRICE_DE_FFload_point_coordonnees_01 \ ,FFload_point_coordonnees_01_____appliquer_une_matrice_de_transformation \ ,FFload_point_coordonnees_01_____matrice_de_transformation \ ); \ /* Bien que les deux derniers arguments de 'FFload_point_coordonnees_01_matrice(...)' (soit */ \ /* {appliquer,matrice}) a cause de 'CONSERVER_LA_MATRICE_DE_FFload_point_coordonnees_01' */ \ /* soient inutiles ici, il est necesaire qu'ils aient les bons types ({Logical,matrixF_3D}) */ \ /* a cause de la programmation de cette procedure, d'ou les valeurs qui leur sont donnees. */ \ /* En effet, l'argument 'matrice' est utilise dans un 'TRANSFERT_MATRICE_3D(...)' que */ \ /* l'argument 'ChangerMatrice' soit 'VRAI' ou 'FAUX' (or il est 'FAUX' ici a cause de */ \ /* 'CONSERVER_LA_MATRICE_DE_FFload_point_coordonnees_01'). */ \ Eblock #define ACCES_A_UNE_VALEUR_INTERPOLEE_DANS_UNE_IMAGE_DEFORMATION(valeur,image_deformation) \ Bblock \ BSaveModifyVariable(Logical \ ,FFload_point_coordonnees_01_____appliquer_une_matrice_de_transformation \ ,FAUX \ ); \ /* L'eventuelle matrice de transformation de 'FFload_point_coordonnees_01(...)' ne sera pas */ \ /* utilisee pour les deformations. Cela pour deux raisons : d'une part afin de ne pas faire */ \ /* la meme chose que dans 'ACCES_A_UNE_VALEUR_INTERPOLEE_DANS_UNE_IMAGE(...)' (voir la */ \ /* remarque du 'v $xiii/di_image$FON 20081028113002') et d'autre part les deformations */ \ /* disposent de leur propre matrice de transformation locale bidimensionnelle (en realite */ \ /* tridimensionnelle) '..._____matrice_de_transformation_2D'. Cela fut introduit le */ \ /* 20081029122749... */ \ \ gACCES_A_UNE_VALEUR_INTERPOLEE_DANS_UNE_IMAGE(valeur,image_deformation); \ \ ESaveModifyVariable(Logical \ ,FFload_point_coordonnees_01_____appliquer_une_matrice_de_transformation \ ); \ Eblock /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E F O R M A T I O N " I N V E R S E " B I D I M E N S I O N N E L L E */ /* D ' U N E I M A G E " F L O T T A N T E " : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_bidimensionnelle_____ignorer_un_couple_diX_diY,FAUX))); DEFV(Common,DEFV(genere_Float,SINT(IFdeformation_inverse_bidimensionnelle_____ignorer_cette_valeur_de_diX,FZERO))); DEFV(Common,DEFV(genere_Float,SINT(IFdeformation_inverse_bidimensionnelle_____ignorer_cette_valeur_de_diY,FZERO))); /* Introduits le 20120620115646 pour faciliter l'usage des deformations generees par */ /* 'v $xci/GenDeform.01$K' qui contiennent des zones de deformations non definies... */ DEFV(Common,DEFV(Positive,SINT(IFdeformation_inverse_bidimensionnelle_____demi_taille_X_du_pave,ZERO))); DEFV(Common,DEFV(Positive,SINT(IFdeformation_inverse_bidimensionnelle_____demi_taille_Y_du_pave,ZERO))); /* Introduits le 20090106120525 afin de permettre de prendre en compte le voisinage du */ /* point courant {X,Y} si besoin est... */ DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_bidimensionnelle_____les_coordonnees_X_sont_normalisees,VRAI))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_bidimensionnelle_____les_coordonnees_Y_sont_normalisees,VRAI))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_bidimensionnelle_____les_coordonnees_Z_sont_normalisees,VRAI))); /* Introduits le 20080525101647, puis le 20080901140231 pour ce qui est de 'Z'... */ DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_bidimensionnelle_____iterer_le_calcul_des_coordonnees,FAUX))); DEFV(Common,DEFV(Int,SINT(IFdeformation_inverse_bidimensionnelle_____nombre_d_iterations_du_calcul_des_coordonnees,ZERO))); /* Introduits le 20081024094410 afin de permettre d'iterer le calcul de {Xf,Yf}, mais */ /* uniquement si les 'les_coordonnees_?_sont_normalisees'... */ DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_bidimensionnelle_____appliquer_une_matrice_de_transformation_2D,FAUX))); DEFV(Common,DEFV(matrixF_3D,SINS(IFdeformation_inverse_bidimensionnelle_____matrice_de_transformation_2D ,IstructH103(IstructL03(FU___,FZERO,FZERO) ,IstructL03(FZERO,FU___,FZERO) ,IstructL03(FZERO,FZERO,FU___) ) ) ) ); DEFV(Common,DEFV(Float,SINT(IFdeformation_inverse_bidimensionnelle_____PreAntiTranslation_Xf,NEUT(FDU)))); DEFV(Common,DEFV(Float,SINT(IFdeformation_inverse_bidimensionnelle_____Post___Translation_Xf,NEUT(FDU)))); DEFV(Common,DEFV(Float,SINT(IFdeformation_inverse_bidimensionnelle_____PreAntiTranslation_Yf,NEUT(FDU)))); DEFV(Common,DEFV(Float,SINT(IFdeformation_inverse_bidimensionnelle_____Post___Translation_Yf,NEUT(FDU)))); /* Definition d'une eventuelle matrice de transformation (introduite le 20081028143608), */ /* neutre par defaut. Evidemment, il suffirait qu'elle soit 'matrixF_2D', mais l'utilisation */ /* de 'gTRANSFORMATION_GEOMETRIQUE_3D_Fxyz(...)' necessite de la definir 'matrixF_3D'... */ /* */ /* Cela n'a de sens que si 'IL_FAUT(IFdeformation_inverse_bidimensionnelle_____iterer_...'. */ DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_bidimensionnelle_____periodiser_X,VRAI))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_bidimensionnelle_____periodiser_Y,VRAI))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_bidimensionnelle_____symetriser_X,FAUX))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_bidimensionnelle_____symetriser_Y,FAUX))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_bidimensionnelle_____prolonger_X,FAUX))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_bidimensionnelle_____prolonger_Y,FAUX))); DEFV(Common,DEFV(genere_Float,SINT(IFdeformation_inverse_bidimensionnelle_____niveau_flottant_hors_image,FZERO))); /* Ces parametres introduits le 20080525105311 ont des valeurs par defaut qui sont */ /* compatibles avec 'v $xci/niveau$K FFload_point_coordonnees_01'... */ DEFV(Common,DEFV(FonctionF,POINTERF(IFdeformation_inverse_bidimensionnelle(imageR,imageA,diX,diY)))) /* Fonction introduite le 20080525100158... */ DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[diX[X][Y],diY[X][Y]]. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(imageF,diX)); DEFV(Argument,DEFV(imageF,diY)); /* Definition de la deformation "Inverse" {diX,diY}. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ DEFORMATION_INVERSE_BI_ET_TRIDIMENSIONNELLE(BLOC(Bblock EGAL(FFload_point_coordonnees_01_____Zf,FZmin); /* Introduit le 20080918210535 par prudence... */ Eblock ) ,diX ,diY ); RETIF(imageR); Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E F O R M A T I O N " I N V E R S E " T R I D I M E N S I O N N E L L E */ /* D ' U N E I M A G E " F L O T T A N T E " : */ /* */ /*************************************************************************************************************************************/ BFonctionF #define IFdeformation_inverse_____les_coordonnees_Z_sont_normalisees \ IFdeformation_inverse_tridimensionnelle_____les_coordonnees_Z_sont_normalisees \ /* Afin de raccourcir une ligne qui suit... */ DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_tridimensionnelle_____ignorer_un_couple_diX_diY,FAUX))); DEFV(Common,DEFV(genere_Float,SINT(IFdeformation_inverse_tridimensionnelle_____ignorer_cette_valeur_de_diX,FZERO))); DEFV(Common,DEFV(genere_Float,SINT(IFdeformation_inverse_tridimensionnelle_____ignorer_cette_valeur_de_diY,FZERO))); /* Introduits le 20120620115646 pour faciliter l'usage des deformations generees par */ /* 'v $xci/GenDeform.01$K' qui contiennent des zones de deformations non definies... */ DEFV(Common,DEFV(Positive,SINT(IFdeformation_inverse_tridimensionnelle_____demi_taille_X_du_pave,ZERO))); DEFV(Common,DEFV(Positive,SINT(IFdeformation_inverse_tridimensionnelle_____demi_taille_Y_du_pave,ZERO))); /* Introduits le 20090106120525 afin de permettre de prendre en compte le voisinage du */ /* point courant {X,Y} si besoin est... */ DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_tridimensionnelle_____les_coordonnees_X_sont_normalisees,VRAI))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_tridimensionnelle_____les_coordonnees_Y_sont_normalisees,VRAI))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_tridimensionnelle_____les_coordonnees_Z_sont_normalisees,VRAI))); /* Introduits le 20080525101647, puis le 20080901140231 pour ce qui est de 'Z'... */ DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_tridimensionnelle_____iterer_le_calcul_des_coordonnees,FAUX))); DEFV(Common,DEFV(Int,SINT(IFdeformation_inverse_tridimensionnelle_____nombre_d_iterations_du_calcul_des_coordonnees,ZERO))); /* Introduits le 20081024094410 afin de permettre d'iterer le calcul de {Xf,Yf}, mais */ /* uniquement si les 'les_coordonnees_?_sont_normalisees'... */ DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_tridimensionnelle_____appliquer_une_matrice_de_transformation_2D,FAUX))); DEFV(Common,DEFV(matrixF_3D,SINS(IFdeformation_inverse_tridimensionnelle_____matrice_de_transformation_2D ,IstructH103(IstructL03(FU___,FZERO,FZERO) ,IstructL03(FZERO,FU___,FZERO) ,IstructL03(FZERO,FZERO,FU___) ) ) ) ); DEFV(Common,DEFV(Float,SINT(IFdeformation_inverse_tridimensionnelle_____PreAntiTranslation_Xf,NEUT(FDU)))); DEFV(Common,DEFV(Float,SINT(IFdeformation_inverse_tridimensionnelle_____Post___Translation_Xf,NEUT(FDU)))); DEFV(Common,DEFV(Float,SINT(IFdeformation_inverse_tridimensionnelle_____PreAntiTranslation_Yf,NEUT(FDU)))); DEFV(Common,DEFV(Float,SINT(IFdeformation_inverse_tridimensionnelle_____Post___Translation_Yf,NEUT(FDU)))); /* Definition d'une eventuelle matrice de transformation (introduite le 20081028143608), */ /* neutre par defaut. Evidemment, il suffirait qu'elle soit 'matrixF_2D', mais l'utilisation */ /* de 'gTRANSFORMATION_GEOMETRIQUE_3D_Fxyz(...)' necessite de la definir 'matrixF_3D'... */ /* */ /* Cela n'a de sens que si 'IL_FAUT(IFdeformation_inverse_tridimensionnelle_____iterer_...'. */ DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_tridimensionnelle_____periodiser_X,VRAI))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_tridimensionnelle_____periodiser_Y,VRAI))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_tridimensionnelle_____symetriser_X,FAUX))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_tridimensionnelle_____symetriser_Y,FAUX))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_tridimensionnelle_____prolonger_X,FAUX))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_tridimensionnelle_____prolonger_Y,FAUX))); DEFV(Common,DEFV(genere_Float,SINT(IFdeformation_inverse_tridimensionnelle_____niveau_flottant_hors_image,FZERO))); /* Ces parametres introduits le 20080525105311 ont des valeurs par defaut qui sont */ /* compatibles avec 'v $xci/niveau$K FFload_point_coordonnees_01'... */ DEFV(Common,DEFV(FonctionF,POINTERF(IFdeformation_inverse_tridimensionnelle(imageR,imageA,diX,diY,diZ)))) /* Fonction introduite le 20080525100158... */ DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[diX[X][Y],diY[X][Y]]. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(imageF,diX)); DEFV(Argument,DEFV(imageF,diY)); /* Definition de la deformation "Inverse" {diX,diY}. */ DEFV(Argument,DEFV(imageF,diZ)); /* L'image de deformation en 'Z' a ete introduite le 20080901140231 et n'a en fait de sens */ /* que si l'indicateur 'v $xiipf/fonction.2$FON FFload_point_coordonnees_01_____applique...' */ /* est 'VRAI'... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ DEFORMATION_INVERSE_BI_ET_TRIDIMENSIONNELLE(BLOC(Bblock EGAL(FFload_point_coordonnees_01_____Zf ,OPC1(EST_VRAI(IFdeformation_inverse_____les_coordonnees_Z_sont_normalisees) ,NEUT ,_____cNORMALISE_OZ ,loadF_point(diZ,X,Y) ) ); /* Introduit le 20080901140231, en notant que cette coordonnee 'Zf' n'a d'utilite que si */ /* l'indicateur 'v $xiipf/fonction.2$FON FFload_point_coordonnees_01_____applique...' est */ /* 'VRAI'... */ Eblock ) ,diX ,diY ); RETIF(imageR); Eblock #undef IFdeformation_inverse_____les_coordonnees_Z_sont_normalisees EFonctionF #undef ACCES_A_UNE_VALEUR_INTERPOLEE_DANS_UNE_IMAGE_DEFORMATION #undef gACCES_A_UNE_VALEUR_INTERPOLEE_DANS_UNE_IMAGE /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E F O R M A T I O N " I N V E R S E " B I - E T T R I D I M E N S I O N N E L L E I N D I R E C T E */ /* D ' U N E I M A G E " F L O T T A N T E " : */ /* */ /* */ /* Definition des deformations inverses bidimensionnelles indirectes : */ /* */ /* Deux images {DX,DY} servent */ /* a acceder a deux images {IX,IY} */ /* qui elles-memes servent a acceder */ /* a l'image 'A' suivant le principe */ /* suivant : */ /* */ /* */ /* ------------------ ------------------ */ /* |DX | |DY | */ /* | | | | */ /* | | | | */ /* Y |------[X'] . . | Y |------[Y'] . . . .|. . . */ /* | | . | | | | . */ /* | | . | | | | . */ /* ------------------ ------------------ . */ /* X . X . */ /* . . */ /* . . . . . . . . . . . . . . . . . . . . . . */ /* . . . */ /* . . . */ /* X' X' . */ /* ------------------ ------------------ . */ /* |IX | |IY | . */ /* Y'|-----------[X''] .|. . Y'|-----------[Y''] |< . . */ /* | | | . | . | */ /* | | | . | . | */ /* | | | . | . | */ /* | | | . | . | */ /* ------------------ . ------------------ */ /* X' . X' */ /* . . */ /* . . */ /* . . */ /* . . */ /* . . . . . . */ /* . . */ /* X'' . */ /* ------------------ . */ /* |A . | . */ /* Y''|--------[N] | Y''< . . . . . */ /* | | | */ /* | | | */ /* | | | */ /* | | | */ /* ------------------ */ /* X'' */ /* */ /* */ /* Definition des deformations inverses tridimensionnelles indirectes : */ /* */ /* Le principe est le meme que dans le */ /* cas bidimensionnel, sauf que les coordonnees */ /* {X,Y} sont soit les memes que ci-dessus (dans */ /* le cas ou une matrice de transformation n'est */ /* pas utilisee), soit le resultat d'une transformation */ /* du type 'TRANSFORMATION_GEOMETRIQUE_2D_?f(...)' */ /* ('v $xiipf/fonction.2$FON TRANSFORMATION_GEOMETRIQUE_2D_.f.Xf.Yf.') */ /* qui permet de passer d'un triplet {X,Y,Z} a un */ /* doublet {X,Y} (dans le cas ou une matrice de */ /* transformation est utilisee). */ /* */ /* */ /*************************************************************************************************************************************/ #define FFload_point_coordonnees_01_indirectes_____appliquer_une_matrice \ FFload_point_coordonnees_01_indirectes_____appliquer_une_matrice_de_transformation_ #define FFload_point_coordonnees_01_indirectes_____matrice \ FFload_point_coordonnees_01_indirectes_____matrice_de_transformation_ /* Afin de raccourcir une ligne qui suit... */ #define gACCES_A_UNE_VALEUR_INTERPOLEE_DANS_UNE_IMAGE(valeur,image) \ Bblock \ FFload_point_coordonnees_01_indirectes_matrice(valeur \ ,image \ ,Xf,Yf \ ,imageIX,imageIY \ ,NomDeLaFonctionCourante QD@@__ _____periodiser_X \ ,NomDeLaFonctionCourante QD@@__ _____periodiser_Y \ ,NomDeLaFonctionCourante QD@@__ _____symetriser_X \ ,NomDeLaFonctionCourante QD@@__ _____symetriser_Y \ ,NomDeLaFonctionCourante QD@@__ _____prolonger_X \ ,NomDeLaFonctionCourante QD@@__ _____prolonger_Y \ ,NomDeLaFonctionCourante QD@@__ _____niveau_flottant_hors_image \ ,CONSERVER_LA_MATRICE_DE_FFload_point_coordonnees_01_indirectes \ ,FFload_point_coordonnees_01_indirectes_____appliquer_une_matrice \ ,FFload_point_coordonnees_01_indirectes_____matrice \ ); \ /* Bien que les deux derniers arguments de 'FFload_point_coordonnees_01_matrice(...)' (soit */ \ /* {appliquer,matrice}) a cause de 'CONSERVER_LA_MATRICE_DE_FFload_point_coordonnees_01_...' */ \ /* soient inutiles ici, il est necesaire qu'ils aient les bons types ({Logical,matrixF_3D}) */ \ /* a cause de la programmation de cette procedure, d'ou les valeurs qui leur sont donnees. */ \ /* En effet, l'argument 'matrice' est utilise dans un 'TRANSFERT_MATRICE_3D(...)' que */ \ /* l'argument 'ChangerMatrice' soit 'VRAI' ou 'FAUX' (or il est 'FAUX' ici a cause de */ \ /* 'CONSERVER_LA_MATRICE_DE_FFload_point_coordonnees_01_indirectes'). */ \ /* */ \ /* On notera le 20090510115427 que {imageIX,imageIY} pourraient etre remplaces par {diX,diY} */ \ /* afin de permuter leur role et qu'ainsi {IX,IY} (soit {imageIX,imageIY}) soient utilises */ \ /* avant {DX,DY} (soit {diX,diY}) dans le schema precedent. Mais attention, cela ne serait */ \ /* pas tres coherent a cause de l'usage qui est fait de 'diZ' dans le cas de la definition */ \ /* de 'IFdeformation_inverse_indirecte_tridimensionnelle(...)'. */ \ Eblock #define ACCES_A_UNE_VALEUR_INTERPOLEE_DANS_UNE_IMAGE_DEFORMATION(valeur,image_deformation) \ Bblock \ BSaveModifyVariable(Logical \ ,FFload_point_coordonnees_01_indirectes_____appliquer_une_matrice_de_transformation_ \ ,FAUX \ ); \ /* L'eventuelle matrice de transformation de 'FFload_point_coordonnees_01_indirectes(...)' */ \ /* sera pas utilisee pour les deformations. Cela pour deux raisons : d'une part afin de ne */ \ /* pas faire la meme chose que dans 'ACCES_A_UNE_VALEUR_INTERPOLEE_DANS_UNE_IMAGE(...)' */ \ /* (voir la remarque du 'v $xiii/di_image$FON 20081028113002') et d'autre part les */ \ /* deformations disposent de leur propre matrice de transformation locale bidimensionnelle */ \ /* (en realite tridimensionnelle) '..._____matrice_de_transformation_2D'. */ \ \ gACCES_A_UNE_VALEUR_INTERPOLEE_DANS_UNE_IMAGE(valeur,image_deformation); \ \ ESaveModifyVariable(Logical \ ,FFload_point_coordonnees_01_indirectes_____appliquer_une_matrice_de_transformation_ \ ); \ Eblock /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E F O R M A T I O N " I N V E R S E " B I D I M E N S I O N N E L L E I N D I R E C T E */ /* D ' U N E I M A G E " F L O T T A N T E " : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_indirecte_bidimensionnelle_____ignorer_un_couple_diX_diY,FAUX))); DEFV(Common,DEFV(genere_Float,SINT(IFdeformation_inverse_indirecte_bidimensionnelle_____ignorer_cette_valeur_de_diX,FZERO))); DEFV(Common,DEFV(genere_Float,SINT(IFdeformation_inverse_indirecte_bidimensionnelle_____ignorer_cette_valeur_de_diY,FZERO))); /* Introduits le 20120620115646 pour faciliter l'usage des deformations generees par */ /* 'v $xci/GenDeform.01$K' qui contiennent des zones de deformations non definies... */ DEFV(Common,DEFV(Positive,SINT(IFdeformation_inverse_indirecte_bidimensionnelle_____demi_taille_X_du_pave,ZERO))); DEFV(Common,DEFV(Positive,SINT(IFdeformation_inverse_indirecte_bidimensionnelle_____demi_taille_Y_du_pave,ZERO))); /* Definition du voisinage du point courant {X,Y} si besoin est... */ DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_indirecte_bidimensionnelle_____les_coordonnees_X_sont_normalisees,VRAI))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_indirecte_bidimensionnelle_____les_coordonnees_Y_sont_normalisees,VRAI))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_indirecte_bidimensionnelle_____les_coordonnees_Z_sont_normalisees,VRAI))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_indirecte_bidimensionnelle_____iterer_le_calcul_des_coordonnees,FAUX))); DEFV(Common,DEFV(Int,SINT(IFdeformation_inverse_indirecte_bidimensionnelle_____nombre_d_iterations_du_calcul_des_coordonnees,ZERO))); /* Afin de permettre d'iterer le calcul de {Xf,Yf}, mais uniquement dans le cas ou les */ /* 'les_coordonnees_?_sont_normalisees'... */ DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_indirecte_bidimensionnelle_____appliquer_une_matrice_de_transformation_2D,FAUX))); DEFV(Common,DEFV(matrixF_3D,SINS(IFdeformation_inverse_indirecte_bidimensionnelle_____matrice_de_transformation_2D ,IstructH103(IstructL03(FU___,FZERO,FZERO) ,IstructL03(FZERO,FU___,FZERO) ,IstructL03(FZERO,FZERO,FU___) ) ) ) ); DEFV(Common,DEFV(Float,SINT(IFdeformation_inverse_indirecte_bidimensionnelle_____PreAntiTranslation_Xf,NEUT(FDU)))); DEFV(Common,DEFV(Float,SINT(IFdeformation_inverse_indirecte_bidimensionnelle_____Post___Translation_Xf,NEUT(FDU)))); DEFV(Common,DEFV(Float,SINT(IFdeformation_inverse_indirecte_bidimensionnelle_____PreAntiTranslation_Yf,NEUT(FDU)))); DEFV(Common,DEFV(Float,SINT(IFdeformation_inverse_indirecte_bidimensionnelle_____Post___Translation_Yf,NEUT(FDU)))); /* Definition d'une eventuelle matrice de transformationneutre par defaut. Evidemment, il */ /* suffirait qu'elle soit 'matrixF_2D', mais il faut la definir 'matrixF_3D' a cause de */ /* l'utilisation de 'gTRANSFORMATION_GEOMETRIQUE_3D_Fxyz(...)'... */ /* */ /* N'a de sens que si 'IL_FAUT(IFdeformation_inverse_indirecte_bidimensionnelle_____it...'. */ DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_indirecte_bidimensionnelle_____periodiser_X,VRAI))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_indirecte_bidimensionnelle_____periodiser_Y,VRAI))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_indirecte_bidimensionnelle_____symetriser_X,FAUX))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_indirecte_bidimensionnelle_____symetriser_Y,FAUX))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_indirecte_bidimensionnelle_____prolonger_X,FAUX))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_indirecte_bidimensionnelle_____prolonger_Y,FAUX))); DEFV(Common,DEFV(genere_Float,SINT(IFdeformation_inverse_indirecte_bidimensionnelle_____niveau_flottant_hors_image,FZERO))); /* Ces parametres ont des valeurs par defaut qui sont compatibles avec */ /* 'v $xci/niveau$K FFload_point_coordonnees_01'... */ DEFV(Common,DEFV(FonctionF,POINTERF(IFdeformation_inverse_indirecte_bidimensionnelle(imageR,imageA,diX,diY,imageIX,imageIY)))) /* Fonction introduite le 20090508123214... */ DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[diX[X][Y],diY[X][Y]]. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(imageF,diX)); DEFV(Argument,DEFV(imageF,diY)); /* Definition de la deformation "Inverse" {diX,diY}. */ DEFV(Argument,DEFV(imageF,imageIX)); DEFV(Argument,DEFV(imageF,imageIY)); /* Definition des indirections {imageIX,imageIY}. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ DEFORMATION_INVERSE_BI_ET_TRIDIMENSIONNELLE(BLOC(Bblock EGAL(FFload_point_coordonnees_01_indirectes_____Zf_,FZmin); /* Par prudence... */ Eblock ) ,diX ,diY ); /* On notera le 20090510110536 que la commande : */ /* */ /* $xci/deformii.01$X \ */ /* IX=INDIRECTION$COORD_X \ */ /* IY=INDIRECTION$COORD_Y \ */ /* DX=DEFORMATION$COORD_X \ */ /* DY=DEFORMATION$COORD_Y \ */ /* A=ARGUMENT \ */ /* R=RESULTAT \ */ /* $formatI */ /* */ /* est a priori equivalente a : */ /* */ /* $xci/deformi.01$X \ */ /* DX=DEFORMATION$COORD_X \ */ /* DY=DEFORMATION$COORD_Y \ */ /* A=INDIRECTION$COORD_X \ */ /* R=DEFORMATION_INDIRECTE$COORD_X \ */ /* $formatI */ /* */ /* $xci/deformi.01$X \ */ /* DX=DEFORMATION$COORD_X \ */ /* DY=DEFORMATION$COORD_Y \ */ /* A=INDIRECTION$COORD_Y \ */ /* R=DEFORMATION_INDIRECTE$COORD_Y \ */ /* $formatI */ /* */ /* $xci/deformi.01$X \ */ /* DX=DEFORMATION_INDIRECTE$COORD_X \ */ /* DY=DEFORMATION_INDIRECTE$COORD_Y \ */ /* A=ARGUMENT \ */ /* R=RESULTAT \ */ /* $formatI */ /* */ /* mais est donc d'un usage plus simple. */ /* */ /* ATTENTION, on remarquera que, par defaut, le parametre "bilineaire=" est 'FAUX' pour */ /* '$xci/deformi.01$K' alors qu'il est 'VRAI' pour '$xci/deformi.01$K'. */ /* */ /* On notera le 20090510115427 que {diX,diY} pourraient etre remplaces par {imageIX,imageIY} */ /* afin de permuter leur role et qu'ainsi {IX,IY} (soit {imageIX,imageIY}) soient utilises */ /* avant {DX,DY} (soit {diX,diY}) dans le schema precedent. Mais attention, cela ne serait */ /* pas tres coherent a cause de l'usage qui est fait de 'diZ' dans le cas de la definition */ /* de 'IFdeformation_inverse_indirecte_tridimensionnelle(...)'. */ RETIF(imageR); Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E F O R M A T I O N " I N V E R S E " T R I D I M E N S I O N N E L L E I N D I R E C T E */ /* D ' U N E I M A G E " F L O T T A N T E " : */ /* */ /*************************************************************************************************************************************/ BFonctionF #define IFdeformation_inverse_____les_coordonnees_Z_sont_normalisees \ IFdeformation_inverse_indirecte_tridimensionnelle_____les_coordonnees_Z_sont_normalisees \ /* Afin de raccourcir une ligne qui suit... */ DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_indirecte_tridimensionnelle_____ignorer_un_couple_diX_diY,FAUX))); DEFV(Common,DEFV(genere_Float,SINT(IFdeformation_inverse_indirecte_tridimensionnelle_____ignorer_cette_valeur_de_diX,FZERO))); DEFV(Common,DEFV(genere_Float,SINT(IFdeformation_inverse_indirecte_tridimensionnelle_____ignorer_cette_valeur_de_diY,FZERO))); /* Introduits le 20120620115646 pour faciliter l'usage des deformations generees par */ /* 'v $xci/GenDeform.01$K' qui contiennent des zones de deformations non definies... */ DEFV(Common,DEFV(Positive,SINT(IFdeformation_inverse_indirecte_tridimensionnelle_____demi_taille_X_du_pave,ZERO))); DEFV(Common,DEFV(Positive,SINT(IFdeformation_inverse_indirecte_tridimensionnelle_____demi_taille_Y_du_pave,ZERO))); /* Definition du voisinage du point courant {X,Y} si besoin est... */ DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_indirecte_tridimensionnelle_____les_coordonnees_X_sont_normalisees,VRAI))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_indirecte_tridimensionnelle_____les_coordonnees_Y_sont_normalisees,VRAI))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_indirecte_tridimensionnelle_____les_coordonnees_Z_sont_normalisees,VRAI))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_indirecte_tridimensionnelle_____iterer_le_calcul_des_coordonnees,FAUX))); DEFV(Common,DEFV(Int,SINT(IFdeformation_inverse_indirecte_tridimensionnelle_____nombre_d_iterations_du_calcul_des_coordonnees,ZERO))); /* Afin de permettre d'iterer le calcul de {Xf,Yf}, mais uniquement dans le cas ou les */ /* 'les_coordonnees_?_sont_normalisees'... */ DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_indirecte_tridimensionnelle_____appliquer_une_matrice_de_transformation_2D,FAUX))); DEFV(Common,DEFV(matrixF_3D,SINS(IFdeformation_inverse_indirecte_tridimensionnelle_____matrice_de_transformation_2D ,IstructH103(IstructL03(FU___,FZERO,FZERO) ,IstructL03(FZERO,FU___,FZERO) ,IstructL03(FZERO,FZERO,FU___) ) ) ) ); DEFV(Common,DEFV(Float,SINT(IFdeformation_inverse_indirecte_tridimensionnelle_____PreAntiTranslation_Xf,NEUT(FDU)))); DEFV(Common,DEFV(Float,SINT(IFdeformation_inverse_indirecte_tridimensionnelle_____Post___Translation_Xf,NEUT(FDU)))); DEFV(Common,DEFV(Float,SINT(IFdeformation_inverse_indirecte_tridimensionnelle_____PreAntiTranslation_Yf,NEUT(FDU)))); DEFV(Common,DEFV(Float,SINT(IFdeformation_inverse_indirecte_tridimensionnelle_____Post___Translation_Yf,NEUT(FDU)))); /* Definition d'une eventuelle matrice de transformationneutre par defaut. Evidemment, il */ /* suffirait qu'elle soit 'matrixF_2D', mais il faut la definir 'matrixF_3D' a cause de */ /* l'utilisation de 'gTRANSFORMATION_GEOMETRIQUE_3D_Fxyz(...)'... */ /* */ /* */ /* N'a de sens que si 'IL_FAUT(IFdeformation_inverse_indirecte_tridimensionnelle_____it...'. */ DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_indirecte_tridimensionnelle_____periodiser_X,VRAI))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_indirecte_tridimensionnelle_____periodiser_Y,VRAI))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_indirecte_tridimensionnelle_____symetriser_X,FAUX))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_indirecte_tridimensionnelle_____symetriser_Y,FAUX))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_indirecte_tridimensionnelle_____prolonger_X,FAUX))); DEFV(Common,DEFV(Logical,SINT(IFdeformation_inverse_indirecte_tridimensionnelle_____prolonger_Y,FAUX))); DEFV(Common,DEFV(genere_Float,SINT(IFdeformation_inverse_indirecte_tridimensionnelle_____niveau_flottant_hors_image,FZERO))); /* Ces parametres ont des valeurs par defaut qui sont compatibles avec */ /* 'v $xci/niveau$K FFload_point_coordonnees_01'... */ DEFV(Common,DEFV(FonctionF,POINTERF(IFdeformation_inverse_indirecte_tridimensionnelle(imageR,imageA,diX,diY,diZ,imageIX,imageIY)))) /* Fonction introduite le AAAAMMJJhhmmss... */ DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[diX[X][Y],diY[X][Y]]. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(imageF,diX)); DEFV(Argument,DEFV(imageF,diY)); /* Definition de la deformation "Inverse" {diX,diY}. */ DEFV(Argument,DEFV(imageF,diZ)); /* L'image de deformation en 'Z' n'a en fait de sens */ /* que si 'v $xiipf/fonction.2$FON FFload_point_coordonnees_01_indirectes_____applique...' */ /* est 'VRAI'... */ DEFV(Argument,DEFV(imageF,imageIX)); DEFV(Argument,DEFV(imageF,imageIY)); /* Definition des indirections {imageIX,imageIY}. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ DEFORMATION_INVERSE_BI_ET_TRIDIMENSIONNELLE(BLOC(Bblock EGAL(FFload_point_coordonnees_01_indirectes_____Zf_ ,OPC1(EST_VRAI(IFdeformation_inverse_____les_coordonnees_Z_sont_normalisees) ,NEUT ,_____cNORMALISE_OZ ,loadF_point(diZ,X,Y) ) ); /* On notera que cette coordonnee 'Zf' n'a d'utilite que si l'indicateur */ /* 'v $xiipf/fonction.2$FON FFload_point_coordonnees_01_indirectes_____appl...' */ /* est 'VRAI'... */ Eblock ) ,diX ,diY ); /* On notera le 20090510115427 que {diX,diY} pourraient etre remplaces par {imageIX,imageIY} */ /* afin de permuter leur role et qu'ainsi {IX,IY} (soit {imageIX,imageIY}) soient utilises */ /* avant {DX,DY} (soit {diX,diY}) dans le schema precedent. Mais attention, cela ne serait */ /* pas tres coherent a cause de l'usage de 'diZ' ci-dessus... */ RETIF(imageR); Eblock #undef IFdeformation_inverse_____les_coordonnees_Z_sont_normalisees EFonctionF #undef ACCES_A_UNE_VALEUR_INTERPOLEE_DANS_UNE_IMAGE_DEFORMATION #undef gACCES_A_UNE_VALEUR_INTERPOLEE_DANS_UNE_IMAGE #undef FFload_point_coordonnees_01_indirectes_____matrice #undef FFload_point_coordonnees_01_indirectes_____appliquer_une_matrice #undef TRANSFORMATION_GEOMETRIQUE_2D_Yf #undef TRANSFORMATION_GEOMETRIQUE_2D_Xf #undef DEFORMATION_INVERSE_BI_ET_TRIDIMENSIONNELLE #undef matrice_transformation_2D #undef nombre_iterations_calcul_des_coordonnees #undef coordonnees_Y_sont_normalisees #undef coordonnees_X_sont_normalisees #undef Yc #undef Xc #undef ACCES_A_UNE_VALEUR_INTERPOLEE_DANS_UNE_IMAGE _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D I F F U S I O N B I D I M E N S I O N N E L L E A T E M P E R A T U R E L O C A L E : */ /* */ /*************************************************************************************************************************************/ BFonctionP #define ACCES_A_UN_POINT_DU_VOISINAGE(niveau,x,y) \ Bblock \ EGAL(niveau \ ,Fload_point(imageR \ ,x,y \ ,Idiffusion_2D_a_temperatures_locales_____periodiser_X \ ,Idiffusion_2D_a_temperatures_locales_____periodiser_Y \ ,Idiffusion_2D_a_temperatures_locales_____symetriser_X \ ,Idiffusion_2D_a_temperatures_locales_____symetriser_Y \ ,Idiffusion_2D_a_temperatures_locales_____prolonger_X \ ,Idiffusion_2D_a_temperatures_locales_____prolonger_Y \ ,Idiffusion_2D_a_temperatures_locales_____niveau_hors_image \ ) \ ); \ Eblock \ /* Niveau courant du voisinage du point courant {X,Y}. */ DEFV(Common,DEFV(Logical,SINT(Idiffusion_2D_a_temperatures_locales_____periodiser_X,VRAI))); DEFV(Common,DEFV(Logical,SINT(Idiffusion_2D_a_temperatures_locales_____periodiser_Y,VRAI))); /* Options par defaut de periodisation des axes. Le 20070210084129 la valeur par defaut */ /* est passee de 'FAUX' a 'VRAI' de facon donc que par defaut il n'y ait pas de "fuites" */ /* de particules au bord... */ DEFV(Common,DEFV(Logical,SINT(Idiffusion_2D_a_temperatures_locales_____symetriser_X,FAUX))); DEFV(Common,DEFV(Logical,SINT(Idiffusion_2D_a_temperatures_locales_____symetriser_Y,FAUX))); /* Options par defaut de symetrisation des axes. */ DEFV(Common,DEFV(Logical,SINT(Idiffusion_2D_a_temperatures_locales_____prolonger_X,FAUX))); DEFV(Common,DEFV(Logical,SINT(Idiffusion_2D_a_temperatures_locales_____prolonger_Y,FAUX))); /* Options par defaut de prolongement des axes. */ DEFV(Common,DEFV(genere_p,SINT(Idiffusion_2D_a_temperatures_locales_____niveau_hors_image ,Idiffusion_2D_a_temperatures_locales_____NIVEAU_DE_LA___MER ) ) ); /* Options par defaut du niveau "hors-image". */ #define Idiffusion_2D_a_temperatures_locales_____PasX \ MUL2(Idiffusion_2D_a_temperatures_locales_____nombre_de_pasX,pasX) #define Idiffusion_2D_a_temperatures_locales_____PasY \ MUL2(Idiffusion_2D_a_temperatures_locales_____nombre_de_pasY,pasY) DEFV(Common,DEFV(Int,SINT(Idiffusion_2D_a_temperatures_locales_____nombre_de_pasX,UN))); DEFV(Common,DEFV(Int,SINT(Idiffusion_2D_a_temperatures_locales_____nombre_de_pasY,UN))); /* Definition des pas du reseau {X,Y} (introduit le 20070313154647). On notera que pour */ /* cela soit utile, il faut que la Source de particules ait au moins des dimensions egales */ /* a 'NpasX.NpasY'... */ DEFV(Common,DEFV(Logical,SINT(Idiffusion_2D_a_temperatures_locales_____shuffler_les_coordonnees,VRAI))); DEFV(Common,DEFV(Int,SINT(Idiffusion_2D_a_temperatures_locales_____graine_de_shuffling_de_X,ONZE))); DEFV(Common,DEFV(Int,SINT(Idiffusion_2D_a_temperatures_locales_____graine_de_shuffling_de_Y,TREIZE))); /* Le 20070210085430 fut introduit la possibilite de "shuffler" les coordonnees {X,Y}. */ /* Ceci est destine a eliminer un effet d'anisotropie certainement du au balayage du champ */ /* avec {begin_image,end_image}. La consequence visible est, par exemple dans le cas d'une */ /* source faite d'une ligne horizontale au milieu de l'image d'avoir plus de particules */ /* au-dessus de la ligne qu'au dessous... */ /* */ /* Le 20070211095739 la valeur par defaut est passe de 'FAUX' a 'VRAI' car, en effet, le */ /* "shuffling" resout effectivement ce probleme... */ DEFV(Common,DEFV(genere_p,SINT(Idiffusion_2D_a_temperatures_locales_____niveau_de_la___mer ,Idiffusion_2D_a_temperatures_locales_____NIVEAU_DE_LA___MER ) ) ); DEFV(Common,DEFV(genere_p,SINT(Idiffusion_2D_a_temperatures_locales_____niveau_de_la___mer_nouvelle_nee ,Idiffusion_2D_a_temperatures_locales_____NIVEAU_DE_LA___MER_NOUVELLE_NEE ) ) ); DEFV(Common,DEFV(genere_p,SINT(Idiffusion_2D_a_temperatures_locales_____niveau_de_la_terre_nouvelle_nee ,Idiffusion_2D_a_temperatures_locales_____NIVEAU_DE_LA_TERRE_NOUVELLE_NEE ) ) ); DEFV(Common,DEFV(genere_p,SINT(Idiffusion_2D_a_temperatures_locales_____niveau_de_la_terre ,Idiffusion_2D_a_temperatures_locales_____NIVEAU_DE_LA_TERRE ) ) ); /* Definition des niveaux associes a la mer et a la terre. */ DEFV(Common,DEFV(genere_p,SINT(Idiffusion_2D_a_temperatures_locales_____marqueur_des_cases_de_la___mer ,Idiffusion_2D_a_temperatures_locales_____MARQUEUR_DES_CASES_DE_LA___MER ) ) ); /* Definition du niveau de marquage des cases de la mer (introduit le 20070308092338). */ DEFV(Common,DEFV(Logical,SINT(Idiffusion_2D_a_temperatures_locales_____reinjecter_la_Source_a_chaque_iteration,VRAI))); /* Indicateur introduit le 20070212115602 dont la valeur par defaut garantit la */ /* compatibilite anterieure. On notera donc les deux fonctionnements possibles : */ /* */ /* VRAI : concentration constante (de la Source), le nombre de */ /* particules augmentant au cours du temps, */ /* FAUX : nombre de particulues constant au cours du temps (et egal */ /* au nombre de particules de la Source). */ /* */ DEFV(Local,DEFV(Positive,INIT(Idiffusion_2D_a_temperatures_locales_____compteur_de_passage,ZERO))); /* A priori ce dispositif avait ete introduit afin de pouvoir faire varier la graine */ /* effective dans 'GENERATION_D_UN_NOMBRE_ALEATOIRE_DE_DIFFUSION_2D(...)' de facon */ /* a ce qu'il ne redonne pas la meme 'valeur_aleatoire'. */ #define GENERATION_D_UN_NOMBRE_ALEATOIRE_DE_DIFFUSION_2D(valeur_aleatoire,type,borne_inferieure,borne_superieure,graine_courante) \ Bblock \ DEFV(pointI_2D,point_courant_de_l_espace_de_parametrage); \ INITIALISATION_POINT_2D(point_courant_de_l_espace_de_parametrage,X,Y); \ /* Point courant de l'espace de parametrage. */ \ \ EGAL(valeur_aleatoire \ ,type(rdnI2D(ADRESSE(point_courant_de_l_espace_de_parametrage) \ ,ADD2(graine_courante,Idiffusion_2D_a_temperatures_locales_____compteur_de_passage) \ ,RDN_INIT_AND_GENERE \ ,FLOT(borne_inferieure),FLOT(borne_superieure) \ ) \ ) \ ); \ /* Generation d'une valeur aleatoire dans [borne_inferieure,borne_superieure] et parametree */ \ /* par le point courant de l'espace de parametrage. On notera que les 'FLOT(...)' relatifs */ \ /* a 'borne_inferieure' et 'borne_superieure' sont essentiels car, en effet, on ne connait */ \ /* pas a priori leur type (aussi bien 'Float' que 'Int'...). */ \ Eblock \ /* Generation d'une valeur aleatoire. */ DEFV(Common,DEFV(Float,SINT(Idiffusion_2D_a_temperatures_locales_____frequence_de_la_diffusion,FU))); /* Frequence "omega" de la reaction. */ DEFV(Common,DEFV(Float,SINT(Idiffusion_2D_a_temperatures_locales_____energie_minimale,FZERO))); DEFV(Common,DEFV(Float,SINT(Idiffusion_2D_a_temperatures_locales_____energie_maximale,FU))); DEFV(Common,DEFV(Float,SINT(Idiffusion_2D_a_temperatures_locales_____lambda,COORDONNEE_BARYCENTRIQUE_CENTRALE))); /* Extrema de l'energie. */ DEFV(Common,DEFV(Float,SINT(Idiffusion_2D_a_temperatures_locales_____constante_de_Boltzmann,CONSTANTE_DE_BOLTZMANN))); /* Constante de Boltzmann (J*K^(-1)). Une valeur de 1 simplifiera les utilisations */ /* des divers parametres (la temperature du modele en particulier). */ #define TEMPERATURE_LOCALE(x,y) \ loadF_point(temperature_locale,x,y) \ /* Acces a la temperature au point {X,Y}. */ #define TAUX_DE_DIFFUSION_2D(frequence,energie_minimale,energie_maximale,lambda,Boltzmann,temperature) \ TAUX_D_ETCHE______COTES_ND(FU,frequence,energie_minimale,energie_maximale,lambda,Boltzmann,temperature) \ /* Definition du taux de diffusion. On notera que le minimum de cette fonction est atteint */ \ /* pour : */ \ /* */ \ /* lambda = COORDONNEE_BARYCENTRIQUE_MAXIMALE ==> taux faible de diffusion, ce qui */ \ /* demande une energie d'activation */ \ /* 'energie_maximale', */ \ /* */ \ /* et le maximum pour : */ \ /* */ \ /* lambda = COORDONNEE_BARYCENTRIQUE_MINIMALE ==> taux eleve de diffusion, ce qui */ \ /* demande une energie d'activation */ \ /* 'energie_minimale', */ \ /* */ DEFV(Common,DEFV(Int,SINT(Idiffusion_2D_a_temperatures_locales_____nombre_de_points_de_la___mer,ZERO))); DEFV(Common,DEFV(Int,SINT(Idiffusion_2D_a_temperatures_locales_____nombre_de_points_de_la_terre,ZERO))); /* Nombre de points de la mer et de la terre (introduits le 20070208134606). */ DEFV(Common,DEFV(Int,SINT(Idiffusion_2D_a_temperatures_locales_____nombre_de_points_diffuses,ZERO))); /* Nombre de points ayant diffuse durant la "passe" courante. Ceci fut introduit le */ /* 20070208134606 pour detecter d'eventuels blocages du processus (cas ou il n'y a plus */ /* aucun sites de libres...). */ DEFV(Common,DEFV(FonctionP,POINTERp(Idiffusion_2D_a_temperatures_locales(imageR ,imageRM ,imageA ,imageAM ,imageS ,imageSM ,temperature_locale ,graine_de_selection_des_points_a_diffuser ,graine_de_selection_des_directions_de_diffusion ,editer_quelques_nombres_utiles ) ) ) ) /* Fonction introduite le 20070207140605... */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR=diffusion(imageA). */ DEFV(Argument,DEFV(image,imageRM)); /* Image Resultat de l'espace apres diffusion et concernant le marquage. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument donnant l'etat courant de l'espace avant son evolution ("etat anterieur"). */ DEFV(Argument,DEFV(image,imageAM)); /* Image Argument de l'espace avant diffusion et concernant le marquage. */ DEFV(Argument,DEFV(image,imageS)); /* Image Argument definissant la source. */ DEFV(Argument,DEFV(image,imageSM)); /* Image Argument de la source concernant le marquage. */ /* */ /* Nota : la notion de marquage (voir {imageRM,imageAM,imageSM}) a ete introduite le */ /* 20070308092338. Elle consiste a generer une seconde serie d'images dans lesquelles les */ /* particules peuvent etre colorees de facon a pouvoir etre ensuite suivies au cours du */ /* temps. Dans ce cas, les niveaux de chaque point ne jouent aucun role et il est meme */ /* possible d'utiliser alors le niveau utilise dans la premiere serie d'image pour coder */ /* la Mer. On notera que lors du mouvement d'une particule d'une case (occupee initialement) */ /* a une cas voisine (libre initialement), la case ainsi liberee est alors materialisee par */ /* 'Idiffusion_2D_a_temperatures_locales_____marqueur_des_cases_de_la___mer', ce niveau */ /* pouvant etre en fait l'un des niveaux de marquage. Cette pratique est en fait a eviter */ /* evidemment (au passage, c'est 'GRIS_0' qui est utilise par defaut...). */ DEFV(Argument,DEFV(imageF,temperature_locale)); /* Image Argument definissant le champ de temperature. */ DEFV(Argument,DEFV(Int,graine_de_selection_des_points_a_diffuser)); DEFV(Argument,DEFV(Int,graine_de_selection_des_directions_de_diffusion)); /* Pour generer l'aleatoire de la diffusion... */ DEFV(Argument,DEFV(Logical,editer_quelques_nombres_utiles)); /* Pour editer quelques nombres utiles (introduit le 20070208141056). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ INCR(Idiffusion_2D_a_temperatures_locales_____compteur_de_passage,I); /* Comptage des passages dans 'Idiffusion_2D_a_temperatures_locales(...)'. */ CLIR(Idiffusion_2D_a_temperatures_locales_____nombre_de_points_de_la___mer); CLIR(Idiffusion_2D_a_temperatures_locales_____nombre_de_points_de_la_terre); CLIR(Idiffusion_2D_a_temperatures_locales_____nombre_de_points_diffuses); /* Initialisation des divers compteurs (introduits le 20070208134606). */ Test(IL_FAUT(Idiffusion_2D_a_temperatures_locales_____reinjecter_la_Source_a_chaque_iteration)) /* Test introduit le 20070212115602... */ Bblock Test(IFGT(Idiffusion_2D_a_temperatures_locales_____niveau_de_la_terre ,Idiffusion_2D_a_temperatures_locales_____niveau_de_la___mer ) ) Bblock CALS(Imaximum(imageR,imageS,imageA)); /* Initialisation de l'image Resultat a partir de l'etat anterieur ('imageA') et de la */ /* source ('imageS') que l'on "reinjecte" a priori... */ Eblock ATes Bblock Test(IFLT(Idiffusion_2D_a_temperatures_locales_____niveau_de_la_terre ,Idiffusion_2D_a_temperatures_locales_____niveau_de_la___mer ) ) Bblock CALS(Iminimum(imageR,imageS,imageA)); /* Initialisation de l'image Resultat a partir de l'etat anterieur ('imageA') et de la */ /* source ('imageS') que l'on "reinjecte" a priori... */ Eblock ATes Bblock PRINT_ERREUR("les niveaux respectifs de la terre et de la mer sont egaux"); Eblock ETes Eblock ETes CALS(Iproduit_de_masquage(imageRM,imageSM,imageAM)); /* Initialisation de l'image Resultat a partir de l'etat anterieur ('imageAM') et de la */ /* source ('imageSM') que l'on "reinjecte" a priori, en ce qui concerne le marquage. */ Eblock ATes Bblock CALS(iMOVE(imageR,imageA)); /* Initialisation de l'image Resultat a partir de l'etat anterieur ('imageA') sans */ /* reinjecter la source ('imageS'). */ CALS(iMOVE(imageRM,imageAM)); /* Initialisation de l'image Resultat a partir de l'etat anterieur ('imageAM') sans */ /* reinjecter la source ('imageS') en ce qui concerne le marquage. */ Eblock ETes begin_image Bblock DEFV(Int,INIT(X_du_point_courant,X)); DEFV(Int,INIT(Y_du_point_courant,Y)); /* Coordonnees {X,Y} du point courant (introduites le 20070210084129). */ DEFV(genere_p,INIT(niveau__anterieur_du_point_courant,NIVEAU_UNDEF)); DEFV(genere_p,INIT(niveau_posterieur_du_point_courant,NIVEAU_UNDEF)); /* Niveaux anterieur et posterieur du point courant... */ Test(IL_FAUT(Idiffusion_2D_a_temperatures_locales_____shuffler_les_coordonnees)) /* Sequence introduite le 20070210085430... */ Bblock GENERATION_D_UN_NOMBRE_ALEATOIRE_DE_DIFFUSION_2D(X_du_point_courant ,INTE ,Xmin ,MAJORATION_BORNE_SUPERIEURE_D_UNE_GENERATION_ALEATOIRE_ENTIERE(Xmax) ,Idiffusion_2D_a_temperatures_locales_____graine_de_shuffling_de_X ); GENERATION_D_UN_NOMBRE_ALEATOIRE_DE_DIFFUSION_2D(Y_du_point_courant ,INTE ,Ymin ,MAJORATION_BORNE_SUPERIEURE_D_UNE_GENERATION_ALEATOIRE_ENTIERE(Ymax) ,Idiffusion_2D_a_temperatures_locales_____graine_de_shuffling_de_Y ); /* "Shuffling" de {X,Y} a l'interieur de [Xmin,Xmax]x[Ymin,Ymax]... */ Eblock ATes Bblock Eblock ETes ACCES_A_UN_POINT_DU_VOISINAGE(niveau__anterieur_du_point_courant,X_du_point_courant,Y_du_point_courant); /* Niveau courant au point courant de la generation courante. */ EGAL(niveau_posterieur_du_point_courant,niveau__anterieur_du_point_courant); /* A priori car, en effet, il s'agit de la situation la plus frequente... */ Test(IFEQ(niveau__anterieur_du_point_courant,Idiffusion_2D_a_temperatures_locales_____niveau_de_la___mer)) Bblock /* Cas ou le site courant {X,Y} fait partie de la mer : rien a faire... */ INCR(Idiffusion_2D_a_temperatures_locales_____nombre_de_points_de_la___mer,I); /* Comptage des points de la mer (introduit le 20070208134606). */ Eblock ATes Bblock /* Cas ou le site courant {X,Y} fait partie de la terre ("vraie" ou "nouvelle nee") : */ INCR(Idiffusion_2D_a_temperatures_locales_____nombre_de_points_de_la_terre,I); /* Comptage des points de la terre (introduit le 20070208134606). */ Test(IFEQ(niveau__anterieur_du_point_courant,Idiffusion_2D_a_temperatures_locales_____niveau_de_la_terre)) Bblock /* Cas ou le site courant {X,Y} fait partie de la terre (la "vraie") : */ DEFV(Float,INIT(taux_de_diffusion,FLOT__UNDEF)); /* Taux 'R' de diffusion. */ DEFV(Float,INIT(valeur_aleatoire_de_selection_des_points_a_diffuser,FLOT__UNDEF)); /* Valeur aleatoire de choix des points a diffuser. */ GENERATION_D_UN_NOMBRE_ALEATOIRE_DE_DIFFUSION_2D(valeur_aleatoire_de_selection_des_points_a_diffuser ,NEUT ,PROBABILITE_NULLE ,PROBABILITE_UNITE ,graine_de_selection_des_points_a_diffuser ); EGAL(taux_de_diffusion ,TAUX_DE_DIFFUSION_2D(Idiffusion_2D_a_temperatures_locales_____frequence_de_la_diffusion ,Idiffusion_2D_a_temperatures_locales_____energie_minimale ,Idiffusion_2D_a_temperatures_locales_____energie_maximale ,Idiffusion_2D_a_temperatures_locales_____lambda ,Idiffusion_2D_a_temperatures_locales_____constante_de_Boltzmann ,TEMPERATURE_LOCALE(X_du_point_courant,Y_du_point_courant) ) ); /* Taux 'R' de diffusion courant de la forme : */ /* */ /* Em + L.(EM - Em) E */ /* - ------------------ - ----- */ /* k.T k.T */ /* taux = F.e = F.e */ /* */ /* ou {Em,EM} designent {energie_minimale,energie_maximale} respectivement et 'L' un */ /* parametre de ponderation dans [0,1]. Ainsi, plus l'energie 'E' est elevee (voisine de */ /* 'EM ', 'L' proche de '1'), plus le taux d'activation est faible et moins la reaction */ /* de diffusion a lieu ; inversement, plus l'energie 'E' est faible (voisine de 'Em', 'L' */ /* proche de 0), plus le taux d'activation est eleve et plus la reaction de diffusion a */ /* lieu. */ /* */ /* On notera que par defaut : */ /* */ /* E = 1/2 */ /* F = 1 */ /* */ /* et que la plupart du temps : */ /* */ /* k = 1 */ /* */ /* ('v $xci/diffus_2D.21$K constante_de_Boltzmann'). */ Test(IFLE(valeur_aleatoire_de_selection_des_points_a_diffuser,taux_de_diffusion)) Bblock /* Cas ou le point courant est "diffusable" : */ DEFV(Float,INIT(valeur_aleatoire_de_selection_des_directions_de_diffusion,FLOT__UNDEF)); /* Valeur aleatoire de choix des points a diffuser. */ DEFV(Int,INIT(deplacement_en_X,UNDEF)); DEFV(Int,INIT(deplacement_en_Y,UNDEF)); /* Deplacements aleatoires en {X,Y}... */ DEFV(Int,INIT(X_du_point_courant_apres_diffusion,UNDEF)); DEFV(Int,INIT(Y_du_point_courant_apres_diffusion,UNDEF)); /* Coordonnees {X,Y} du point courant apres diffusion (introduites le 20070210084129). */ DEFV(genere_p,INIT(niveau__anterieur_d_un_voisin_du_point_courant,NIVEAU_UNDEF)); /* Niveau anterieur d'un voisin (parmi {Est,Nord,Ouest,Sud}) du point courant. */ INCR(Idiffusion_2D_a_temperatures_locales_____nombre_de_points_diffuses,I); /* Comptage des points diffusant (introduit le 20070208134606). */ GENERATION_D_UN_NOMBRE_ALEATOIRE_DE_DIFFUSION_2D(valeur_aleatoire_de_selection_des_directions_de_diffusion ,NEUT ,FZERO ,CERCLE_TRIGONOMETRIQUE ,graine_de_selection_des_directions_de_diffusion ); /* Generation d'un angle aleatoire dans [0,2.pi]. */ Test(IFINof(valeur_aleatoire_de_selection_des_directions_de_diffusion ,GRO0(PI_SUR_2) ,GRO1(PI_SUR_2) ) ) Bblock EGAL(deplacement_en_X,NEUT(Idiffusion_2D_a_temperatures_locales_____PasX)); EGAL(deplacement_en_Y,ZERO); /* Deplacement "Est". */ Eblock ATes Bblock Test(IFINof(valeur_aleatoire_de_selection_des_directions_de_diffusion ,GRO1(PI_SUR_2) ,GRO2(PI_SUR_2) ) ) Bblock EGAL(deplacement_en_X,ZERO); EGAL(deplacement_en_Y,NEUT(Idiffusion_2D_a_temperatures_locales_____PasY)); /* Deplacement "Nord". */ Eblock ATes Bblock Test(IFINof(valeur_aleatoire_de_selection_des_directions_de_diffusion ,GRO2(PI_SUR_2) ,GRO3(PI_SUR_2) ) ) Bblock EGAL(deplacement_en_X,NEGA(Idiffusion_2D_a_temperatures_locales_____PasX)); EGAL(deplacement_en_Y,ZERO); /* Deplacement "Ouest". */ Eblock ATes Bblock EGAL(deplacement_en_X,ZERO); EGAL(deplacement_en_Y,NEGA(Idiffusion_2D_a_temperatures_locales_____PasY)); /* Deplacement "Sud". */ Eblock ETes Eblock ETes Eblock ETes EGAL(X_du_point_courant_apres_diffusion,ADD2(X_du_point_courant,deplacement_en_X)); EGAL(Y_du_point_courant_apres_diffusion,ADD2(Y_du_point_courant,deplacement_en_Y)); /* Deplacement (virtuel pour le moment...) du point courant... */ ACCES_A_UN_POINT_DU_VOISINAGE(niveau__anterieur_d_un_voisin_du_point_courant ,X_du_point_courant_apres_diffusion ,Y_du_point_courant_apres_diffusion ); /* Niveau anterieur d'un voisin (parmi {Est,Nord,Ouest,Sud}) du point courant. */ Test(IFEQ(niveau__anterieur_d_un_voisin_du_point_courant ,Idiffusion_2D_a_temperatures_locales_____niveau_de_la___mer ) ) Bblock /* Cas ou le voisin choisi est dans la mer : */ EGAL(niveau_posterieur_du_point_courant ,Idiffusion_2D_a_temperatures_locales_____niveau_de_la___mer_nouvelle_nee ); Fstore_point(Idiffusion_2D_a_temperatures_locales_____niveau_de_la_terre_nouvelle_nee ,imageR ,X_du_point_courant_apres_diffusion ,Y_du_point_courant_apres_diffusion ,Idiffusion_2D_a_temperatures_locales_____periodiser_X ,Idiffusion_2D_a_temperatures_locales_____periodiser_Y ,Idiffusion_2D_a_temperatures_locales_____symetriser_X ,Idiffusion_2D_a_temperatures_locales_____symetriser_Y ,Idiffusion_2D_a_temperatures_locales_____prolonger_X ,Idiffusion_2D_a_temperatures_locales_____prolonger_Y ); /* Cas ou le point {X,Y} diffuse vers une case de la mer voisine ; on echange donc ainsi */ /* la case {X,Y} avec l'une de ses voisines... */ Fstore_point(Fload_point(imageRM ,X_du_point_courant,Y_du_point_courant ,Idiffusion_2D_a_temperatures_locales_____periodiser_X ,Idiffusion_2D_a_temperatures_locales_____periodiser_Y ,Idiffusion_2D_a_temperatures_locales_____symetriser_X ,Idiffusion_2D_a_temperatures_locales_____symetriser_Y ,Idiffusion_2D_a_temperatures_locales_____prolonger_X ,Idiffusion_2D_a_temperatures_locales_____prolonger_Y ,Idiffusion_2D_a_temperatures_locales_____niveau_hors_image ) ,imageRM ,X_du_point_courant_apres_diffusion ,Y_du_point_courant_apres_diffusion ,Idiffusion_2D_a_temperatures_locales_____periodiser_X ,Idiffusion_2D_a_temperatures_locales_____periodiser_Y ,Idiffusion_2D_a_temperatures_locales_____symetriser_X ,Idiffusion_2D_a_temperatures_locales_____symetriser_Y ,Idiffusion_2D_a_temperatures_locales_____prolonger_X ,Idiffusion_2D_a_temperatures_locales_____prolonger_Y ); store_point(Idiffusion_2D_a_temperatures_locales_____marqueur_des_cases_de_la___mer ,imageRM ,X_du_point_courant,Y_du_point_courant ,FVARIABLE ); /* Gestion du marquage de la diffusion (introduit le 20070308092338)... */ Eblock ATes Bblock /* Cas ou le site courant {X,Y} fait partie de la terre et ne peut pas bouger car la case */ /* voisine ou il devait aller est deja faite de terre... */ Eblock ETes Eblock ATes Bblock /* Cas ou le site courant {X,Y} fait partie de la terre, mais n'a pas "le droit" a etre */ /* diffuse... */ Eblock ETes Eblock ATes Bblock Test(IFOU(IFEQ(niveau__anterieur_du_point_courant ,Idiffusion_2D_a_temperatures_locales_____niveau_de_la___mer_nouvelle_nee ) ,IFEQ(niveau__anterieur_du_point_courant ,Idiffusion_2D_a_temperatures_locales_____niveau_de_la_terre_nouvelle_nee ) ) ) /* Cas ou le site courant {X,Y} fait partie de la mer (la "nouvelle nee") ou de la terre */ /* (la "nouvelle nee") : rien a faire... */ Bblock Eblock ATes Bblock /* Cas ou ni le niveau de la mer, ni le niveau de la terre ne furent reconnus : ce niveau */ /* est considere comme celui d'un obstacle. Cette notion d'"obstacle" fut introduite le */ /* 20070405161255. Avant cette date, il y avait ici le code suivant : */ /* */ /* PRINT_ERREUR("un niveau non reconnu a ete rencontre"); */ /* CAL1(Prer1("(sa valeur est %d)\n",niveau__anterieur_du_point_courant)); */ /* */ /* qui n'a donc plus de raisons d'etre... */ Eblock ETes Eblock ETes Eblock ETes store_point(niveau_posterieur_du_point_courant ,imageR ,X_du_point_courant,Y_du_point_courant ,FVARIABLE ); /* Et on calcule la generation suivante... */ Eblock end_image begin_image Bblock DEFV(genere_p,INIT(niveau_courant,load_point(imageR,X,Y))); store_point(COND(IFEQ(niveau_courant,Idiffusion_2D_a_temperatures_locales_____niveau_de_la_terre_nouvelle_nee) ,Idiffusion_2D_a_temperatures_locales_____niveau_de_la_terre ,COND(IFEQ(niveau_courant,Idiffusion_2D_a_temperatures_locales_____niveau_de_la___mer_nouvelle_nee) ,Idiffusion_2D_a_temperatures_locales_____niveau_de_la___mer ,niveau_courant ) ) ,imageR ,X,Y ,FVARIABLE ); /* Et on fait de la terre "nouvelle nee", de la "vraie" terre (introduit le 20070208151737). */ Eblock end_image Test(IL_FAUT(editer_quelques_nombres_utiles)) /* Test introduit le 20070208141056... */ Bblock /* ATTENTION : il est imperatif que la "clef" du premier nombre edite soit precedee d'un */ /* espace, afin que les espaces soient des limiteurs des nombre edites ou qu'ils soient */ /* situes dans la liste (premier ou dernier en particulier...). */ CAL3(Prme1(" Iteration=%d" ,Idiffusion_2D_a_temperatures_locales_____compteur_de_passage ) ); /* Ajoute le 20070208143106... */ CAL3(Prme1(" NombrePointsMer=%d" ,Idiffusion_2D_a_temperatures_locales_____nombre_de_points_de_la___mer ) ); CAL3(Prme1(" NombrePointsTerre=%d" ,Idiffusion_2D_a_temperatures_locales_____nombre_de_points_de_la_terre ) ); CAL3(Prme1(" NombrePointsDiffuses=%d" ,Idiffusion_2D_a_temperatures_locales_____nombre_de_points_diffuses ) ); CALS(Fsauts_de_lignes(UN)); Eblock ATes Bblock Eblock ETes Test(IFNE(ADD2(Idiffusion_2D_a_temperatures_locales_____nombre_de_points_de_la___mer ,Idiffusion_2D_a_temperatures_locales_____nombre_de_points_de_la_terre ) ,dimXY ) ) /* Test introduit le 20070208144134... */ Bblock PRINT_ERREUR("il semble qu'il y ait autre chose que de la mer et de la terre"); Eblock ATes Bblock Eblock ETes Test(IZEQ(Idiffusion_2D_a_temperatures_locales_____nombre_de_points_de_la___mer)) /* Test introduit le 20070208141056... */ Bblock PRINT_ERREUR("la mer est vide"); Eblock ATes Bblock Eblock ETes Test(IZEQ(Idiffusion_2D_a_temperatures_locales_____nombre_de_points_de_la_terre)) /* Test introduit le 20070208141056... */ Bblock PRINT_ERREUR("la terre est vide"); Eblock ATes Bblock Eblock ETes Test(IZEQ(Idiffusion_2D_a_temperatures_locales_____nombre_de_points_diffuses)) /* Test introduit le 20070208141056... */ Bblock PRINT_ERREUR("il n'y a pas eu de points diffuses"); /* Message redondant avec 'v $xci/diffus_2D.21$K PRINT_ERREUR..il.n.y.a.pas.eu.de.points.d' */ /* et 'v $xci/diffus_3D.21$K PRINT_ERREUR..il.n.y.a.pas.eu.de.points.d'. */ Eblock ATes Bblock Eblock ETes RETI(imageR); Eblock #undef TAUX_DE_DIFFUSION_2D #undef TEMPERATURE_LOCALE #undef GENERATION_D_UN_NOMBRE_ALEATOIRE_DE_DIFFUSION_2D #undef Idiffusion_2D_a_temperatures_locales_____PasY #undef Idiffusion_2D_a_temperatures_locales_____PasX #undef ACCES_A_UN_POINT_DU_VOISINAGE EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D I F F U S I O N B I D I M E N S I O N N E L L E A T E M P E R A T U R E G L O B A L E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Idiffusion_2D(imageR ,imageRM ,imageA ,imageAM ,imageS ,imageSM ,temperature_globale ,graine_de_selection_des_points_a_diffuser ,graine_de_selection_des_directions_de_diffusion ,editer_quelques_nombres_utiles ) ) ) ) /* Fonction introduite le 20070207140605... */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR=diffusion(imageA). */ DEFV(Argument,DEFV(image,imageRM)); /* Image Resultat concernant le marquage (introduite le 20070308094306). */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument donnant l'etat courant de l'espace avant son evolution ("etat anterieur"). */ DEFV(Argument,DEFV(image,imageAM)); /* Image Argument concernant le marquage (introduite le 20070308094306). */ DEFV(Argument,DEFV(image,imageS)); /* Image Argument definissant la source. */ DEFV(Argument,DEFV(image,imageSM)); /* Image Argument concernant le marquage (introduite le 20070308094306). */ DEFV(Argument,DEFV(Float,temperature_globale)); /* Temperature globale. */ DEFV(Argument,DEFV(Int,graine_de_selection_des_points_a_diffuser)); DEFV(Argument,DEFV(Int,graine_de_selection_des_directions_de_diffusion)); /* Pour generer l'aleatoire de la diffusion... */ DEFV(Argument,DEFV(Logical,editer_quelques_nombres_utiles)); /* Pour editer quelques nombres utiles (introduit le 20070208141056). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock BDEFV(imageF,temperature_locale); /* Image flottante donnant la temperature en chaque point {X,Y}. */ /*..............................................................................................................................*/ CALS(IFinitialisation(temperature_locale,temperature_globale)); /* Initialisation du taux d'affaiblissement de la terre de facon uniforme. */ CALS(Idiffusion_2D_a_temperatures_locales(imageR ,imageRM ,imageA ,imageAM ,imageS ,imageSM ,temperature_locale ,graine_de_selection_des_points_a_diffuser ,graine_de_selection_des_directions_de_diffusion ,editer_quelques_nombres_utiles ) ); /* Et calcul avec la meme temperature en chaque point {X,Y}... */ EDEFV(imageF,temperature_locale); /* Image flottante donnant la temperature en chaque point {X,Y}. */ RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* A U T O M A T E S C E L L U L A I R E S M O N O D I M E N S I O N N E L S : */ /* */ /*************************************************************************************************************************************/ BFonctionP #define PRNX(x) \ nPREX(x,Iautomate_cellulaire_monodimensionnel_____N_voisins) #define SUNX(x) \ nSUCX(x,Iautomate_cellulaire_monodimensionnel_____N_voisins) DEFV(Common,DEFV(Int,SINT(Iautomate_cellulaire_monodimensionnel_____N_voisins,UN))); /* Introduit le 20081125184428 pour permettre d'aller "au-dela" des deux premiers (=UN=1) */ /* voisins... */ /* */ /* Le 20081218111646 je note, lors de tests avec le calcul de 'v $xiird/AC1B.61', que cette */ /* possibilite semble de peu d'interet. Malgre cela, je la laisse en place puisqu'en effet */ /* elle est "gratuite"... */ DEFV(Common,DEFV(Logical,SINT(Iautomate_cellulaire_monodimensionnel_____periodiser_X,FAUX))); DEFV(Common,DEFV(Logical,SINT(Iautomate_cellulaire_monodimensionnel_____symetriser_X,FAUX))); DEFV(Common,DEFV(Logical,SINT(Iautomate_cellulaire_monodimensionnel_____prolonger_X,FAUX))); /* Introduit le 20081121180825 pour permettre l'utilisation de 'Fload_point(...)'. Les */ /* valeurs par defaut des arguments garantissant la compatibilite anterieure. On notera */ /* de plus que l'axe 'Y' (tres different de l'axe 'X' puisqu'il represente le "temps") */ /* n'a aucun interet ici et que les valeurs utiles pour lui seront 'FAUX' ci-apres lors */ /* de l'appel de 'Fload_point(...)'. */ DEFV(Common,DEFV(genere_p,SINT(Iautomate_cellulaire_monodimensionnel_____niveau_hors_processus,BLANC))); /* Niveau correspondant aux points n'ayant qu'un seul voisin monodimensionnel. On notera */ /* que le 20021015095720 ce parametre est passe de 'NOIR' a 'BLANC' car, en effet, cette */ /* nouvelle valeur est celle qui en regle generale limite (voire supprime) les effets de */ /* bord... */ DEFV(Common,DEFV(Logical,SINT(Iautomate_cellulaire_monodimensionnel_____editer_les_messages_de_hors_image,VRAI))); /* Afin de controler les messages d'erreur lorsque la coordonnee 'Ymin_de_l_automate_...' */ /* ou la coordonnee 'Ymax_de_l_automate_' sortent de l'ecran (introduit le 20081118134606). */ DEFV(Common,DEFV(Int,SINT(Iautomate_cellulaire_monodimensionnel_____graine_de_perturbation_aleatoire,1789))); DEFV(Common,DEFV(Int,SINT(Iautomate_cellulaire_monodimensionnel_____graine_du_niveau_du_point_Gauche__anterieur,1947))); DEFV(Common,DEFV(Int,SINT(Iautomate_cellulaire_monodimensionnel_____graine_du_niveau_du_point_Droite__anterieur,2001))); /* Graines du generateur aleatoire... */ DEFV(Common,DEFV(Int,SINT(Iautomate_cellulaire_monodimensionnel_____num_liste_de_substitution,L_SUBSTITUTION_NEUTRE))); /* Pour pouvoir substituer les niveaux aleatoires... */ #define PERTURBATION_ALEATOIRE_D_UN_AUTOMATE_CELLULAIRE(valeur_aleatoire,graine_courante) \ Bblock \ DEFV(pointI_2D,point_courant_de_l_espace_de_parametrage); \ INITIALISATION_POINT_2D(point_courant_de_l_espace_de_parametrage,X,Y); \ /* Point courant de l'espace de parametrage. */ \ \ PUSH_FILTRAGE; \ /* Sauvegarde de l'etat courant du filtrage des niveaux. */ \ SET_FILTRAGE(ACTIF); \ /* On autorise tous les filtrages afin d'avoir la 'SUBSTITUTION'. */ \ PUSH_SUBSTITUTION; \ /* Sauvegarde de la substitution courante. */ \ SUBSTITUTION(Iautomate_cellulaire_monodimensionnel_____num_liste_de_substitution); \ \ EGAL(valeur_aleatoire \ ,Nsubstitution(GENP(rdnI2D(ADRESSE(point_courant_de_l_espace_de_parametrage) \ ,graine_courante \ ,RDN_INIT_AND_GENERE \ ,FLOT__NOIR,FLOT__BLANC \ ) \ ) \ ) \ ); \ /* Generation d'une valeur aleatoire dans [NOIR,BLANC] puis substituee... */ \ \ PULL_SUBSTITUTION; \ PULL_FILTRAGE; \ /* Et restauration des conditions initiales... */ \ Eblock \ /* Generation d'une valeur aleatoire. */ DEFV(Common,DEFV(FonctionP,POINTERp(Iautomate_cellulaire_monodimensionnel(imageR ,imageA ,automate_cellulaire ,Ymin_de_l_automate_cellulaire_monodimensionnel ,Ymax_de_l_automate_cellulaire_monodimensionnel ,perturber_aleatoirement ,seuil_de_perturbation_aleatoire ) ) ) ) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=Evolution(imageA[X][Ymin]). */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(automate_cellulaire_monodimensionnel,automate_cellulaire)); /* Matrice donnant l'automate cellulaire courant... */ DEFV(Argument,DEFV(Int,Ymin_de_l_automate_cellulaire_monodimensionnel)); DEFV(Argument,DEFV(Int,Ymax_de_l_automate_cellulaire_monodimensionnel)); /* Definition des extrema de la coordonnee 'Y'. Evidemment, en general, il s'agira de */ /* {Ymin,Ymax} ; mais des valeurs differentes permettront de repartir d'un automate */ /* "partiel" anterieur et ainsi de changer la definition de 'automate_cellulaire' au cours */ /* de la generation. On pourra ainsi faire, par exemple, les 'N1' premieres lignes avec */ /* 'AUTOMATE1', puis les 'N2' lignes suivantes avec 'AUTOMATE2',... Ceci fut introduit le */ /* 20081013105338... */ DEFV(Argument,DEFV(Logical,perturber_aleatoirement)); /* Afin de pouvoir perturber aleatoirement l'automate cellulaire. Ce dispositif a ete */ /* introduit le 20081205162240 et mis sous forme 'Argument' le 20081207171228... */ DEFV(Argument,DEFV(imageF,seuil_de_perturbation_aleatoire)); /* Seuil de declenchement losrqu'il faut perturber aleatoirement l'automate cellulaire. */ /* Pour une valeur nulle, il n'y a pas de perturbation, alosr que pour une valeur unite, */ /* la perturbation est systematique... */ /* */ /* Le 20081207164857, je note que ce 'Float' pourrait etre remplace par une 'imageF' qui */ /* donnerait donc en chaque point {X,Y} un seuil ainsi variable localement. Cela fut donc */ /* introduit le 20081207171228... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock BDEFV(image,evolution_au_cours_du_temps); /* Image destinee a cumuler l'evolution au cours du temps represente par la coordonnee 'Y'. */ DEFV(Int,INIT(Ymin_effectif_de_l_automate_cellulaire_monodimensionnel,Ymin_de_l_automate_cellulaire_monodimensionnel)); DEFV(Int,INIT(Ymax_effectif_de_l_automate_cellulaire_monodimensionnel,Ymax_de_l_automate_cellulaire_monodimensionnel)); /* Extrema effectifs de la coordonnee 'Y'... */ /*..............................................................................................................................*/ iMOVE(evolution_au_cours_du_temps,imageA); /* Initialisation de l'evolution (voir les commentaires relatifs a la procedure */ /* 'iMOVE(...)' dans 'v $xiii/di_image$DEF')... */ Test(IFLE(Ymin_de_l_automate_cellulaire_monodimensionnel,Ymax_de_l_automate_cellulaire_monodimensionnel)) /* Test introduit le 20081118135755 car, en effet, il manquait... */ Bblock Test(IFINff(Ymin_de_l_automate_cellulaire_monodimensionnel,Ymin,Ymax)) /* Test introduit le 20081117161943 car, en effet, il manquait... */ Bblock Test(IFINff(Ymax_de_l_automate_cellulaire_monodimensionnel,Ymin,Ymax)) /* Test introduit le 20081117161943 car, en effet, il manquait... */ Bblock Eblock ATes Bblock EGAL(Ymax_effectif_de_l_automate_cellulaire_monodimensionnel ,MIN2(Ymax_de_l_automate_cellulaire_monodimensionnel,Ymax) ); /* On notera qu'ainsi si 'Ymax_de_l_automate_cellulaire_monodimensionnel' est inferieur */ /* en fait a 'Ymin' (et non pas superieur a 'Ymax'), il garde alors sa valeur et ainsi */ /* le begin_colonneQ(...)' qui suit ne sera pas execute... */ Test(IL_FAUT(Iautomate_cellulaire_monodimensionnel_____editer_les_messages_de_hors_image)) /* Test introduit le 20081118134606... */ Bblock PRINT_ERREUR("l'ordonnee maximale est 'hors-image'"); CAL1(Prer2("(elle vaut %d et va etre seuillee en %d)\n" ,Ymax_de_l_automate_cellulaire_monodimensionnel ,Ymax_effectif_de_l_automate_cellulaire_monodimensionnel ) ); /* Messages introduits le 20081117161943... */ Eblock ATes Bblock Eblock ETes Eblock ETes Test(IL_FAUT(perturber_aleatoirement)) /* Test introduit le 20081217165223... */ Bblock DEFV(genere_Float,INIT(niveau_minimum_de_perturbation_aleatoire,IFnivo_minimum(seuil_de_perturbation_aleatoire))); DEFV(genere_Float,INIT(niveau_maximum_de_perturbation_aleatoire,IFnivo_maximum(seuil_de_perturbation_aleatoire))); /* Extrema du champ 'seuil_de_perturbation_aleatoire'... */ Test(IFEXff(niveau_minimum_de_perturbation_aleatoire,PROBABILITE_NULLE,PROBABILITE_UNITE)) Bblock PRINT_ERREUR("le minimum du seuil de perturbation aleatoire n'est pas une probabilite"); CAL1(Prer3("(il vaut %f et n'est pas dans [%f,%f])\n" ,niveau_minimum_de_perturbation_aleatoire ,PROBABILITE_NULLE ,PROBABILITE_UNITE ) ); Eblock ATes Bblock Eblock ETes Test(IFEXff(niveau_maximum_de_perturbation_aleatoire,PROBABILITE_NULLE,PROBABILITE_UNITE)) Bblock PRINT_ERREUR("le maximum du seuil de perturbation aleatoire n'est pas une probabilite"); CAL1(Prer3("(il vaut %f et n'est pas dans [%f,%f])\n" ,niveau_maximum_de_perturbation_aleatoire ,PROBABILITE_NULLE ,PROBABILITE_UNITE ) ); Eblock ATes Bblock Eblock ETes Eblock ATes Bblock Eblock ETes begin_colonneQ(DoIn ,Ymin_effectif_de_l_automate_cellulaire_monodimensionnel ,Ymax_effectif_de_l_automate_cellulaire_monodimensionnel ,pasY ) Bblock begin_ligne Bblock /* L'utilisation de {begin_colonneQ,begin_ligneQ} a la place de 'begin_image' est destine */ /* a garantir que l'on balaye l'image ligne apres ligne, la coordonnee 'Y' representant */ /* le temps. La coordonnee 'X' doit donc varier plus "vite" que la coordonnee 'Y'... */ Test(IFGT(Y,Ymin)) Bblock #define periodiser_X \ Iautomate_cellulaire_monodimensionnel_____periodiser_X #define symetriser_X \ Iautomate_cellulaire_monodimensionnel_____symetriser_X #define prolonger__X \ Iautomate_cellulaire_monodimensionnel_____prolonger_X #define niveau_hors_image \ Iautomate_cellulaire_monodimensionnel_____niveau_hors_processus /* Pour raccourcir les noms afin que les trois 'Fload_point(...)'s ci-apres soient bien */ /* "presentes"... */ Test(IFOU(IFET(IFNE(X,Xmin),IFNE(X,Xmax)) ,I3OU(IL_FAUT(periodiser_X) ,IL_FAUT(symetriser_X) ,IL_FAUT(prolonger__X) ) ) ) /* Jusqu'au 20081122095330, il y avait ici : */ /* */ /* IFET(IFGT(X,Xmin),IFLT(X,Xmax)) */ /* */ /* mais la nouvelle formulation est plus explicite (lisible...) quant au test de savoir si */ /* l'on n'est pas aux extremites {Xmin,Xmax}, en notant bien que l'on ne peut pas etre */ /* exterieur au segment [Xmin,Xmax] par definition du 'begin_ligne' ci-dessus... */ Bblock #define NE_PAS_PERIODISER_NI_SYMETRISER_NI_PROLONGER_Y \ FAUX \ /* Introduit le 20081205104633 pour ameliorer la comprehensibilite de ce qui suit... */ DEFV(genere_p,INIT(niveau_du_point_Gauche__anterieur ,Fload_point(evolution_au_cours_du_temps ,PRNX(X),PREY(Y) ,periodiser_X,NE_PAS_PERIODISER_NI_SYMETRISER_NI_PROLONGER_Y ,symetriser_X,NE_PAS_PERIODISER_NI_SYMETRISER_NI_PROLONGER_Y ,prolonger__X,NE_PAS_PERIODISER_NI_SYMETRISER_NI_PROLONGER_Y ,niveau_hors_image ) ) ); DEFV(genere_p,INIT(niveau_du_point_Courant_anterieur ,Fload_point(evolution_au_cours_du_temps ,NEUT(X),PREY(Y) ,periodiser_X,NE_PAS_PERIODISER_NI_SYMETRISER_NI_PROLONGER_Y ,symetriser_X,NE_PAS_PERIODISER_NI_SYMETRISER_NI_PROLONGER_Y ,prolonger__X,NE_PAS_PERIODISER_NI_SYMETRISER_NI_PROLONGER_Y ,niveau_hors_image ) ) ); DEFV(genere_p,INIT(niveau_du_point_Droite__anterieur ,Fload_point(evolution_au_cours_du_temps ,SUNX(X),PREY(Y) ,periodiser_X,NE_PAS_PERIODISER_NI_SYMETRISER_NI_PROLONGER_Y ,symetriser_X,NE_PAS_PERIODISER_NI_SYMETRISER_NI_PROLONGER_Y ,prolonger__X,NE_PAS_PERIODISER_NI_SYMETRISER_NI_PROLONGER_Y ,niveau_hors_image ) ) ); /* Recuperation des niveaux anterieurs (c'est-a-dire au temps 'PREY(Y)') : */ /* */ /* Gauche : PRNX(X) --> niveau(X-n,Y-1) */ /* Courant : NEUT(X) --> niveau(X ,Y-1) */ /* Droite : SUNX(X) --> niveau(X+n,Y-1) */ /* */ /* (avec n=1 par defaut). */ /* */ /* On notera que les niveaux anterieurs {Gauche,Droite} sont recuperes, meme si on les */ /* remplace ci-apres par des valeurs aleatoires. Ceci est fait pour simplifier les */ /* 'Test(...)'s correspondants car, en effet, il y a deux circonstances dans lesquelles */ /* les niveaux anterieurs {Gauche,Droite} doivent etre utilises : d'une part lorsque la */ /* perturbation aleatoire n'est pas demandee et d'autre part, lorsque cette derniere est */ /* demandee et que le seuil est trop faible... */ #undef NE_PAS_PERIODISER_NI_SYMETRISER_NI_PROLONGER_Y Test(IL_FAUT(perturber_aleatoirement)) /* Dispositif introduit le 20081205162240... */ Bblock DEFV(Float,INIT(valeur_aleatoire_courante,FLOT__UNDEF)); /* Valeur aleatoire de declenchement de la perturbation aleatoire de l'automate cellulaire. */ DEFV(pointI_2D,point_courant_de_l_espace_de_parametrage); INITIALISATION_POINT_2D(point_courant_de_l_espace_de_parametrage,X,Y); /* Point courant de l'espace de parametrage. */ EGAL(valeur_aleatoire_courante ,rdnI2D(ADRESSE(point_courant_de_l_espace_de_parametrage) ,Iautomate_cellulaire_monodimensionnel_____graine_de_perturbation_aleatoire ,RDN_INIT_AND_GENERE ,PROBABILITE_NULLE,PROBABILITE_UNITE ) ); Test(IFLE(valeur_aleatoire_courante ,loadF_point(seuil_de_perturbation_aleatoire,X,Y) ) ) Bblock #define graine_niveau_du_point_Gauche__anterieur \ Iautomate_cellulaire_monodimensionnel_____graine_du_niveau_du_point_Gauche__anterieur #define graine_niveau_du_point_Droite__anterieur \ Iautomate_cellulaire_monodimensionnel_____graine_du_niveau_du_point_Droite__anterieur /* Pour raccourcir les noms afin que 'PERTURBATION_ALEATOIRE_D_UN_AUTOMATE_CELLULAIRE(...)' */ /* soit bien "presentee"... */ PERTURBATION_ALEATOIRE_D_UN_AUTOMATE_CELLULAIRE(niveau_du_point_Gauche__anterieur ,graine_niveau_du_point_Gauche__anterieur ); PERTURBATION_ALEATOIRE_D_UN_AUTOMATE_CELLULAIRE(niveau_du_point_Droite__anterieur ,graine_niveau_du_point_Droite__anterieur ); /* Perturbation des niveaux de Gauche et de Droite, lorsque cela est demandee et possible... */ #undef graine_niveau_du_point_Droite__anterieur #undef graine_niveau_du_point_Gauche__anterieur Eblock ATes Bblock Eblock ETes Eblock ATes Bblock Eblock ETes store_point(AUTOMATE_CELLULAIRE_MONODIMENSIONNEL(automate_cellulaire ,niveau_du_point_Gauche__anterieur ,niveau_du_point_Courant_anterieur ,niveau_du_point_Droite__anterieur ) ,evolution_au_cours_du_temps ,NEUT(X),NEUT(Y) ,FVARIABLE ); /* Ainsi : */ /* */ /* niveau(X,Y) = REGLE(niveau(X-1,Y-1),niveau(X,Y-1),niveau(X+1,Y-1)) */ /* */ /* ou 'Y' joue le role du temps... */ /* */ /* Le 20081121180825 fut introduite 'Fload_point(...)' afin de pouvoir utiliser, par */ /* exemple, la periodicite, les valeurs par defaut des arguments garantissant la */ /* compatibilite anterieure. On notera au passage que l'axe 'Y' n'a aucun interet ici */ /* et donc les valeurs utiles pour lui sont 'FAUX' systematiquement... */ /* */ /* Le 20081228112836, je note qu'au lieu de forcer "brutalement" le niveau du point {X,Y} */ /* avec 'AUTOMATE_CELLULAIRE_MONODIMENSIONNEL(...)', il serait possible de mettre en place */ /* un dispositif d'hysteresis combinant 'AUTOMATE_CELLULAIRE_MONODIMENSIONNEL(...)' avec le */ /* niveau anterieur 'load_point(evolution_au_cours_du_temps,NEUT(X),NEUT(Y))' en utilisant, */ /* par exemple : */ /* */ /* INITIALISATION_QUELCONQUE_TABLE_DE_MULTIPLICATION(...) */ /* */ /* a l'exterieur de 'Iautomate_cellulaire_monodimensionnel(...)', puis : */ /* */ /* ACCES_A_UN_PRODUIT_GENERALISE(table_de_multiplication */ /* ,load_point(evolution_au_cours_du_temps,NEUT(X),NEUT(Y)) */ /* ,AUTOMATE_CELLULAIRE_MONODIMENSIONNEL(...) */ /* ) */ /* */ /* a la place de 'AUTOMATE_CELLULAIRE_MONODIMENSIONNEL(...)' ci-dessus et en introduisant */ /* 'table_de_multiplication' comme argument de 'Iautomate_cellulaire_monodimensionnel(...)' */ /* (ou en utilisant 'table_de_multiplication_standard'...). On verra a ce propos les */ /* nouvelles definitions 'PRODUIT_NIVEAU?(...)' ('v $xiii/Images$DEF 20081228114814') qui */ /* assureraient (du moins l'une d'entre-elles) en particulier la compatibilite anterieure... */ Eblock ATes Bblock store_point(Iautomate_cellulaire_monodimensionnel_____niveau_hors_processus ,evolution_au_cours_du_temps ,NEUT(X),NEUT(Y) ,FVARIABLE ); /* Dans le cas 'X=Xmin' ou 'X=Xmax', un niveau a priori est force... */ Eblock ETes #undef niveau_hors_image #undef prolonger__X #undef symetriser_X #undef periodiser_X Eblock ATes Bblock store_point(load_point(evolution_au_cours_du_temps,NEUT(X),NEUT(Y)) ,evolution_au_cours_du_temps ,NEUT(X),NEUT(Y) ,FVARIABLE ); /* Dans le cas 'Y=Ymin', on duplique simplement les niveaux. On notera qu'evidemment cette */ /* operation est inutile (puisque l'image 'evolution_au_cours_du_temps' est a la fois */ /* "source" et "destination" de cette duplication pour le meme point {X,Y}) mais qu'elle */ /* est malgre tout mise en place pour des raisons de symetrie avec les deux autres cas de */ /* 'store_point(...)' ci-dessus ; de plus on prepare eventuellement une future evolution */ /* ou 'evolution_au_cours_du_temps' demanderait en fait deux images... */ Eblock ETes Eblock end_ligne Eblock end_colonneQ(EDoI) /* L'utilisation de {end_ligne,end_colonne} a la place de 'end_image' est destine */ /* a garantir que l'on balaye l'image ligne apres ligne, la coordonnee 'Y' representant */ /* le temps. La coordonnee 'X' doit donc varier plus "vite" que la coordonnee 'Y'... */ Eblock ATes Bblock Test(IL_FAUT(Iautomate_cellulaire_monodimensionnel_____editer_les_messages_de_hors_image)) /* Test introduit le 20081118134606... */ Bblock PRINT_ERREUR("l'ordonnee minimale est 'hors-image'"); CAL1(Prer1("(elle vaut %d)\n",Ymin_de_l_automate_cellulaire_monodimensionnel)); /* Messages introduits le 20081117161943... */ Eblock ATes Bblock Eblock ETes Eblock ETes Eblock ATes Bblock Test(IL_FAUT(Iautomate_cellulaire_monodimensionnel_____editer_les_messages_de_hors_image)) /* Test introduit le 20081118134606... */ Bblock PRINT_ERREUR("l'ordre des ordonnees minimale et maximale est incorrect"); CAL1(Prer2("([Ymax=%d] < [Ymin=%d])\n" ,Ymax_de_l_automate_cellulaire_monodimensionnel ,Ymin_de_l_automate_cellulaire_monodimensionnel ) ); /* Messages introduits le 20081117161943... */ Eblock ATes Bblock Eblock ETes Eblock ETes iMOVE(imageR,evolution_au_cours_du_temps); /* Renvoi du Resultat (voir les commentaires relatifs a la procedure */ /* 'iMOVE(...)' dans 'v $xiii/di_image$DEF')... */ EDEFV(image,evolution_au_cours_du_temps); /* Image destinee a cumuler l'evolution au cours du temps represente par la coordonnee 'Y'. */ RETI(imageR); Eblock #undef PERTURBATION_ALEATOIRE_D_UN_AUTOMATE_CELLULAIRE #undef SUNX #undef PRNX EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* M O D E L E B I D I M E N S I O N N E L D E C O T E S A V E C " E T C H I N G " : */ /* */ /* */ /* Definition : */ /* */ /* Ce modele est tres inspire de celui */ /* de Kiran Kolwankar et de Bernard */ /* Sapoval. Il consiste en un espace bidimensionnel */ /* de points P(x,y). Les points a valeurs negatives */ /* correspondent a la terre et les points a valeurs */ /* positives a la mer. */ /* */ /* */ /*************************************************************************************************************************************/ DEFV(Common,DEFV(Logical,ZINT(Ietche__CoastLines_2D_____explorer_parallelement_la_cote,FAUX))); /* Choix entre le mode parallele de l'exploration de la cote (c'est-a-dire un mode dans */ /* lequel un nombre quelconque de points peuvent etre "etche"s a chaque iteration) et le */ /* "sequentiel" ou "individuel" (c'est-a-dire un mode dans lequel un seul point est "etche" */ /* a chaque iteration). Le 20020531095533, je suis passe de 'VRAI' a 'FAUX' car c'est ce */ /* mode qui semble etre le plus "physique"... */ DEFV(Local,DEFV(Positive,INIT(Ietche__CoastLines_2D_____compteur_de_passage,ZERO))); /* A priori ce dispositif avait ete introduit afin de pouvoir faire varier la graine */ /* effective dans 'GENERATION_D_UN_NOMBRE_ALEATOIRE_D_ETCHE______COTES_2D(...)' de facon */ /* a ce qu'il ne redonne pas la meme 'valeur_aleatoire', en particulier en ce qui concerne */ /* 'liste_des_valeurs_aleatoires_de_selection_du_point_a_etcher'. En fait, il est plus */ /* logique de laisser a l'appelant de 'Ietche__CoastLines_2D_a_temperatures_locales(...)' */ /* cette responsabilite ('v $xci/CoastL_2D.21$K INCREMENT_DES_GRAINES'). */ #define GENERATION_D_UN_NOMBRE_ALEATOIRE_D_ETCHE______COTES_2D(valeur_aleatoire,borne_inferieure,borne_superieure,graine_courante) \ Bblock \ DEFV(pointI_2D,point_courant_de_l_espace_de_parametrage); \ INITIALISATION_POINT_2D(point_courant_de_l_espace_de_parametrage,X,Y); \ /* Point courant de l'espace de parametrage. */ \ \ EGAL(valeur_aleatoire \ ,rdnI2D(ADRESSE(point_courant_de_l_espace_de_parametrage) \ ,graine_courante \ ,RDN_INIT_AND_GENERE \ ,FLOT(borne_inferieure),FLOT(borne_superieure) \ ) \ ); \ /* Generation d'une valeur aleatoire dans [borne_inferieure,borne_superieure] et parametree */ \ /* par le point courant de l'espace de parametrage. On notera que les 'FLOT(...)' relatifs */ \ /* a 'borne_inferieure' et 'borne_superieure' sont essentiels car, en effet, on ne connait */ \ /* pas a priori leur type (aussi bien 'Float' que 'Int'...). */ \ Eblock \ /* Generation d'une valeur aleatoire. */ #define UN_POINT_D_ETCHE______COTES_2D_EST_SUR_LA_TERRE(etat) \ IFLT(etat,NIVEAU______MEDIAN_DANS_Ietche__CoastLines_2D) #define UN_POINT_D_ETCHE______COTES_2D_EST__INDETERMINE(etat) \ IFEQ(etat,NIVEAU______MEDIAN_DANS_Ietche__CoastLines_2D) #define UN_POINT_D_ETCHE______COTES_2D_EST_SUR_LA___MER(etat) \ IFGT(etat,NIVEAU______MEDIAN_DANS_Ietche__CoastLines_2D) /* Pour connaitre le type de localisation du point courant... */ #define ACCES_A_UN_POINT_D_ETCHE______COTES_2D(etat,x,dx,y,dy,ponderation_de_ce_point) \ Bblock \ EGAL(etat \ ,MUL2(ponderation_de_ce_point \ ,FFload_point(imageA \ ,ADD2(x,dx),ADD2(y,dy) \ ,Ietche__CoastLines_2D_____periodiser_X \ ,Ietche__CoastLines_2D_____periodiser_Y \ ,Ietche__CoastLines_2D_____symetriser_X \ ,Ietche__CoastLines_2D_____symetriser_Y \ ,Ietche__CoastLines_2D_____prolonger_X \ ,Ietche__CoastLines_2D_____prolonger_Y \ ,Ietche__CoastLines_2D_____niveau_hors_image \ ) \ ) \ ); \ \ INCR(nombre_d_etats_de_type_terre,COND(UN_POINT_D_ETCHE______COTES_2D_EST_SUR_LA_TERRE(etat),I,ZERO)); \ INCR(nombre_d_etats__indetermines,COND(UN_POINT_D_ETCHE______COTES_2D_EST__INDETERMINE(etat),I,ZERO)); \ INCR(nombre_d_etats_de_type___mer,COND(UN_POINT_D_ETCHE______COTES_2D_EST_SUR_LA___MER(etat),I,ZERO)); \ /* Comptabilite des differents signes possibles de l'"etat". */ \ \ INCR(moyenne_des_etats_de_type_terre,COND(UN_POINT_D_ETCHE______COTES_2D_EST_SUR_LA_TERRE(etat),etat,FZERO)); \ INCR(moyenne_des_etats__indetermines,COND(UN_POINT_D_ETCHE______COTES_2D_EST__INDETERMINE(etat),etat,FZERO)); \ INCR(moyenne_des_etats_de_type___mer,COND(UN_POINT_D_ETCHE______COTES_2D_EST_SUR_LA___MER(etat),etat,FZERO)); \ /* Comptabilite des differents "etat"s en vue de calculer leur moyenne. */ \ Eblock \ /* Acces a l'etat associe a un point {x,y}. */ DEFV(Common,DEFV(Logical,ZINT(Ietche__CoastLines_2D_____marquer_les_points_etches_avec_le_taux,VRAI))); DEFV(Common,DEFV(Logical,ZINT(Ietche__CoastLines_2D_____marquer_les_points_etches_avec_le_temps_simule,FAUX))); DEFV(Common,DEFV(Logical,ZINT(Ietche__CoastLines_2D_____marquer_les_points_etches_avec_le_pas_de_temps_simule,FAUX))); DEFV(Common,DEFV(Logical,ZINT(Ietche__CoastLines_2D_____marquer_les_points_etches_arbitrairement,FAUX))); DEFV(Common,DEFV(genere_Float,ZINT(Ietche__CoastLines_2D_____marqueur_des_points_etches ,NIVEAU_DE_LA___MER_DANS_Ietche__CoastLines_2D ) ) ); /* Afin de pouvoir marquer les points "etche"s avec la valeur courante de la force de la mer */ /* ou bien a l'aide d'une valeur arbitraire... */ DEFV(Common,DEFV(genere_Float,ZINT(Ietche__CoastLines_2D_____niveau_de_la___mer,NIVEAU_DE_LA___MER_DANS_Ietche__CoastLines_2D))); DEFV(Common,DEFV(genere_Float,ZINT(Ietche__CoastLines_2D_____niveau_de_la_terre,NIVEAU_DE_LA_TERRE_DANS_Ietche__CoastLines_2D))); #define NIVEAU______MEDIAN_DANS_Ietche__CoastLines_2D \ MOYE(Ietche__CoastLines_2D_____niveau_de_la___mer,Ietche__CoastLines_2D_____niveau_de_la_terre) #define NIVEAU_HORS_IMAGE_DANS_Ietche__CoastLines_2D \ NIVEAU_DE_LA_TERRE_DANS_Ietche__CoastLines_2D /* Niveaux "speciaux"... */ DEFV(Common,DEFV(Logical,ZINT(Ietche__CoastLines_2D_____initialiser,VRAI))); /* Faut-il initialiser le modele ? */ DEFV(Common,DEFV(Logical,ZINT(Ietche__CoastLines_2D_____periodiser_X,FAUX))); DEFV(Common,DEFV(Logical,ZINT(Ietche__CoastLines_2D_____periodiser_Y,FAUX))); /* Options par defaut de periodisation des axes. */ DEFV(Common,DEFV(Logical,ZINT(Ietche__CoastLines_2D_____symetriser_X,FAUX))); DEFV(Common,DEFV(Logical,ZINT(Ietche__CoastLines_2D_____symetriser_Y,FAUX))); /* Options par defaut de symetrisation des axes (introduites le 20050721103950). */ DEFV(Common,DEFV(Logical,ZINT(Ietche__CoastLines_2D_____prolonger_X,FAUX))); DEFV(Common,DEFV(Logical,ZINT(Ietche__CoastLines_2D_____prolonger_Y,FAUX))); /* Options par defaut de prolongement des axes. */ DEFV(Common,DEFV(genere_Float,ZINT(Ietche__CoastLines_2D_____niveau_hors_image,NIVEAU_HORS_IMAGE_DANS_Ietche__CoastLines_2D))); /* Options par defaut du niveau "hors-image". */ DEFV(Common,DEFV(Logical,ZINT(Ietche__CoastLines_2D_____utiliser_un_noyau,FAUX))); /* Options par defaut de choix entre la methode "des quatre plus proches voisins" ('FAUX') */ /* et la methode dite "a noyau" ('VRAI'). */ DEFV(Common,DEFV(Float,ZINT(Ietche__CoastLines_2D_____ponderation_du_point_sX__Y ,PONDERATION_D_UN_POINT_DANS_Ietche__CoastLines_2D ) ) ); DEFV(Common,DEFV(Float,ZINT(Ietche__CoastLines_2D_____ponderation_du_point__X_sY ,PONDERATION_D_UN_POINT_DANS_Ietche__CoastLines_2D ) ) ); DEFV(Common,DEFV(Float,ZINT(Ietche__CoastLines_2D_____ponderation_du_point_pX__Y ,PONDERATION_D_UN_POINT_DANS_Ietche__CoastLines_2D ) ) ); DEFV(Common,DEFV(Float,ZINT(Ietche__CoastLines_2D_____ponderation_du_point__X_pY ,PONDERATION_D_UN_POINT_DANS_Ietche__CoastLines_2D ) ) ); /* Definition des facteurs des points du voisinage du point courant {X,Y}. */ DEFV(Common,DEFV(Logical,ZINT(Ietche__CoastLines_2D_____initialiser_le_noyau,VRAI))); DEFV(Common,DEFV(Int,ZINT(Ietche__CoastLines_2D_____demi_dimension_effective_du_noyau ,DEMI_DIMENSION_STANDARD_DU_NOYAU_DANS_Ietche__CoastLines_2D ) ) ); DEFV(Common,DEFV(Float,DTb2(Ietche__CoastLines_2D_____noyau,DimNo_Ietche__CoastLines_2D,DimNo_Ietche__CoastLines_2D))); DEFV(Common,DEFV(Float,INIT(POINTERf(PIetche__CoastLines_2D_____noyau) ,ADRESSE(ACCES_NOYAU_DANS_Ietche__CoastLines_2D(Ietche__CoastLines_2D_____XYmin ,Ietche__CoastLines_2D_____XYmin ) ) ) ) ); /* Definition du noyau a utiliser dans 'Ietche__CoastLines_2D(...)', ainsi que d'un */ /* indicateur disant si l'initialisation doit etre faite et de la demi-dimension effective */ /* (inferieure ou egale a 'DEMI_DIMENSION_MAXIMALE_DU_NOYAU_DANS_Ietche__CoastLines_2D') */ /* de ce dernier. */ /* */ /* ATTENTION, la ligne relative a 'DTb2(...)' doit tenir sur une seule ligne a cause de */ /* '$xcg/gen.ext$Z'... */ /* */ /* Le pointeur 'PIetche__CoastLines_2D_____noyau' a ete introduit le 20010222110806 pour */ /* permettre des acces de type 'IloadF_image(...)' au noyau... */ DEFV(Common,DEFV(Int,ZINT(Ietche__CoastLines_2D_____delta_X,ZERO))); DEFV(Common,DEFV(Int,ZINT(Ietche__CoastLines_2D_____delta_Y,ZERO))); /* Translation des points du voisinage du point courant {X,Y}. */ DEFV(Common,DEFV(Float,ZINT(Ietche__CoastLines_2D_____pas_de_temps_simule,FU))); DEFV(Common,DEFV(Float,ZINT(Ietche__CoastLines_2D_____temps_simule,FZERO))); /* Temps simule dont la progression depend du mode d'"etching" defini par */ /* 'Ietche__CoastLines_2D_____explorer_parallelement_la_cote'. L'initialisation a 'FU' */ /* du pas de temps (lui-meme introduit le 20020619101220), et non pas a 'FLOT__UNDEF', est */ /* due au mode 'IL_FAUT(Ietche__CoastLines_2D_____explorer_parallelement_la_cote)'. */ #define NOMBRE_MAXIMAL_DE_POINTS_A_ETCHER_DANS_Ietche__CoastLines_2D \ UN DEFV(Common,DEFV(Positive,ZINT(Ietche__CoastLines_2D_____nombre_maximal_de_points_a_etcher ,NOMBRE_MAXIMAL_DE_POINTS_A_ETCHER_DANS_Ietche__CoastLines_2D ) ) ); /* Nombre de points a "etcher" a chaque iteration dans le cas ou */ /* 'IL_NE_FAUT_PAS(Ietche__CoastLines_2D_____explorer_parallelement_la_cote)'. */ #define PREMIERE_VALEUR_ALEATOIRE_DE_SELECTION_DU_POINT_A_ETCHER \ INDEX0 #define DERNIERE_VALEUR_ALEATOIRE_DE_SELECTION_DU_POINT_A_ETCHER \ LSTX(PREMIERE_VALEUR_ALEATOIRE_DE_SELECTION_DU_POINT_A_ETCHER \ ,Ietche__CoastLines_2D_____nombre_maximal_de_points_a_etcher \ ) /* Premier et dernier niveaux differents. */ #define LISTE_DES_VALEURS_ALEATOIRES(index) \ IdTb1(liste_des_valeurs_aleatoires_de_selection_du_point_a_etcher \ ,INDX(index,PREMIERE_VALEUR_ALEATOIRE_DE_SELECTION_DU_POINT_A_ETCHER) \ ,Ietche__CoastLines_2D_____nombre_maximal_de_points_a_etcher \ ) /* Procedures d'acces aux differentes listes... */ DEFV(Common,DEFV(Positive,INIT(Ietche__CoastLines_2D_____nombre_de_points_sur_la_frontiere,UNDEF))); /* Afin de connaitre le nombre de points sur la frontiere (cela peut toujours servir...). */ #define NOMBRE_COURANT_D_ETCHERS_DANS_Ietche__CoastLines_2D \ F_PETIT_INFINI DEFV(Common,DEFV(Float,ZINT(Ietche__CoastLines_2D_____nombre_courant_d_etchers ,NOMBRE_COURANT_D_ETCHERS_DANS_Ietche__CoastLines_2D ) ) ); DEFV(Common,DEFV(Positive,INIT(Ietche__CoastLines_2D_____numero_du_point_etche_courant_lors_de_l_iteration_courante,UNDEF))); DEFV(Common,DEFV(Positive,INIT(Ietche__CoastLines_2D_____nombre_de_points_etches_lors_de_l_iteration_courante,UNDEF))); /* Afin de savoir combien il y a d'"etchers" a un instant donne et de points qui ont ete */ /* "etches" lors de l'iteration courante. On notera l'initialisation avec 'INFINI' due a */ /* 'v $xci/CoastL_2D.21$K IZGT.Ietche__CoastLines_2D_____nombre_courant_d_etchers'. */ /* On notera le 'Float' introduit le 20020522100014 afin de permettre de tres grandes */ /* valeurs pour 'Ietche__CoastLines_2D_____nombre_courant_d_etchers' qui n'est en fait */ /* pas lie au nombre de points des images ; par contre le 'Positive' suffit pour */ /* 'Ietche__CoastLines_2D_____nombre_de_points_etches_lors_de_l_iteration_courante' qui */ /* lui ne peut execeder 'dimXY'... */ /* */ /* Le numero du point "etche" courant a ete introduit le 20020711090422 afin de permettre */ /* l'edition des coordonnees des points "etche"s... */ DEFV(Common,DEFV(Logical,ZINT(Ietche__CoastLines_2D_____editer_les_coordonnees_des_points_parmi_les_nombres_utiles,VRAI))); /* Afin de permettre, dans le cas ou 'IL_FAUT(editer_quelques_nombres_utiles)', l'edition */ /* des coordonnees des points "etche"s (introduit le 20020711090422). */ #define TEMPERATURE_LOCALE(x,y) \ loadF_point(temperature_locale,x,y) \ /* Acces aux caracteristiques de la terre et de la mer associees a un point {x,y}. */ DEFV(Common,DEFV(Float,ZINT(Ietche__CoastLines_2D_____concentration_initiale_d_etchers,FU))); /* Concentration initiale d'"etcher"s. On notera qu'en fait ce parametre ne sert */ /* pratiquement a rien ('v $xiii/di_image$FON 20020604114847'). */ DEFV(Common,DEFV(Float,ZINT(Ietche__CoastLines_2D_____frequence_de_la_reaction,FU))); /* Frequence "omega" de la reaction. On notera qu'en fait ce parametre ne sert */ /* pratiquement a rien ('v $xiii/di_image$FON 20020604114847'). */ DEFV(Common,DEFV(Float,ZINT(Ietche__CoastLines_2D_____energie_minimale,FZERO))); DEFV(Common,DEFV(Float,ZINT(Ietche__CoastLines_2D_____energie_maximale,FU))); /* Extrema de l'energie. */ DEFV(Common,DEFV(Float,ZINT(Ietche__CoastLines_2D_____constante_de_Boltzmann,CONSTANTE_DE_BOLTZMANN))); /* Constante de Boltzmann (J*K^(-1)). Une valeur de 1 simplifiera les utilisations */ /* des divers parametres (la temperature du modele en particulier). */ #define MARQUAGE_DU_POINT_ETCHE_COURANT_D_ETCHE______COTES_2D \ Bblock \ EGAL(nouvel_etat__X__Y \ ,MEME_SIGNE_QUE \ (Ietche__CoastLines_2D_____niveau_de_la___mer \ ,COND(IL_FAUT(Ietche__CoastLines_2D_____marquer_les_points_etches_avec_le_taux) \ ,taux_d_etching \ ,COND(IL_FAUT(Ietche__CoastLines_2D_____marquer_les_points_etches_avec_le_temps_simule) \ ,ADD2(Ietche__CoastLines_2D_____temps_simule \ ,ABSO(Ietche__CoastLines_2D_____niveau_de_la___mer) \ ) \ ,COND(IL_FAUT(Ietche__CoastLines_2D_____marquer_les_points_etches_avec_le_pas_de_temps_simule) \ ,ADD2(Ietche__CoastLines_2D_____pas_de_temps_simule \ ,ABSO(Ietche__CoastLines_2D_____niveau_de_la___mer) \ ) \ ,COND(IL_FAUT(Ietche__CoastLines_2D_____marquer_les_points_etches_arbitrairement) \ ,Ietche__CoastLines_2D_____marqueur_des_points_etches \ ,Ietche__CoastLines_2D_____niveau_de_la___mer \ ) \ ) \ ) \ ) \ ) \ ); \ /* Le point courant {X,Y} est trop faible par rapport a la force de la mer, il disparait */ \ /* en devenant de la mer... */ \ \ Test(IFET(IL_FAUT(editer_quelques_nombres_utiles) \ ,IL_FAUT(Ietche__CoastLines_2D_____editer_les_coordonnees_des_points_parmi_les_nombres_utiles) \ ) \ ) \ Bblock \ CAL3(Prme5(" P(%d)={%+.^^^,%+.^^^}({%d,%d})" \ ,Ietche__CoastLines_2D_____numero_du_point_etche_courant_lors_de_l_iteration_courante \ ,_____cNORMALISE_OX(X),_____cNORMALISE_OY(Y) \ ,X,Y \ ) \ ); \ /* Le 20060105091108, le format "16g" est passe a "^^g" pour plus de souplesse... */ \ /* */ \ /* Le 20091123122720, le format "^^g" est passe a "^^^" pour plus de souplesse... */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ INCR(Ietche__CoastLines_2D_____numero_du_point_etche_courant_lors_de_l_iteration_courante,I); \ INCR(Ietche__CoastLines_2D_____nombre_de_points_etches_lors_de_l_iteration_courante,I); \ /* Un point supplementaire de "terre" a ete "etche" au cours de l'iteration courante... */ \ DECR(Ietche__CoastLines_2D_____nombre_courant_d_etchers,I); \ /* Et il y a un "etcher" de moins... */ \ Eblock \ /* Marquage du point "etche" courant... */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* M O D E L E B I D I M E N S I O N N E L D E C O T E S A V E C " E T C H I N G " */ /* A T E M P E R A T U R E L O C A L E : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(Ietche__CoastLines_2D_a_temperatures_locales(imageR ,imageA ,nombre_maximal_d_etchers ,graine_de_selection_des_points_a_etcher ,temperature_locale ,editer_quelques_nombres_utiles ) ) ) ) DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR=CoastLines(imageA). */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument a traiter par le modele Lignes de Cotes bidimensionnel. */ DEFV(Argument,DEFV(Float,nombre_maximal_d_etchers)); /* Nombre maximal (et initial) d'"etcher"s. */ DEFV(Argument,DEFV(Int,graine_de_selection_des_points_a_etcher)); /* Pour choisir les points a "etcher". */ DEFV(Argument,DEFV(imageF,temperature_locale)); /* Temperature locale. */ DEFV(Argument,DEFV(Logical,editer_quelques_nombres_utiles)); /* Afin de permettre l'edition du nombre d'"etchers" avant "etching" et du nombre de */ /* points "etches" apres "etching". */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Logical,INIT(boucler_sur_le_parcours_de_imageA,VRAI)); /* Afin de pouvoir iterer {begin_image,end_image}. */ DEFV(Logical,INIT(le_cumul_complet_des_taux_d_etching_est_connu,FAUX)); DEFV(Float,INIT(cumul_complet_des_taux_d_etching,FLOT__UNDEF)); /* Cumul des taux 'R' d'"etching" et indicateur de validite lorsqu'ils sont utiles, soit */ /* si 'IL_NE_FAUT_PAS(Ietche__CoastLines_2D_____explorer_parallelement_la_cote)'. */ /*..............................................................................................................................*/ INCR(Ietche__CoastLines_2D_____compteur_de_passage,I); /* Comptage des passages dans 'Ietche__CoastLines_2D_a_temperatures_locales(...)'. */ EGAL(Ietche__CoastLines_2D_____numero_du_point_etche_courant_lors_de_l_iteration_courante,PREMIER_POINT); CLIR(Ietche__CoastLines_2D_____nombre_de_points_etches_lors_de_l_iteration_courante); /* A priori aucun points de "terre" n'a encore ete "etche" au cours de l'iteration courante. */ Test(IL_FAUT(Ietche__CoastLines_2D_____initialiser)) Bblock Test(IFOU(IZLE(nombre_maximal_d_etchers),fN_EST_PAS_ENTIER(nombre_maximal_d_etchers))) Bblock PRINT_ERREUR("le nombre d'\"etcher\"s est incorrect, il vaut :"); CAL1(Prer2("%f et la valeur effectivement utilisee sera %.0f\n" ,nombre_maximal_d_etchers ,Ietche__CoastLines_2D_____nombre_courant_d_etchers ) ); Eblock ATes Bblock Test(IFEQ(Ietche__CoastLines_2D_____nombre_courant_d_etchers,NOMBRE_COURANT_D_ETCHERS_DANS_Ietche__CoastLines_2D)) /* Ce test a ete introduit le 20020606122011 afin de pouvoir separer les initialisations de */ /* de 'Ietche__CoastLines_2D_____nombre_courant_d_etchers' et de 'nombre_maximal_d_etchers' */ /* afin de ne pas perturber le calcul de 'concentration_courante_d_etchers' ci-apres lors */ /* de la reprise des resultats d'une simulation anterieure en tant que conditions Initiales */ /* d'une autre simulation (il est imperatif que 'nombre_maximal_d_etchers' ne change pas et */ /* qu'alors 'Ietche__CoastLines_2D_____nombre_courant_d_etchers' lui soit different... */ Bblock EGAL(Ietche__CoastLines_2D_____nombre_courant_d_etchers,nombre_maximal_d_etchers); Eblock ATes Bblock Eblock ETes Eblock ETes EGAL(Ietche__CoastLines_2D_____initialiser,FAUX); /* L'initialisation est faite... */ Eblock ATes Bblock Eblock ETes Test(IL_FAUT(editer_quelques_nombres_utiles)) Bblock /* ATTENTION : il est imperatif que la "clef" du premier nombre edite soit precedee d'un */ /* espace, afin que les espaces soient des limiteurs des nombre edites ou qu'ils soient */ /* situes dans la liste (premier ou dernier en particulier...). */ CAL3(Prme1(" Temps=%f" ,Ietche__CoastLines_2D_____temps_simule ) ); CAL3(Prme1(" NombreEtchersAvant=%.0f" ,Ietche__CoastLines_2D_____nombre_courant_d_etchers ) ); /* Ainsi, on edite bien 'Ietche__CoastLines_2D_____nombre_courant_d_etchers' apres */ /* l'initialisation du modele (mais pas la valeur obtenue apres la derniere iteration). */ Eblock ATes Bblock Eblock ETes INITIALISATION_EVENTUELLE_DU_NOYAU_DANS_Ietche__CoastLines_2D; /* Initialisation si necessaire du noyau (dans le cas ou il est de plus utilise...). */ Tant(IL_FAUT(boucler_sur_le_parcours_de_imageA)) Bblock DEFV(Float,INIT(cumul_precedent_des_taux_d_etching,FLOT__UNDEF)); DEFV(Float,INIT(cumul_courant_des_taux_d_etching,FZERO)); /* Cumul courant des taux 'R' d'"etching"... */ DEFV(Int,INIT(index_valeur_aleatoire,UNDEF)); DEFV(Float,DdTb1(POINTERf ,liste_des_valeurs_aleatoires_de_selection_du_point_a_etcher ,Ietche__CoastLines_2D_____nombre_maximal_de_points_a_etcher ,fMalo(MUL2(Ietche__CoastLines_2D_____nombre_maximal_de_points_a_etcher,size_Float)) ) ); /* Liste des probabilites associees a chaque point unique a "etcher". On notera que le */ /* 20020603085917 a ete introduite la possibilite d'avoir non plus un seul point "unique", */ /* mais 'Ietche__CoastLines_2D_____nombre_maximal_de_points_a_etcher' de tels points... */ CLIR(Ietche__CoastLines_2D_____nombre_de_points_sur_la_frontiere); /* Afin de connaitre le nombre de points sur la frontiere (cela peut toujours servir...). */ Test(IL_FAUT(Ietche__CoastLines_2D_____explorer_parallelement_la_cote)) Bblock Eblock ATes Bblock Test(EST_VRAI(le_cumul_complet_des_taux_d_etching_est_connu)) Bblock Test(IZLE(Ietche__CoastLines_2D_____nombre_maximal_de_points_a_etcher)) Bblock PRINT_ERREUR("le nombre de points a \"etcher\" doit etre strictement positif"); EGAL(Ietche__CoastLines_2D_____nombre_maximal_de_points_a_etcher ,NOMBRE_MAXIMAL_DE_POINTS_A_ETCHER_DANS_Ietche__CoastLines_2D ); Eblock ATes Bblock Eblock ETes DoIn(index_valeur_aleatoire ,PREMIERE_VALEUR_ALEATOIRE_DE_SELECTION_DU_POINT_A_ETCHER ,DERNIERE_VALEUR_ALEATOIRE_DE_SELECTION_DU_POINT_A_ETCHER ,I ) Bblock GENERATION_D_UN_NOMBRE_ALEATOIRE_D_ETCHE______COTES_2D(LISTE_DES_VALEURS_ALEATOIRES(index_valeur_aleatoire) ,PROBABILITE_NULLE ,PROBABILITE_UNITE ,ADD2(graine_de_selection_des_points_a_etcher ,index_valeur_aleatoire ) ); /* Generation de l'eventuel evenement d'"etching" unique. ATTENTION : cette generation ne */ /* doit etre faite qu'une seule fois par iteration {begin_image,end_image} et ainsi doit */ /* donc etre situee imperativement ici. On notera le 'ADD2(...,index_valeur_aleatoire)' */ /* destine au fait que 'GENERATION_D_UN_NOMBRE_ALEATOIRE_D_ETCHE______COTES_2D(...)' base */ /* sa generation sur les coordonnees {X,Y} courantes qui dans le cas present n'evoluent */ /* evidemment pas dans la boucle 'DoIn(...)' (au passage, ces coordonnees n'ont ici en fait */ /* pas de sens et valent {Xmin,Ymin}...). C'est a cause de cette incrementation que */ /* 'INCREMENT_DES_GRAINES' a ete modifie ('v $xci/CoastL_2D.21$K INCREMENT_DES_GRAINES'). */ Eblock EDoI Eblock ATes Bblock Eblock ETes Eblock ETes begin_image Bblock Test(IZGT(Ietche__CoastLines_2D_____nombre_courant_d_etchers)) Bblock DEFV(Positive,INIT(nombre_d_etats_de_type_terre,ZERO)); DEFV(Positive,INIT(nombre_d_etats__indetermines,ZERO)); DEFV(Positive,INIT(nombre_d_etats_de_type___mer,ZERO)); /* Comptabilite des differents signes possibles de l'"etat". */ DEFV(genere_Float,INIT(moyenne_des_etats_de_type_terre,FZERO)); DEFV(genere_Float,INIT(moyenne_des_etats__indetermines,FZERO)); DEFV(genere_Float,INIT(moyenne_des_etats_de_type___mer,FZERO)); /* Moyenne des differents "etat"s. */ DEFV(genere_Float,INIT(etat__X__Y,FLOT__UNDEF)); DEFV(genere_Float,INIT(nouvel_etat__X__Y,FLOT__UNDEF)); /* Etat du point courant {X,Y} et son etat futur... */ Test(IL_FAUT(Ietche__CoastLines_2D_____utiliser_un_noyau)) Bblock #define Xc \ EnTete_de_sauvegardM ## X #define Yc \ EnTete_de_sauvegardM ## Y /* Memorisation du point courant {Xc,Yc} (on notera que la procedure 'begin_imageQ(...)' */ /* permet d'y acceder via '{SavM_____X,SavM_____Y}). */ DEFV(genere_Float,INIT(etat_iX_jY,FLOT__UNDEF)); /* Etat du point courant du voisinage du point {Xc,Yc}. */ begin_imageQ(DoIn,Ietche__CoastLines_2D_____XYmin_effectif,Ietche__CoastLines_2D_____XYmax_effectif,PasY ,DoIn,Ietche__CoastLines_2D_____XYmin_effectif,Ietche__CoastLines_2D_____XYmax_effectif,PasX ) Bblock /* ATTENTION : dans cette boucle {X,Y} designent l'element courant du noyau, alors que */ /* {Xc,Yc} designent le point courant dont on etudie le voisinage... */ Test(IFET(IZEQ(X),IZEQ(Y))) Bblock ACCES_A_UN_POINT_D_ETCHE______COTES_2D(etat__X__Y ,NEUT(Xc),ZERO ,NEUT(Yc),ZERO ,PONDERATION_D_UN_POINT_DANS_Ietche__CoastLines_2D ); /* Traitement du point courant {Xc,Yc}. */ Eblock ATes Bblock ACCES_A_UN_POINT_D_ETCHE______COTES_2D(etat_iX_jY ,ADD2(Xc,X),Ietche__CoastLines_2D_____delta_X ,ADD2(Yc,Y),Ietche__CoastLines_2D_____delta_Y ,ACCES_NOYAU_DANS_Ietche__CoastLines_2D(X,Y) ); /* Traitement du point courant {Xc+X,Yc+Y} du voisinage du point {Xc,Yc}. */ Eblock ETes Eblock end_imageQ(EDoI,EDoI) #undef Yc #undef Xc Eblock ATes Bblock DEFV(genere_Float,INIT(etat_sX__Y,FLOT__UNDEF)); DEFV(genere_Float,INIT(etat__X_sY,FLOT__UNDEF)); DEFV(genere_Float,INIT(etat_pX__Y,FLOT__UNDEF)); DEFV(genere_Float,INIT(etat__X_pY,FLOT__UNDEF)); /* Etats des voisins du point {X,Y}. */ ACCES_A_UN_POINT_D_ETCHE______COTES_2D(etat__X__Y ,NEUT(X),ZERO ,NEUT(Y),ZERO ,PONDERATION_D_UN_POINT_DANS_Ietche__CoastLines_2D ); ACCES_A_UN_POINT_D_ETCHE______COTES_2D(etat_sX__Y ,SUCX(X),Ietche__CoastLines_2D_____delta_X ,NEUT(Y),Ietche__CoastLines_2D_____delta_Y ,Ietche__CoastLines_2D_____ponderation_du_point_sX__Y ); ACCES_A_UN_POINT_D_ETCHE______COTES_2D(etat__X_sY ,NEUT(X),Ietche__CoastLines_2D_____delta_X ,SUCY(Y),Ietche__CoastLines_2D_____delta_Y ,Ietche__CoastLines_2D_____ponderation_du_point__X_sY ); ACCES_A_UN_POINT_D_ETCHE______COTES_2D(etat_pX__Y ,PREX(X),Ietche__CoastLines_2D_____delta_X ,NEUT(Y),Ietche__CoastLines_2D_____delta_Y ,Ietche__CoastLines_2D_____ponderation_du_point_pX__Y ); ACCES_A_UN_POINT_D_ETCHE______COTES_2D(etat__X_pY ,NEUT(X),Ietche__CoastLines_2D_____delta_X ,PREY(Y),Ietche__CoastLines_2D_____delta_Y ,Ietche__CoastLines_2D_____ponderation_du_point__X_pY ); /* Etats des points utiles avec ponderation eventuelle. */ Eblock ETes EGAL(moyenne_des_etats_de_type_terre,DIVZ(moyenne_des_etats_de_type_terre,FLOT(nombre_d_etats_de_type_terre))); EGAL(moyenne_des_etats__indetermines,DIVZ(moyenne_des_etats__indetermines,FLOT(nombre_d_etats__indetermines))); EGAL(moyenne_des_etats_de_type___mer,DIVZ(moyenne_des_etats_de_type___mer,FLOT(nombre_d_etats_de_type___mer))); /* Moyenne des differents "etat"s. */ EGAL(nouvel_etat__X__Y,etat__X__Y); /* A priori, l'etat du point courant {X,Y} est inchange... */ Test(UN_POINT_D_ETCHE______COTES_2D_EST_SUR_LA_TERRE(etat__X__Y)) /* Cas ou l'on est sur la terre : */ Bblock Test(IFOU(IFGT(ABSO(etat__X__Y),ABSO(Ietche__CoastLines_2D_____niveau_de_la_terre)) ,IFEXff(ABSO(etat__X__Y),COORDONNEE_BARYCENTRIQUE_MINIMALE,COORDONNEE_BARYCENTRIQUE_MAXIMALE) ) ) Bblock PRINT_ERREUR("un niveau de la terre est incorrect, il vaut :"); CAL1(Prer3("niveau(%d,%d) = %g\n",X,Y,etat__X__Y)); Eblock ATes Bblock Eblock ETes Test(IZGT(nombre_d_etats_de_type___mer)) /* Cas ou l'on est sur la frontiere (c'est-a-dire sur un point de la terre qui est au bord */ /* de la mer) : */ Bblock DEFV(Float,INIT(taux_d_etching,FLOT__UNDEF)); /* Taux 'R' d'"etching". */ DEFV(Float,INIT(concentration_courante_d_etchers ,SCAL(Ietche__CoastLines_2D_____concentration_initiale_d_etchers ,nombre_maximal_d_etchers ,Ietche__CoastLines_2D_____nombre_courant_d_etchers ) ) ); /* Concentration courante d'"etcher"s. */ INCR(Ietche__CoastLines_2D_____nombre_de_points_sur_la_frontiere,I); /* Afin de connaitre le nombre de points sur la frontiere (cela peut toujours servir...). */ EGAL(taux_d_etching ,TAUX_D_ETCHE______COTES_ND(concentration_courante_d_etchers ,Ietche__CoastLines_2D_____frequence_de_la_reaction ,Ietche__CoastLines_2D_____energie_minimale ,Ietche__CoastLines_2D_____energie_maximale ,ABSO(etat__X__Y) ,Ietche__CoastLines_2D_____constante_de_Boltzmann ,TEMPERATURE_LOCALE(X,Y) ) ); /* Taux 'R' d'"etching" courant de la forme : */ /* */ /* Em + p.(EM - Em) E */ /* - ------------------ - ----- */ /* k.T k.T */ /* taux = C.F.e = C.F.e */ /* */ /* ou {Em,EM} designent {energie_minimale,energie_maximale} respectivement et 'p' un */ /* parametre de ponderation dans [0,1]. Ainsi, plus l'energie 'E' est elevee (voisine de */ /* 'EM ', 'p' proche de '1'), plus le taux d'activation est faible et moins la reaction */ /* d'"etching" a lieu ; inversement, plus l'energie 'E' est faible (voisine de 'Em', 'p' */ /* proche de 0), plus le taux d'activation est eleve et plus la reaction d'"etching" a lieu. */ /* Enfin, 'C' designe la concentration... */ /* */ /* On notera que par defaut : */ /* */ /* Em = 0 */ /* EM = 1 */ /* F = 1 */ /* */ /* et que la plupart du temps : */ /* */ /* k = 1 */ /* */ /* ('v $xci/CoastL_2D.21$K constante_de_Boltzmann'). */ /* */ /* Dans le cas 'IL_NE_FAUT_PAS(Ietche__CoastLines_2D_____explorer_parallelement_la_cote)', */ /* on notera que lorsque 'EM-Em' est faible (voisin de 1 par exemple), la cote obtenue est */ /* tres peu tourmentee, alors que pour des valeurs plus elevees (100 par exemple), la cote */ /* est tres tourmentee avec des fjords tres longs (et donc des avalanches...). Par contre, */ /* lorsque 'IL_FAUT(Ietche__CoastLines_2D_____explorer_parallelement_la_cote)' les valeurs */ /* fortes de 'EM-Em' donnent tres peu d'evolution, alors que les valeurs faibles de 'EM-Em' */ /* donnent beaucoup de points "etche"s par iteration... */ Test(IL_FAUT(Ietche__CoastLines_2D_____explorer_parallelement_la_cote)) Bblock DEFV(Float,INIT(valeur_aleatoire_de_selection_des_points_a_etcher,FLOT__UNDEF)); /* Valeur aleatoire de choix des points a "etcher". */ GENERATION_D_UN_NOMBRE_ALEATOIRE_D_ETCHE______COTES_2D (valeur_aleatoire_de_selection_des_points_a_etcher ,gTAUX_D_ETCHE______COTES_ND(Ietche__CoastLines_2D_____concentration_initiale_d_etchers ,Ietche__CoastLines_2D_____frequence_de_la_reaction ,MINIMUM_FONCTION_ENERGIE_TEMPERATURE_DE_TAUX_D_ETCHE______COTES_ND ) ,gTAUX_D_ETCHE______COTES_ND(Ietche__CoastLines_2D_____concentration_initiale_d_etchers ,Ietche__CoastLines_2D_____frequence_de_la_reaction ,MAXIMUM_FONCTION_ENERGIE_TEMPERATURE_DE_TAUX_D_ETCHE______COTES_ND ) ,graine_de_selection_des_points_a_etcher ); /* Generation de l'eventuel evenement d'"etching" multiple. */ Test(IFLE(valeur_aleatoire_de_selection_des_points_a_etcher,taux_d_etching)) Bblock MARQUAGE_DU_POINT_ETCHE_COURANT_D_ETCHE______COTES_2D; /* Le point courant est "etche"... */ Eblock ATes Bblock Eblock ETes Eblock ATes Bblock EGAL(cumul_precedent_des_taux_d_etching,cumul_courant_des_taux_d_etching); INCR(cumul_courant_des_taux_d_etching,taux_d_etching); /* Cumul des taux d'"etching". Cette facon de faire permet au premier point d'etre "etche" */ /* (cas ou un element de 'liste_des_valeurs_aleatoires_de_selection_du_point_a_etcher' */ /* est une toute petite valeur...). */ Test(EST_VRAI(le_cumul_complet_des_taux_d_etching_est_connu)) Bblock Test(IFLT(Ietche__CoastLines_2D_____nombre_de_points_etches_lors_de_l_iteration_courante ,Ietche__CoastLines_2D_____nombre_maximal_de_points_a_etcher ) ) Bblock DEFV(Logical,INIT(un_point_a_ete_etche,FAUX)); /* Afin de ne faire qu'un seul "etching" du point courant (si besoin est...). */ DoIn(index_valeur_aleatoire ,PREMIERE_VALEUR_ALEATOIRE_DE_SELECTION_DU_POINT_A_ETCHER ,DERNIERE_VALEUR_ALEATOIRE_DE_SELECTION_DU_POINT_A_ETCHER ,I ) Bblock Test(EST_FAUX(un_point_a_ete_etche)) Bblock Test(IFINof(LISTE_DES_VALEURS_ALEATOIRES(index_valeur_aleatoire) ,DIVZ(cumul_precedent_des_taux_d_etching ,cumul_complet_des_taux_d_etching ) ,DIVZ(cumul_courant_des_taux_d_etching ,cumul_complet_des_taux_d_etching ) ) ) Bblock MARQUAGE_DU_POINT_ETCHE_COURANT_D_ETCHE______COTES_2D; /* Le point courant est "etche". Ce point possede le rang 'k+1' sur la frontiere, tel que : */ /* */ /* ___ _____ */ /* \ \ */ /* / taux(i) / taux(i) */ /* --- ----- */ /* k k+1 */ /* ------------- < RDN <= --------------- */ /* ___ ___ */ /* \ \ */ /* / taux(i) / taux(i) */ /* --- --- */ /* N N */ /* */ /* ou 'N' designe le nombre de point total de la frontiere. On voit qu'ainsi une quantite */ /* importante est la longueur : */ /* */ /* _____ ___ */ /* \ \ */ /* / taux(i) - / taux(i) */ /* ----- --- */ /* k+1 k */ /* */ /* et plus cette longueur est importante, plus le seuil aleatoire 'RDN' a de chance de */ /* tomber dans l'intervalle [k,k+1]. */ /* */ /* On notera que 'taux(i)' etant de la forme : */ /* */ /* taux(i) = C.F.exp(...) */ /* */ /* et etant donne que ci-dessus les quantites utiles sont des rapports de sommes des */ /* 'taux(i)', le produit 'C.F' disparait par simplification au numerateur et au */ /* denominateur. Moralite : 'Ietche__CoastLines_2D_____concentration_initiale_d_etchers' */ /* (la concentration 'C') et 'Ietche__CoastLines_2D_____frequence_de_la_reaction' */ /* (la frequence 'F') sont deux parametres inutiles (decouverte faite le 20020604114847) ; */ /* malgre tout, ils sont conserves d'une part par esprit de generalite et d'autre part */ /* parce que la concentration sert malgre tout pour definir l'echelle de temps lors du */ /* calcul de 'Ietche__CoastLines_2D_____temps_simule' ci-apres... */ /* */ /* ATTENTION : depuis qu'a ete introduite 'LISTE_DES_VALEURS_ALEATOIRES(...)' le */ /* 20020603085917, plusieurs valeurs 'RDN' de la liste aleatoire peuvent se situer */ /* a l'interieur d'un meme intervalle [k,k+1] alors que seule la premiere d'entre-elles */ /* rencontree sera utilisee. Cela explique donc que dans ces conditions que la valeur de */ /* 'Ietche__CoastLines_2D_____nombre_de_points_etches_lors_de_l_iteration_courante' */ /* puisse etre inferieur a 'Ietche__CoastLines_2D_____nombre_maximal_de_points_a_etcher' */ /* en sortie de cette fonction, lorsque l'on est dans ce mode de calcul evidemment... */ EGAL(un_point_a_ete_etche,VRAI); /* Afin de ne faire qu'un seul "etching" du point courant (si besoin est...). */ #define nombre_de_points_etches_lors_de_l_iteration_courante \ Ietche__CoastLines_2D_____nombre_de_points_etches_lors_de_l_iteration_courante \ /* Afin de raccourcir la ligne suivante... */ Test(IFEQ(nombre_de_points_etches_lors_de_l_iteration_courante,UN)) /* ATTENTION : ce test ne peut avoir lieu qu'apres que la mise a jour de ce compteur ait */ /* eu lieu dans 'MARQUAGE_DU_POINT_ETCHE_COURANT_D_ETCHE______COTES_2D'. */ #undef nombre_de_points_etches_lors_de_l_iteration_courante Bblock EGAL(Ietche__CoastLines_2D_____pas_de_temps_simule ,INVZ(cumul_complet_des_taux_d_etching) ); INCR(Ietche__CoastLines_2D_____temps_simule ,Ietche__CoastLines_2D_____pas_de_temps_simule ); /* Enfin, le temps progresse, mais uniquement une seule fois : ce qui explique qu'on le */ /* fasse uniquement pour le premier point. On notera au passage qu'il est possible de */ /* jouer sur l'echelle de temps via 'concentration_courante_d_etchers' (et donc via */ /* 'Ietche__CoastLines_2D_____concentration_initiale_d_etchers') qui ne sert d'ailleurs */ /* qu'ici. */ /* */ /* Le 20020606132935, des tests complexes ont montre que lorsque la valeur absolue de */ /* l'exposant de l'exponentielle calculee dans 'v $xiii/di_image$DEF EXPX.NEGA.DIVZ.BARY.' */ /* est grand (plusieurs dizaines...), alors le 'cumul_complet_des_taux_d_etching' decroit */ /* tres rapidement au cours de la simulation pour atteindre au bout de quelques dizaines de */ /* milliers d'iterations des valeurs inferieures a 10^-13. Pour cela, il suffit d'avoir par */ /* exemple : */ /* */ /* energie_minimale = 0 */ /* energie_maximale = 100 */ /* Boltzmann = 1 */ /* temperature = 2 */ /* */ /* Je l'ai en particulier verifie en faisant quelques editions (de 'taux_d_etching' en */ /* particulier) et surtout en faisant une premiere simulation de N iterations, puis en */ /* la refaisant sous forme de deux simulations successives de N/2 iterations, les resultats */ /* de la premiere ('imageR', nombre d'"etcher"s, graine courante,...) devenant les */ /* conditions initiales de la seconde ; les resultats ainsi obtenus sont identiques a ceux */ /* obtenus par la methode a N iterations. */ /* */ /* C'est la sequence 'v _____xivPdf_14_1/$Fnota 029774_029901' qui a ete utilisee pour */ /* ce test ainsi que les autres decrits ci-apres. */ /* */ /* L'universalite de ce phenomene a pu etre verifiee d'autre part grace au programme */ /* 'v $xu/Kolwankar.K/etchne$vv$f' en lui donnant les valeurs {100,1000} (ce qui correspond */ /* a beta=100 et 1000 particules d'"etcher"s). */ /* */ /* Cela semble donc etre un phenomene normal dont l'une des composantes a pu etre */ /* "simulee" a l'aide du programme 'v $xtc/proba.01$c' ; en effet, dans celui-ci */ /* on tire au sort des nombres aleatoires 'X(i)' uniformement reparti dans [0,100] ; leur */ /* valeur moyenne est approximativement 50.0 qui est bien egale a 100/2. Puis la moyenne */ /* de 'EXP(-X(i))' est calculee : elle vaut 0.010822 ; cela montre que si l'on considere */ /* les nombres 'EXP(-X(i))' comme des valeurs aleatoires, il y en a beaucoup plus qui sont */ /* petites (proches de 0) que de grandes (proches de 1) et meme que de moyennes (proches de */ /* 0.5). Or 'cumul_complet_des_taux_d_etching' est une somme de 'taux_d_etching' ; or ces */ /* 'taux_d_etching' sont des variables aleatoires du type 'EXP(-X(i))' ; alors, lorsque */ /* les valeurs 'X(i)' sont loins d'etre dans [0,1] (et par exemple dans [0,100]), les */ /* 'EXP(-X(i))' sont en general petits et donc plus on en ajoute les uns aux autres, plus */ /* on a de chance d'ajouter des nombres petits. Mais cela n'explique pas, malgre tout, */ /* la decroissance au cours du temps de 'cumul_complet_des_taux_d_etching', puisqu'en */ /* ajoutant toujours davantage de nombres petits, on devrait trouver des cumuls toujours */ /* plus grands. En fait, l'algorithme doit certainement faire converger vers une frontiere */ /* caracterisee par des 'EXP(-X(i))' petits. */ /* */ /* Enfin (et peut-etre surtout), il ne faut surtout pas oublier le facteur multiplicatif */ /* 'concentration_courante_d_etchers' qui figure dans le calcul de 'taux_d_etching' ; or */ /* 'concentration_courante_d_etchers' decroit au cours du temps (par definition...) ce */ /* qui fait qu'en chaque point, 'taux_d_etching' calcule via la procedure definie dans */ /* 'v $xiii/di_image$DEF EXPX.NEGA.DIVZ.BARY.' decroit lui-aussi au cours du temps. Ainsi, */ /* le cumul 'cumul_complet_des_taux_d_etching' des 'taux_d_etching' peut effectivement */ /* decroitre au cours du temps, contrairement a ce que l'intuition laisse supposer... */ Eblock ATes Bblock Eblock ETes Eblock ATes Bblock Eblock ETes Eblock ATes Bblock Eblock ETes Eblock EDoI Eblock ATes Bblock Eblock ETes Eblock ATes Bblock Eblock ETes Eblock ETes Eblock ATes Bblock Eblock ETes Eblock ATes Bblock Eblock ETes Test(IFOU(IL_FAUT(Ietche__CoastLines_2D_____explorer_parallelement_la_cote) ,IFET(IL_NE_FAUT_PAS(Ietche__CoastLines_2D_____explorer_parallelement_la_cote) ,EST_VRAI(le_cumul_complet_des_taux_d_etching_est_connu) ) ) ) Bblock storeF_point(nouvel_etat__X__Y ,imageR ,X,Y ); /* Nouvel etat du point courant {X,Y}... */ Eblock ATes Bblock Eblock ETes Eblock ATes Bblock Eblock ETes Eblock end_image Test(IL_FAUT(Ietche__CoastLines_2D_____explorer_parallelement_la_cote)) Bblock EGAL(boucler_sur_le_parcours_de_imageA,FAUX); /* On a fini de parcourir 'imageA'... */ Eblock ATes Bblock Test(EST_FAUX(le_cumul_complet_des_taux_d_etching_est_connu)) Bblock EGAL(cumul_complet_des_taux_d_etching,cumul_courant_des_taux_d_etching); EGAL(le_cumul_complet_des_taux_d_etching_est_connu,VRAI); /* Maintenant le cumul des taux d'"etching" est connu, mais il faut encore boucler sur */ /* le parcours de 'imageA'... */ TesF(IZEQ(cumul_complet_des_taux_d_etching)) /* Ce test a ete "virtuellement" supprime le 20020710165851 (en remplacant 'Test(...)' par */ /* 'TesF(...)'), car cette situation est normale et correspond a l'epuisement des "etcher"s. */ Bblock PRINT_ERREUR("le cumul complet des taux d'\"etching\" est nul"); Eblock ATes Bblock Eblock ETes Eblock ATes Bblock TesF(IZEQ(Ietche__CoastLines_2D_____nombre_de_points_etches_lors_de_l_iteration_courante)) /* Ce test a ete "virtuellement" supprime le 20020710165851 (en remplacant 'Test(...)' par */ /* 'TesF(...)'), car cette situation est normale et correspond a l'epuisement des "etcher"s. */ Bblock PRINT_ERREUR("aucun point a \"etcher\" n'a ete trouve"); CAL1(Prer1("cumul complet des taux d_etching.. = %g\n",cumul_complet_des_taux_d_etching)); CAL1(Prer1("cumul precedent des taux d_etching = %g\n",cumul_precedent_des_taux_d_etching)); CAL1(Prer1("cumul courant des taux d_etching.. = %g\n",cumul_courant_des_taux_d_etching)); Eblock ATes Bblock Eblock ETes EGAL(boucler_sur_le_parcours_de_imageA,FAUX); /* On a fini de parcourir 'imageA'... */ Eblock ETes Eblock ETes FdTb1(liste_des_valeurs_aleatoires_de_selection_du_point_a_etcher ,Ietche__CoastLines_2D_____nombre_maximal_de_points_a_etcher ,Float ,ADRESSE_PLUS_DEFINIE ); /* Liberation de la liste des probabilites associees a chaque point unique a "etcher". */ /* */ /* Le 'ADRESSE_PLUS_DEFINIE' a ete introduit le 20050221164113... */ Eblock ETan Test(IL_FAUT(Ietche__CoastLines_2D_____explorer_parallelement_la_cote)) Bblock INCR(Ietche__CoastLines_2D_____temps_simule,Ietche__CoastLines_2D_____pas_de_temps_simule); /* Enfin, le temps progresse... */ Eblock ATes Bblock Eblock ETes Test(IL_FAUT(editer_quelques_nombres_utiles)) Bblock CAL3(Prme1(" NombreEtchesApres=%d" ,Ietche__CoastLines_2D_____nombre_de_points_etches_lors_de_l_iteration_courante ) ); /* Ainsi, on edite bien le nombre de points "etches" lors de l'iteration courante... */ Test(IL_FAUT(Ietche__CoastLines_2D_____marquer_les_points_etches_arbitrairement)) Bblock CAL3(Prme1(" NiveauMarquage=%.^^^" ,Ietche__CoastLines_2D_____marqueur_des_points_etches ) ); /* Ceci a ete introduit le 20020527101710 afin de permettre de faire au retour, par exemple, */ /* des renormalisations en connaissant le dernier niveau de marquage (le premier etant */ /* evidemment connu puisque c'est un argument initial...). */ /* */ /* Le 20060106160816, le format "16f" est passe a "^^f" pour plus de souplesse... */ /* */ /* Le 20091123122720, le format "^^g" est passe a "^^^" pour plus de souplesse... */ Eblock ATes Bblock Eblock ETes CAL3(Prme1(" PasDeTemps=%f" ,Ietche__CoastLines_2D_____pas_de_temps_simule ) ); CALS(FPrme0(" \n")); /* L'espace devant le changement de ligne a ete introduit le 20020619135547 et c'est a */ /* cette date qu'ont ete supprimees les virgules de separation entre entites editees. */ /* Ceci est en fait destine a faciliter la recuperation automatique de ces entites qui */ /* sont donc systematiquement precedees et suivies par un espace... */ /* */ /* ATTENTION : il est donc imperatif que la "clef" du dernier nombre edite soit suivie d'un */ /* espace, afin que les espaces soient des limiteurs des nombre edites ou qu'ils soient */ /* situes dans la liste (premier ou dernier en particulier...). */ Eblock ATes Bblock Eblock ETes RETIF(imageR); Eblock EFonctionF #undef MARQUAGE_DU_POINT_ETCHE_COURANT_D_ETCHE______COTES_2D #undef TEMPERATURE_LOCALE #undef LISTE_DES_VALEURS_ALEATOIRES #undef NOMBRE_COURANT_D_ETCHERS_DANS_Ietche__CoastLines_2D #undef DERNIERE_VALEUR_ALEATOIRE_DE_SELECTION_DU_POINT_A_ETCHER #undef PREMIERE_VALEUR_ALEATOIRE_DE_SELECTION_DU_POINT_A_ETCHER #undef NOMBRE_MAXIMAL_DE_POINTS_A_ETCHER_DANS_Ietche__CoastLines_2D #undef NIVEAU_HORS_IMAGE_DANS_Ietche__CoastLines_2D #undef NIVEAU______MEDIAN_DANS_Ietche__CoastLines_2D #undef ACCES_A_UN_POINT_D_ETCHE______COTES_2D #undef UN_POINT_D_ETCHE______COTES_2D_EST_SUR_LA___MER #undef UN_POINT_D_ETCHE______COTES_2D_EST__INDETERMINE #undef UN_POINT_D_ETCHE______COTES_2D_EST_SUR_LA_TERRE #undef GENERATION_D_UN_NOMBRE_ALEATOIRE_D_ETCHE______COTES_2D /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* M O D E L E B I D I M E N S I O N N E L D E C O T E S A V E C " E T C H I N G " */ /* A T E M P E R A T U R E G L O B A L E : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(Ietche__CoastLines_2D(imageR ,imageA ,nombre_maximal_d_etchers ,graine_de_selection_des_points_a_etcher ,temperature_globale ,editer_quelques_nombres_utiles ) ) ) ) DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR=CoastLines(imageA). */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument a traiter par le modele Lignes de Cotes bidimensionnel. */ DEFV(Argument,DEFV(Float,nombre_maximal_d_etchers)); /* Nombre maximal (et initial) d'"etcher"s. */ DEFV(Argument,DEFV(Int,graine_de_selection_des_points_a_etcher)); /* Pour choisir les points a "etcher". */ DEFV(Argument,DEFV(Float,temperature_globale)); /* Temperature globale de la terre. */ DEFV(Argument,DEFV(Logical,editer_quelques_nombres_utiles)); /* Afin de permettre l'edition du nombre d'"etchers" avant "etching" et du nombre de */ /* points "etches" apres "etching". */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock BDEFV(imageF,temperature_locale); /* Image flottante donnant la temperature en chaque point {X,Y}. */ /*..............................................................................................................................*/ CALS(IFinitialisation(temperature_locale,temperature_globale)); /* Initialisation du taux d'affaiblissement de la terre de facon uniforme. */ CALS(Ietche__CoastLines_2D_a_temperatures_locales(imageR ,imageA ,nombre_maximal_d_etchers ,graine_de_selection_des_points_a_etcher ,temperature_locale ,editer_quelques_nombres_utiles ) ); /* Et calcul avec la meme temperature en chaque point {X,Y} de la terre. */ EDEFV(imageF,temperature_locale); /* Image flottante donnant la temperature en chaque point {X,Y}. */ RETIF(imageR); Eblock EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* J E U D E L A V I E S T A N D A R D : */ /* */ /* */ /* Definition : */ /* */ /* Dans le jeu de la vie standard de Conway, */ /* une particule nait lorsqu'une case vide est */ /* entouree d'exactement trois cases occupees. */ /* Une particule meurt soit par "solitude" (moins */ /* de deux cases voisinnes occupees) ou par "etouffement" */ /* (plus de trois cases voisinnes occupees). */ /* */ /* */ /* Quelques configurations : */ /* */ /* 1-stables : */ /* */ /* ** */ /* ** */ /* */ /* * */ /* * * */ /* * */ /* */ /* ** */ /* * * */ /* * * */ /* ** */ /* */ /* */ /* 2-clignotantes : */ /* */ /* * */ /* * */ /* * */ /* */ /* */ /* 3-glissantes : */ /* */ /* * */ /* * */ /* *** */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(Int,SINT(Ijeu_de_la_vie_____NpasX,UN))); DEFV(Common,DEFV(Int,SINT(Ijeu_de_la_vie_____NpasY,UN))); /* Afin de pouvoir "etaler" la definition des premiers et seconds voisins (ceci a ete */ /* introduit le 20120305145638... */ #define COMPTAGE_DES_VOISINS_DANS_LE_JEU_DE_LA_VIE_BIDIMENSIONNEL(x,y) \ Bblock \ DEFV(genere_p,INIT(niveau_courant_du_voisinage \ ,Fload_point(imageA \ ,x,y \ ,Ijeu_de_la_vie_____periodiser_X,Ijeu_de_la_vie_____periodiser_Y \ ,Ijeu_de_la_vie_____symetriser_X,Ijeu_de_la_vie_____symetriser_Y \ ,Ijeu_de_la_vie_____prolonger_X,Ijeu_de_la_vie_____prolonger_Y \ ,Ijeu_de_la_vie_____niveau_hors_image \ ) \ ) \ ); \ /* Niveau courant du voisinage du point courant {X,Y}. */ \ \ Test(IFNE(niveau_courant_du_voisinage,Ijeu_de_la_vie_____niveau_de_mort)) \ Bblock \ INCR(nombre_de_voisins,I); \ /* Le point {x,y} est un voisin de {X,Y} quel que soit son niveau a condition qu'il soit */ \ /* different de 'Ijeu_de_la_vie_____niveau_de_mort'. */ \ EGAL(niveau_minimal_du_voisinage,MIN2(niveau_minimal_du_voisinage,niveau_courant_du_voisinage)); \ EGAL(niveau_maximal_du_voisinage,MAX2(niveau_maximal_du_voisinage,niveau_courant_du_voisinage)); \ /* Niveaux extremaux du voisinage du point courant {X,Y}. */ \ EGAL(niveau_OUEX_du_voisinage,VEOR(niveau_OUEX_du_voisinage,niveau_courant_du_voisinage)); \ /* Niveau "plaisant" du voisinage du point courant {X,Y}. */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ /* Comptage des voisins du point courant {X,Y}. */ #define LA_CELLULE_EST_MORTE__ \ IFEQ(niveau_de_la_generation_courante,Ijeu_de_la_vie_____niveau_de_mort) #define LA_CELLULE_EST_VIVANTE \ IFNE(niveau_de_la_generation_courante,Ijeu_de_la_vie_____niveau_de_mort) /* Comment sait-on qu'une cellule est vivante ou morte (introduit le 20120229135036) ? */ #define NIVEAU_DE_MORT_DE_Ijeu_de_la_vie \ NOIR #define NIVEAU_DE_VIE_DE_Ijeu_de_la_vie \ BLANC /* Niveaux "speciaux"... */ DEFV(Common,DEFV(Logical,SINT(Ijeu_de_la_vie_____periodiser_X,FAUX))); DEFV(Common,DEFV(Logical,SINT(Ijeu_de_la_vie_____periodiser_Y,FAUX))); /* Options par defaut de periodisation des axes. */ DEFV(Common,DEFV(Logical,SINT(Ijeu_de_la_vie_____symetriser_X,FAUX))); DEFV(Common,DEFV(Logical,SINT(Ijeu_de_la_vie_____symetriser_Y,FAUX))); /* Options par defaut de symetrisation des axes (introduites le 20050721103950). */ DEFV(Common,DEFV(Logical,SINT(Ijeu_de_la_vie_____prolonger_X,FAUX))); DEFV(Common,DEFV(Logical,SINT(Ijeu_de_la_vie_____prolonger_Y,FAUX))); /* Options par defaut de prolongement des axes. */ DEFV(Common,DEFV(genere_p,SINT(Ijeu_de_la_vie_____niveau_hors_image,NIVEAU_DE_MORT_DE_Ijeu_de_la_vie))); /* Options par defaut du niveau "hors-image". */ DEFV(Common,DEFV(genere_p,SINT(Ijeu_de_la_vie_____niveau_de_mort,NIVEAU_DE_MORT_DE_Ijeu_de_la_vie))); DEFV(Common,DEFV(genere_p,SINT(Ijeu_de_la_vie_____niveau_de_vie,NIVEAU_DE_VIE_DE_Ijeu_de_la_vie))); /* Definition des niveaux associes a la mort et a la vie. ATTENTION, de ces deux niveaux */ /* seul 'Ijeu_de_la_vie_____niveau_de_mort' a un sens "absolu" : un site qui possede ce */ /* niveau est bien mort. Alors que 'Ijeu_de_la_vie_____niveau_de_vie' n'est pas le seul */ /* niveau a designer l'etat vivant (en fait, tout niveau qui a une valeur differente de */ /* 'Ijeu_de_la_vie_____niveau_de_mort' designe un etat "vivant"). En fait, le niveau */ /* 'Ijeu_de_la_vie_____niveau_de_vie' ne sert qu'eventuellement lors de la naissance d'un */ /* site, lorsqu'il n'y a pas d'autre niveau a lui attribuer... */ DEFV(Common,DEFV(Positive,SINT(Ijeu_de_la_vie_____seuil_de_solitude,DEUX))); DEFV(Common,DEFV(Positive,SINT(Ijeu_de_la_vie_____seuil_de_naissance,TROIS))); DEFV(Common,DEFV(Positive,SINT(Ijeu_de_la_vie_____seuil_d_etouffement,TROIS))); /* Quelques seuils utiles... */ #define LONGUEUR_DES_LISTES_DE_CHANGEMENT_D_ETAT \ NBRE(NOMBRE_MINIMAL_DE_VOISINS_DE_Ijeu_de_la_vie,NOMBRE_MAXIMAL_DE_VOISINS_DE_Ijeu_de_la_vie) \ /* Definition introduite le 20120303081812... */ #define ACCES_LISTE_DE_CHANGEMENT_D_ETAT(liste,nombre_de_voisins) \ ITb0(liste \ ,TRON(ADD2(SOUS(nombre_de_voisins,NOMBRE_MINIMAL_DE_VOISINS_DE_Ijeu_de_la_vie),PREMIER_CARACTERE) \ ,PREMIER_CARACTERE \ ,LSTX(PREMIER_CARACTERE,chain_Xtaille(liste)) \ ) \ ) DEFV(Common,DEFV(Positive,SINT(Ijeu_de_la_vie_____definir_les_seuils_a_l_aide_de_listes,FAUX))); DEFV(Common,DEFV(CHAR,INIT(POINTERc(Ijeu_de_la_vie_____liste_pour_les_cellules_mortes__) ,"000100000" ) ) ); DEFV(Common,DEFV(CHAR,INIT(POINTERc(Ijeu_de_la_vie_____liste_pour_les_cellules_vivantes) ,"110011111" ) ) ); /* Definition des seuils via des listes (introduites le 20120229135051). */ /* */ /* La definition de ces listes est la suivante : */ /* */ /* NombreVoisins : 012345678 */ /* */ /* CellulesMortes : 000100000 */ /* | */ /* CellulesVivantes : 110011111 */ /* || */ /* ||--------------> seuil_d_etouffement=TROIS */ /* || */ /* | --------------> seuil_de_naissance=TROIS */ /* | */ /* ---------------> seuil_de_solitude=DEUX */ /* */ /* Ces deux listes sont donc indexee par 'NombreVoisins'... */ /* */ /* ATTENTION : 'v $xcg/gen.ext$Z' demande a ce que la valeur initiale des pointeurs ne soit */ /* pas sur la meme ligne que le pointeur lui-meme... */ DEFV(Common,DEFV(Logical,SINT(Ijeu_de_la_vie_____marquer_la_naissance_avec_le_minimum,FAUX))); DEFV(Common,DEFV(Logical,SINT(Ijeu_de_la_vie_____marquer_la_naissance_avec_le_maximum,FAUX))); DEFV(Common,DEFV(Logical,SINT(Ijeu_de_la_vie_____marquer_la_naissance_avec_le_OUEX,FAUX))); /* Choix du coloriage de la naissance. */ DEFV(Common,DEFV(FonctionP,POINTERp(Ijeu_de_la_vie(imageR,imageA)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR=vie(imageA). */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument donnant l'etat courant de l'espace avant son evolution... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ Test(IL_FAUT(Ijeu_de_la_vie_____definir_les_seuils_a_l_aide_de_listes)) /* Test introduit le 20120303080340... */ Bblock Test(IFNE(chain_Xtaille(Ijeu_de_la_vie_____liste_pour_les_cellules_mortes__),LONGUEUR_DES_LISTES_DE_CHANGEMENT_D_ETAT)) Bblock PRINT_ERREUR("la longueur de la liste des cellules mortes est incorrecte, elle est donc ignoree"); CAL1(Prer1("(la longueur 'standard' est %d)\n",LONGUEUR_DES_LISTES_DE_CHANGEMENT_D_ETAT)); EGAL(Ijeu_de_la_vie_____definir_les_seuils_a_l_aide_de_listes,FAUX); Eblock ATes Bblock Eblock ETes Test(IFNE(chain_Xtaille(Ijeu_de_la_vie_____liste_pour_les_cellules_vivantes),LONGUEUR_DES_LISTES_DE_CHANGEMENT_D_ETAT)) Bblock PRINT_ERREUR("la longueur de la liste des cellules vivantes est incorrecte, elle est donc ignoree"); CAL1(Prer1("(la longueur 'standard' est %d)\n",LONGUEUR_DES_LISTES_DE_CHANGEMENT_D_ETAT)); EGAL(Ijeu_de_la_vie_____definir_les_seuils_a_l_aide_de_listes,FAUX); Eblock ATes Bblock Eblock ETes Eblock ATes Bblock Eblock ETes Test(IL_FAUT(Ijeu_de_la_vie_____definir_les_seuils_a_l_aide_de_listes)) /* Test introduit le 20120303080340... */ Bblock DEFV(Int,INIT(index_de_validation,UNDEF)); /* Index d'extraction dans les deux listes... */ DoIn(index_de_validation,PREMIER_CARACTERE,LSTX(PREMIER_CARACTERE,NOMBRE_MAXIMAL_DE_VOISINS_DE_Ijeu_de_la_vie),I) Bblock DEFV(CHAR,INIT(caractere_liste__cellules_vivantes ,ITb0(Ijeu_de_la_vie_____liste_pour_les_cellules_vivantes ,INDX(index_de_validation,PREMIER_CARACTERE) ) ) ); DEFV(CHAR,INIT(caractere_liste__cellules_mortes__ ,ITb0(Ijeu_de_la_vie_____liste_pour_les_cellules_mortes__ ,INDX(index_de_validation,PREMIER_CARACTERE) ) ) ); Test(IFET(IFNE(caractere_liste__cellules_vivantes,CONSERVER_L_ETAT_D_UNE_CELLULE_DU_JEU_DE_LA_VIE) ,IFNE(caractere_liste__cellules_vivantes,CHANGER___L_ETAT_D_UNE_CELLULE_DU_JEU_DE_LA_VIE) ) ) Bblock PRINT_ERREUR("la liste des cellules vivantes contient des caracteres non reconnus, elle est donc ignoree"); CAL1(Prer2("(caractere '%c' a l'index %d)\n",caractere_liste__cellules_vivantes,index_de_validation)); EGAL(Ijeu_de_la_vie_____definir_les_seuils_a_l_aide_de_listes,FAUX); Eblock ATes Bblock Eblock ETes Test(IFET(IFNE(caractere_liste__cellules_mortes__,CONSERVER_L_ETAT_D_UNE_CELLULE_DU_JEU_DE_LA_VIE) ,IFNE(caractere_liste__cellules_mortes__,CHANGER___L_ETAT_D_UNE_CELLULE_DU_JEU_DE_LA_VIE) ) ) Bblock PRINT_ERREUR("la liste des cellules mortes contient des caracteres non reconnus, elle est donc ignoree"); CAL1(Prer2("(caractere '%c' a l'index %d)\n",caractere_liste__cellules_mortes__,index_de_validation)); EGAL(Ijeu_de_la_vie_____definir_les_seuils_a_l_aide_de_listes,FAUX); Eblock ATes Bblock Eblock ETes Eblock EDoI Eblock ATes Bblock Eblock ETes Test(IL_FAUT(Ijeu_de_la_vie_____definir_les_seuils_a_l_aide_de_listes)) /* Test introduit le 20120303080340... */ Bblock Eblock ATes Bblock Test(IFEXff(Ijeu_de_la_vie_____seuil_de_solitude ,NOMBRE_MINIMAL_DE_VOISINS_DE_Ijeu_de_la_vie ,NOMBRE_MAXIMAL_DE_VOISINS_DE_Ijeu_de_la_vie ) ) /* Validation introduite le 20120227140954... */ Bblock PRINT_ERREUR("le seuil de solitude est en-dehors de ses bornes naturelles"); CAL1(Prer3("(il vaut %d alors que ses bornes inferieure et superieure sont [%d,%d])\n" ,Ijeu_de_la_vie_____seuil_de_solitude ,NOMBRE_MINIMAL_DE_VOISINS_DE_Ijeu_de_la_vie ,NOMBRE_MAXIMAL_DE_VOISINS_DE_Ijeu_de_la_vie ) ); Eblock ATes Bblock Eblock ETes Test(IFEXff(Ijeu_de_la_vie_____seuil_de_naissance ,NOMBRE_MINIMAL_DE_VOISINS_DE_Ijeu_de_la_vie ,NOMBRE_MAXIMAL_DE_VOISINS_DE_Ijeu_de_la_vie ) ) /* Validation introduite le 20120227140954... */ Bblock PRINT_ERREUR("le seuil de naissance est en-dehors de ses bornes naturelles"); CAL1(Prer3("(il vaut %d alors que ses bornes inferieure et superieure sont [%d,%d])\n" ,Ijeu_de_la_vie_____seuil_de_naissance ,NOMBRE_MINIMAL_DE_VOISINS_DE_Ijeu_de_la_vie ,NOMBRE_MAXIMAL_DE_VOISINS_DE_Ijeu_de_la_vie ) ); Eblock ATes Bblock Eblock ETes Test(IFEXff(Ijeu_de_la_vie_____seuil_d_etouffement ,NOMBRE_MINIMAL_DE_VOISINS_DE_Ijeu_de_la_vie ,NOMBRE_MAXIMAL_DE_VOISINS_DE_Ijeu_de_la_vie ) ) /* Validation introduite le 20120227140954... */ Bblock PRINT_ERREUR("le seuil d'etouffement est en-dehors de ses bornes naturelles"); CAL1(Prer3("(il vaut %d alors que ses bornes inferieure et superieure sont [%d,%d])\n" ,Ijeu_de_la_vie_____seuil_d_etouffement ,NOMBRE_MINIMAL_DE_VOISINS_DE_Ijeu_de_la_vie ,NOMBRE_MAXIMAL_DE_VOISINS_DE_Ijeu_de_la_vie ) ); Eblock ATes Bblock Eblock ETes Eblock ETes begin_image Bblock DEFV(genere_p,INIT(niveau_de_la_generation_courante,load_point(imageA,X,Y))); /* Niveau courant au point courant de la generation courante. */ DEFV(Int,INIT(nombre_de_voisins,ZERO)); /* Nombre de voisins du point courant. */ DEFV(genere_p,INIT(niveau_minimal_du_voisinage,BLANC)); DEFV(genere_p,INIT(niveau_maximal_du_voisinage,NOIR)); /* Niveaux extremaux du voisinage du point courant. */ DEFV(genere_p,INIT(niveau_OUEX_du_voisinage,NOIR)); /* Niveau "plaisant"... */ DEFV(genere_p,INIT(niveau_de_la_generation_suivante,NIVEAU_UNDEF)); /* Niveau courant au point courant de la generation suivante. */ #define nNEUT(xy,pasXY) \ NEUT(xy) #define _____NpasX \ Ijeu_de_la_vie_____NpasX #define _____NpasY \ Ijeu_de_la_vie_____NpasY /* Afin de raccourcir les lignes qui suivent... */ COMPTAGE_DES_VOISINS_DANS_LE_JEU_DE_LA_VIE_BIDIMENSIONNEL(nSUCX(X,_____NpasX),nNEUT(Y,_____NpasY)); COMPTAGE_DES_VOISINS_DANS_LE_JEU_DE_LA_VIE_BIDIMENSIONNEL(nSUCX(X,_____NpasX),nSUCY(Y,_____NpasY)); COMPTAGE_DES_VOISINS_DANS_LE_JEU_DE_LA_VIE_BIDIMENSIONNEL(nNEUT(X,_____NpasX),nSUCY(Y,_____NpasY)); COMPTAGE_DES_VOISINS_DANS_LE_JEU_DE_LA_VIE_BIDIMENSIONNEL(nPREX(X,_____NpasX),nSUCY(Y,_____NpasY)); COMPTAGE_DES_VOISINS_DANS_LE_JEU_DE_LA_VIE_BIDIMENSIONNEL(nPREX(X,_____NpasX),nNEUT(Y,_____NpasY)); COMPTAGE_DES_VOISINS_DANS_LE_JEU_DE_LA_VIE_BIDIMENSIONNEL(nPREX(X,_____NpasX),nPREY(Y,_____NpasY)); COMPTAGE_DES_VOISINS_DANS_LE_JEU_DE_LA_VIE_BIDIMENSIONNEL(nNEUT(X,_____NpasX),nPREY(Y,_____NpasY)); COMPTAGE_DES_VOISINS_DANS_LE_JEU_DE_LA_VIE_BIDIMENSIONNEL(nSUCX(X,_____NpasX),nPREY(Y,_____NpasY)); /* Comptage des (3^2)-1=8 voisins eventuels. */ #undef _____NpasY #undef _____NpasX #undef nNEUT Test(IFET(LA_CELLULE_EST_MORTE__ ,IFOU(IFET(IL_NE_FAUT_PAS(Ijeu_de_la_vie_____definir_les_seuils_a_l_aide_de_listes) ,IFEQ(nombre_de_voisins,Ijeu_de_la_vie_____seuil_de_naissance) ) ,IFET(IL_FAUT(Ijeu_de_la_vie_____definir_les_seuils_a_l_aide_de_listes) ,IFEQ(ACCES_LISTE_DE_CHANGEMENT_D_ETAT(Ijeu_de_la_vie_____liste_pour_les_cellules_mortes__ ,nombre_de_voisins ) ,CHANGER___L_ETAT_D_UNE_CELLULE_DU_JEU_DE_LA_VIE ) ) ) ) ) Bblock EGAL(niveau_de_la_generation_suivante ,COND(IL_FAUT(Ijeu_de_la_vie_____marquer_la_naissance_avec_le_minimum) ,niveau_minimal_du_voisinage ,COND(IL_FAUT(Ijeu_de_la_vie_____marquer_la_naissance_avec_le_maximum) ,niveau_maximal_du_voisinage ,COND(IL_FAUT(Ijeu_de_la_vie_____marquer_la_naissance_avec_le_OUEX) ,niveau_OUEX_du_voisinage ,Ijeu_de_la_vie_____niveau_de_vie ) ) ) ); /* Naissance du point courant {X,Y}. */ Test(IFEQ(niveau_de_la_generation_suivante,Ijeu_de_la_vie_____niveau_de_mort)) Bblock EGAL(niveau_de_la_generation_suivante,Ijeu_de_la_vie_____niveau_de_vie); /* Ou cas ou 'VEOR(...)' nous ferait des miseres en donnant le niveau de mort... */ Eblock ATes Bblock Eblock ETes Eblock ATes Bblock Test(IFET(LA_CELLULE_EST_VIVANTE ,IFOU(IFET(IL_NE_FAUT_PAS(Ijeu_de_la_vie_____definir_les_seuils_a_l_aide_de_listes) ,IFEXff(nombre_de_voisins ,Ijeu_de_la_vie_____seuil_de_solitude ,Ijeu_de_la_vie_____seuil_d_etouffement ) ) ,IFET(IL_FAUT(Ijeu_de_la_vie_____definir_les_seuils_a_l_aide_de_listes) ,IFEQ(ACCES_LISTE_DE_CHANGEMENT_D_ETAT(Ijeu_de_la_vie_____liste_pour_les_cellules_vivantes ,nombre_de_voisins ) ,CHANGER___L_ETAT_D_UNE_CELLULE_DU_JEU_DE_LA_VIE ) ) ) ) ) /* ATTENTION, on ecrit : */ /* */ /* IFNE(niveau_de_la_generation_courante,Ijeu_de_la_vie_____niveau_de_mort) */ /* */ /* et non pas : */ /* */ /* IFEQ(niveau_de_la_generation_courante,Ijeu_de_la_vie_____niveau_de_vie) */ /* */ /* car en effet de 'Ijeu_de_la_vie_____niveau_de_mort' et 'Ijeu_de_la_vie_____niveau_de_vie' */ /* seul 'Ijeu_de_la_vie_____niveau_de_mort' a un sens "absolu" : un site qui possede ce */ /* niveau est bien mort. Alors que 'Ijeu_de_la_vie_____niveau_de_vie' n'est pas le seul */ /* niveau a designer l'etat vivant (en fait, tout niveau qui a une valeur differente de */ /* 'Ijeu_de_la_vie_____niveau_de_mort' designe un etat "vivant"). En fait, le niveau */ /* 'Ijeu_de_la_vie_____niveau_de_vie' ne sert qu'eventuellement lors de la naissance d'un */ /* site, lorsqu'il n'y a pas d'autre niveau a lui attribuer... */ Bblock EGAL(niveau_de_la_generation_suivante,Ijeu_de_la_vie_____niveau_de_mort); /* Mort du point courant {X,Y}. */ Eblock ATes Bblock EGAL(niveau_de_la_generation_suivante,niveau_de_la_generation_courante); /* Etat stationnaire du point courant {X,Y}. */ Eblock ETes Eblock ETes store_point(niveau_de_la_generation_suivante ,imageR ,X,Y ,FVARIABLE ); /* Et on calcule la generation suivante... */ Eblock end_image RETI(imageR); Eblock #undef ACCES_LISTE_DE_CHANGEMENT_D_ETAT #undef LONGUEUR_DES_LISTES_DE_CHANGEMENT_D_ETAT #undef LA_CELLULE_EST_VIVANTE #undef LA_CELLULE_EST_MORTE__ #undef NIVEAU_DE_MORT_DE_Ijeu_de_la_vie #undef NIVEAU_DE_VIE_DE_Ijeu_de_la_vie #undef COMPTAGE_DES_VOISINS_DANS_LE_JEU_DE_LA_VIE_BIDIMENSIONNEL EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /* :Debut_listMN_ISING_BIDIMENSIONNEL_11: */ /*************************************************************************************************************************************/ /* */ /* M O D E L E D E I S I N G B I D I M E N S I O N N E L : */ /* */ /* */ /* Definition : */ /* */ /* Considerons un ensemble de points */ /* 'P(i)' porteurs chacun d'un spin 'S(i)' */ /* (valant en general -1/2 ou +1/2) */ /* et disposes sur un reseau carre. */ /* A chaque pas de temps, on choisira */ /* aleatoirement quelques points pour */ /* lesquels on evalue la quantite : */ /* */ /* _____ */ /* \ */ /* \ */ /* dE(i) = f.J. / S(i).S(j) */ /* /____ */ /* j */ /* */ /* ou l'indice 'j' parcourt les 4 premiers */ /* voisins de 'P(i)' et ou 'J' designe la constante */ /* de couplage (c'est-a-dire la force de celui-ci) et */ /* 'f' une constante (positive en general, une valeur */ /* negative simulant l'anti-ferromagnetisme). Alors : */ /* */ /* si dE(i) <= 0, 'S(i)' est inverse : S(i) = -S(i) */ /* */ /* dE(i) */ /* - ------- */ /* k.T */ /* sinon, 'S(i)' n'est inverse que si : p < e */ /* */ /* ou 'p' est un nombre aleatoire (dans [0,1]), 'k' */ /* designe la constante de Boltzmann (dont la valeur est */ /* 1.38066e-23 J^1K^-1 mais qui sera en general remplacee */ /* par 1 dans les simulations effectuees) et enfin 'T' */ /* est la temperature "locale". */ /* */ /* Il existe une temperature critique (valable pour */ /* le cas bidimensionnel uniquement) en faisant */ /* f=k=J=1 (pour simplifier) et avec des spins {-1/2,+1/2} : */ /* */ /* 1 */ /* Tc = ------------------- */ /* ___ */ /* 2.A.ln(1 + \/ N ) */ /* */ /* (le facteur 2 au denominateur compense le fait */ /* qu'habituellement la constante 'f' vaut 2...) */ /* avec A=2 (ou 1), suivant que les paires {S(i),S(j)} */ /* et {S(j),S(i)} sont considerees comme identiques (A=2) */ /* (ce qui est le cas dans l'implementation suivante...) */ /* ou differentes (A=1) ; le parametre 'N' donne le nombre */ /* d'etats du spin (en general N=2). On notera au passage */ /* qu'avec des spins {-1,+1}, la temperature critique est */ /* a diviser par (1/2)x(1/2). Enfin, la formule donnant 'Tc' */ /* est demontree pour le cas N=2 et conjecturee en ce qui */ /* concerne les cas N>2. Cette valeur theorique de 'Tc' */ /* correspond a un reseau infini ; pour les reseaux finis */ /* (ce qui est evidemment le cas dans ces simulations), */ /* la valeur de 'Tc' est inferieure... */ /* */ /* Il s'agit d'un systeme auto-organise, ainsi qu'il */ /* possible de le voir dans les simulations. */ /* */ /* Appelons "noyau" (ou "voisinage") la matrice */ /* 3x3 definie comme suit : */ /* */ /* ------- */ /* | 0 1 0 | */ /* | 1 0 1 | */ /* | 0 1 0 | */ /* ------- */ /* */ /* et qui sert a ponderer les spins des (3x3)-1=8 points */ /* voisins d'un point donne (represente par l'element */ /* central de cette matrice). La configuration */ /* ci-dessus correspond effectivement a la recherche */ /* des 4 premiers voisins. Il est alors possible de */ /* generaliser cela et de definir ainsi des noyaux */ /* de dimensions quelconques et contenant des valeurs */ /* arbitraires. Une application de cela est la generation */ /* de certains types de textures bidimensionnelles. */ /* */ /* */ /*************************************************************************************************************************************/ /* :Fin_listMN_ISING_BIDIMENSIONNEL_11: */ #define GENERATION_D_UN_NOMBRE_ALEATOIRE_DU_MODELE_D_ISING_2D(valeur_aleatoire,borne_inferieure,borne_superieure,graine_courante) \ Bblock \ DEFV(pointI_2D,point_courant_de_l_espace_de_parametrage); \ INITIALISATION_POINT_2D(point_courant_de_l_espace_de_parametrage,X,Y); \ /* Point courant de l'espace de parametrage. */ \ \ EGAL(valeur_aleatoire \ ,rdnI2D(ADRESSE(point_courant_de_l_espace_de_parametrage) \ ,graine_courante \ ,RDN_INIT_AND_GENERE \ ,FLOT(borne_inferieure),FLOT(borne_superieure) \ ) \ ); \ /* Generation d'une valeur aleatoire dans [borne_inferieure,borne_superieure] et parametree */ \ /* par le point courant de l'espace de parametrage. On notera que les 'FLOT(...)' relatifs */ \ /* a 'borne_inferieure' et 'borne_superieure' sont essentiels car, en effet, on ne connait */ \ /* pas a priori leur type (aussi bien 'Float' que 'Int'...). */ \ Eblock \ /* Generation d'une valeur aleatoire. */ #define ACCES_A_UN_POINT_DU_MODELE_D_ISING_2D(spin,x,dx,y,dy,ponderation_de_ce_point) \ Bblock \ DEFV(Float,INIT(niveau_normalise,FLOT__UNDEF)); \ EGAL(niveau_normalise \ ,______NORMALISE_NIVEAU(Fload_point(imageA \ ,ADD2(x,dx),ADD2(y,dy) \ ,Imodele_d_Ising_2D_____periodiser_X \ ,Imodele_d_Ising_2D_____periodiser_Y \ ,Imodele_d_Ising_2D_____symetriser_X \ ,Imodele_d_Ising_2D_____symetriser_Y \ ,Imodele_d_Ising_2D_____prolonger_X \ ,Imodele_d_Ising_2D_____prolonger_Y \ ,Imodele_d_Ising_2D_____niveau_hors_image \ ) \ ) \ ); \ EGAL(spin \ ,MUL2(ponderation_de_ce_point \ ,HOMO(niveau_normalise \ ,______________NOIR_NORMALISE,______________BLANC_NORMALISE \ ,Imodele_d_Ising_2D_____spin_negatif,Imodele_d_Ising_2D_____spin_positif \ ) \ ) \ ); \ \ INCR(nombre_de_spins_negatifs,COND(IZLT(spin),I,ZERO)); \ INCR(nombre_de_spins_____nuls,COND(IZEQ(spin),I,ZERO)); \ INCR(nombre_de_spins_positifs,COND(IZGT(spin),I,ZERO)); \ /* Comptabilite des differents signes possibles du "spin" (inutile au 20011203143813). */ \ Eblock \ /* Acces au spin associe a un point {x,y}. */ #define ACCES_A_LA_TEMPERATURE_DU_MODELE_D_ISING_2D(x,y) \ loadF_point(temperature_locale,x,y) \ /* Acces a la temperature associee a un point {x,y}. */ #define NIVEAU_HORS_IMAGE_DANS_Imodele_d_Ising_2D \ NOIR \ /* Niveaux "speciaux"... */ DEFV(Common,DEFV(Logical,ZINT(Imodele_d_Ising_2D_____periodiser_X,FAUX))); DEFV(Common,DEFV(Logical,ZINT(Imodele_d_Ising_2D_____periodiser_Y,FAUX))); /* Options par defaut de periodisation des axes. */ DEFV(Common,DEFV(Logical,ZINT(Imodele_d_Ising_2D_____symetriser_X,FAUX))); DEFV(Common,DEFV(Logical,ZINT(Imodele_d_Ising_2D_____symetriser_Y,FAUX))); /* Options par defaut de symetrisation des axes (introduites le 20050721103950). */ DEFV(Common,DEFV(Logical,ZINT(Imodele_d_Ising_2D_____prolonger_X,FAUX))); DEFV(Common,DEFV(Logical,ZINT(Imodele_d_Ising_2D_____prolonger_Y,FAUX))); /* Options par defaut de prolongement des axes. */ DEFV(Common,DEFV(genere_p,ZINT(Imodele_d_Ising_2D_____niveau_hors_image,NIVEAU_HORS_IMAGE_DANS_Imodele_d_Ising_2D))); /* Options par defaut du niveau "hors-image". */ DEFV(Common,DEFV(Logical,ZINT(Imodele_d_Ising_2D_____utiliser_un_noyau,FAUX))); /* Options par defaut de choix entre la methode "des quatre plus proches voisins" ('FAUX') */ /* et la methode dite "a noyau" ('VRAI'). */ DEFV(Common,DEFV(Float,ZINT(Imodele_d_Ising_2D_____ponderation_du_point_sX__Y,PONDERATION_D_UN_POINT_DANS_Imodele_d_Ising_2D))); DEFV(Common,DEFV(Float,ZINT(Imodele_d_Ising_2D_____ponderation_du_point__X_sY,PONDERATION_D_UN_POINT_DANS_Imodele_d_Ising_2D))); DEFV(Common,DEFV(Float,ZINT(Imodele_d_Ising_2D_____ponderation_du_point_pX__Y,PONDERATION_D_UN_POINT_DANS_Imodele_d_Ising_2D))); DEFV(Common,DEFV(Float,ZINT(Imodele_d_Ising_2D_____ponderation_du_point__X_pY,PONDERATION_D_UN_POINT_DANS_Imodele_d_Ising_2D))); /* Definition des facteurs des points du voisinage du point courant {X,Y}. */ DEFV(Common,DEFV(Logical,ZINT(Imodele_d_Ising_2D_____initialiser_le_noyau,VRAI))); DEFV(Common,DEFV(Int,ZINT(Imodele_d_Ising_2D_____demi_dimension_effective_du_noyau ,DEMI_DIMENSION_STANDARD_DU_NOYAU_DANS_Imodele_d_Ising_2D ) ) ); DEFV(Common,DEFV(Float,DTb2(Imodele_d_Ising_2D_____noyau,DimNo_Imodele_d_Ising_2D,DimNo_Imodele_d_Ising_2D))); DEFV(Common,DEFV(Float,INIT(POINTERf(PImodele_d_Ising_2D_____noyau) ,ADRESSE(ACCES_NOYAU_DANS_Imodele_d_Ising_2D(Imodele_d_Ising_2D_____XYmin ,Imodele_d_Ising_2D_____XYmin ) ) ) ) ); /* Definition du noyau a utiliser dans 'Imodele_d_Ising_2D(...)', ainsi que d'un indicateur */ /* precisant si l'initialisation doit etre faite et de la demi-dimension effective */ /* (inferieure ou egale a 'DEMI_DIMENSION_MAXIMALE_DU_NOYAU_DANS_Imodele_d_Ising_2D') */ /* de ce dernier. */ /* */ /* ATTENTION, la ligne relative a 'DTb2(...)' doit tenir sur une seule ligne a cause de */ /* '$xcg/gen.ext$Z'... */ /* */ /* Le pointeur 'PImodele_d_Ising_2D_____noyau' a ete introduit le 20010222110806 pour */ /* permettre des acces de type 'IloadF_image(...)' au noyau... */ /* */ /* On notera le 20050920143432 que seul le centre du noyau (celui-ci etant defini grace a */ /* 'Imodele_d_Ising_2D_____demi_dimension_effective_du_noyau') est utilise. Ainsi, la */ /* matrice 'PImodele_d_Ising_2D_____noyau' pourra n'etre initialisee qu'en son centre (ce */ /* point existant bien puisque ses dimensions sont impaires...). A cette date, ce point */ /* central a pour d'indices {X=64,Y=64} et ses dimensions sont : */ /* */ /* XYmax 128 128 */ /* */ /* Je note de plus le 20050920143432, que si au lieu d'utiliser les quatre premiers voisins */ /* (cas par defaut 'v $xiii/di_image$FON Imodele_d_Ising_2D_____utiliser_un_noyau'), ce qui */ /* equivaut au noyau : */ /* */ /* ------- */ /* | 0 1 0 | */ /* | 1 0 1 | */ /* | 0 1 0 | */ /* ------- */ /* */ /* on utilise explicitement le noyau : */ /* */ /* ------- */ /* | 1 1 0 | */ /* | 1 0 1 | */ /* | 0 1 1 | */ /* ------- */ /* */ /* ou le noyau : */ /* */ /* ------- */ /* | 0 1 1 | */ /* | 1 0 1 | */ /* | 1 1 0 | */ /* ------- */ /* */ /* cela revient a utiliser les quatre premiers voisins et deux des quatre seconds voisins */ /* opposes, c'est-a-dire un maillage non plus carre, mais hexagonal (a base de triangles */ /* equilateraux...). On rappelera qu'alors dans une situation anti-ferromagnetique, ou */ /* l'on recherche des spins anti-paralleles en ce qui concerne les 6 voisins (sur le reseau */ /* hexagonal), il y a necessairement un tiers des couples de points qui sont "frustres", */ /* c'est-a-dire pour lesquels les spins sont paralleles... */ DEFV(Common,DEFV(Int,ZINT(Imodele_d_Ising_2D_____delta_X,ZERO))); DEFV(Common,DEFV(Int,ZINT(Imodele_d_Ising_2D_____delta_Y,ZERO))); /* Translation des points du voisinage du point courant {X,Y}. */ DEFV(Common,DEFV(Float,ZINT(Imodele_d_Ising_2D_____spin_negatif,NEGA(VALEUR_ABSOLUE_DU_SPIN_DU_MODELE_D_ISING)))); DEFV(Common,DEFV(Float,ZINT(Imodele_d_Ising_2D_____spin_positif,NEUT(VALEUR_ABSOLUE_DU_SPIN_DU_MODELE_D_ISING)))); /* Definition des deux spins "extremes"... */ DEFV(Common,DEFV(Float,ZINT(Imodele_d_Ising_2D_____facteur_de_la_variation_d_energie,NEUT(FU)))); /* Facteur multiplicatif de la variation d'energie. Une valeur positive donne un */ /* comportement de type "ferromagnetique" alors qu'une valeur negative donne quant */ /* a elle un comportement de type "anti-ferromagnetique"... */ /* */ /* Le 20050825111821, lors de la realisation de l'image 'v $xiirk/ISIN.91' et apres avoir */ /* relu le courrier 'v $Dcourrier_in/20001208174958 dE.i..=.2J.S.i..sigma.S.k..', il semble */ /* qu'il serait mieux que ce facteur vaille 2 (et non pas 1) par defaut. Malgre tout, pour */ /* des raisons de compatibilite anterieure, je ne change pas sa valeur par defaut. Cela */ /* a des consequences quant a la valeur de la temperature critique et cela explique le */ /* facteur 2 que j'ai introduit au denominateur de : */ /* */ /* 1 */ /* Tc = ------------------- */ /* ___ */ /* 2.A.ln(1 + \/ N ) */ /* */ /* pour compenser cela... */ DEFV(Common,DEFV(Float,ZINT(Imodele_d_Ising_2D_____constante_de_Boltzmann,CONSTANTE_DE_BOLTZMANN))); /* Constante de Boltzmann (J*K^(-1)). Une valeur de 1 simplifiera les utilisations */ /* ('v $xci/Ising_2D.11$K CONSTANTE_DE_BOLTZMANN_ISING_2D') des divers parametres (la */ /* temperature du modele en particulier). */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* M O D E L E D E I S I N G B I D I M E N S I O N N E L A T E M P E R A T U R E L O C A L E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Imodele_d_Ising_2D_a_temperature_locale(imageR ,imageA ,graine_de_selection_des_points_a_tester ,probabilite_de_selection_des_points_a_tester ,graine_de_selection_des_points_a_basculer ,constante_de_couplage_J ,temperature_locale ) ) ) ) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR=Ising(imageA). */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument a traiter par le modele d'Ising bidimensionnel. */ /* La notion d'increment des graines ci-apres a ete introduite le 20001211134636 afin de */ /* permettre des appels "iteratifs" de 'Imodele_d_Ising_2D(...)' avec la meme graine et */ /* sans que cela cree des artefacts. Une application de cela est de faire une simulation */ /* en deux temps en conservant donc une image intermediaire 'I' ; la poursuite du calcul */ /* sur l'image 'I' se fera en reprenant les memes graines que pour le calcul de 'I', mais */ /* en les incrementant de 'N' ou 'N' est le nombre d'iterations ayant conduit a 'I'... */ DEFV(Argument,DEFV(Int,graine_de_selection_des_points_a_tester)); DEFV(Argument,DEFV(Float,probabilite_de_selection_des_points_a_tester)); /* Pour choisir les points a tester. */ /* */ /* Le 20050830123104, je note qu'une valeur trop importante (par exemple 1/10 telle que la */ /* valeur par defaut de 'v $xci/Ising_2D.11$K PROBABILITE_DE_SELECTION_DES_POINTS_A_TESTER') */ /* pose des problemes ('v $Dcourrier_in/20001208174958 N.est.trop.grand') ; une valeur plus */ /* faible (par exemple 1/100) semble mieux convenir, en particulier au voisinage de la */ /* temperature critique ('v $xiirk/ISIN.A2'). */ DEFV(Argument,DEFV(Int,graine_de_selection_des_points_a_basculer)); /* Pour determiner le basculement du spin des points a tester. */ DEFV(Argument,DEFV(Float,constante_de_couplage_J)); /* Constante de couplage 'J'. */ /* */ /* Le 20050831112247, le symbole 'energie_positive_J' a ete remplace par quelque chose de */ /* plus logique, a savoir 'constante_de_couplage_J'... */ DEFV(Argument,DEFV(imageF,temperature_locale)); /* Temperature locale du modele (c'est-a-dire en chaque point {X,Y}). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ INITIALISATION_EVENTUELLE_DU_NOYAU_DANS_Imodele_d_Ising_2D; /* Initialisation si necessaire du noyau (dans le cas ou il est de plus utilise...). */ begin_image Bblock DEFV(Float,INIT(valeur_aleatoire_courante,FLOT__UNDEF)); /* Valeur aleatoire "multi-usage" courante. */ GENERATION_D_UN_NOMBRE_ALEATOIRE_DU_MODELE_D_ISING_2D(valeur_aleatoire_courante ,PROBABILITE_NULLE ,PROBABILITE_UNITE ,graine_de_selection_des_points_a_tester ); Test(IFLE(valeur_aleatoire_courante,probabilite_de_selection_des_points_a_tester)) Bblock DEFV(Positive,INIT(nombre_de_spins_negatifs,ZERO)); DEFV(Positive,INIT(nombre_de_spins_____nuls,ZERO)); DEFV(Positive,INIT(nombre_de_spins_positifs,ZERO)); /* Comptabilite des differents signes possibles du "spin" (inutile au 20011203143813). */ /* */ /* Le 20061122165533 je note que les trois variables precedentes ont le nom qu'elles ont */ /* afin que ceux-ci aient la meme longueur et ainsi ameliorent la mise en page... */ DEFV(Float,INIT(spin__X__Y,FLOT__UNDEF)); /* Spin du point courant {X,Y}. */ DEFV(Float,INIT(nouveau_spin__X__Y,FLOT__UNDEF)); /* Nouveau spin du point {X,Y}. */ DEFV(Float,INIT(cumul_des_spins_des_voisins_du_point__X__Y,FZERO)); /* Cumul des spins des voisins du point {X,Y}. L'initialisation a 'FZERO' (et non pas */ /* a 'FLOT__UNDEF') est due a l'eventuelle utilisation d'un noyau... */ DEFV(Float,INIT(variation_d_energie,FLOT__UNDEF)); /* Valeur de la variation d'energie. */ Test(IL_FAUT(Imodele_d_Ising_2D_____utiliser_un_noyau)) Bblock #define Xc \ EnTete_de_sauvegardM ## X #define Yc \ EnTete_de_sauvegardM ## Y /* Memorisation du point courant {Xc,Yc} (on notera que la procedure 'begin_imageQ(...)' */ /* permet d'y acceder via '{SavM_____X,SavM_____Y}). */ DEFV(Float,INIT(spin_iX_jY,FLOT__UNDEF)); /* Spin du point courant du voisinage du point {Xc,Yc}. */ begin_imageQ(DoIn,Imodele_d_Ising_2D_____XYmin_effectif,Imodele_d_Ising_2D_____XYmax_effectif,PasY ,DoIn,Imodele_d_Ising_2D_____XYmin_effectif,Imodele_d_Ising_2D_____XYmax_effectif,PasX ) Bblock /* ATTENTION : dans cette boucle {X,Y} designent l'element courant du noyau, alors que */ /* {Xc,Yc} designent le point courant dont on etudie le voisinage... */ Test(IFET(IZEQ(X),IZEQ(Y))) Bblock ACCES_A_UN_POINT_DU_MODELE_D_ISING_2D(spin__X__Y ,NEUT(Xc),ZERO ,NEUT(Yc),ZERO ,PONDERATION_D_UN_POINT_DANS_Imodele_d_Ising_2D ); /* Traitement du point courant {Xc,Yc}. */ Eblock ATes Bblock ACCES_A_UN_POINT_DU_MODELE_D_ISING_2D(spin_iX_jY ,ADD2(Xc,X),Imodele_d_Ising_2D_____delta_X ,ADD2(Yc,Y),Imodele_d_Ising_2D_____delta_Y ,ACCES_NOYAU_DANS_Imodele_d_Ising_2D(X,Y) ); /* Traitement du point courant {Xc+X,Yc+Y} du voisinage du point {Xc,Yc}. */ INCR(cumul_des_spins_des_voisins_du_point__X__Y,spin_iX_jY); /* Et cumul des spins (ponderes...). */ Eblock ETes Eblock end_imageQ(EDoI,EDoI) #undef Yc #undef Xc Eblock ATes Bblock DEFV(Float,INIT(spin_sX__Y,FLOT__UNDEF)); DEFV(Float,INIT(spin__X_sY,FLOT__UNDEF)); DEFV(Float,INIT(spin_pX__Y,FLOT__UNDEF)); DEFV(Float,INIT(spin__X_pY,FLOT__UNDEF)); /* Spins des voisins du point {X,Y}. */ ACCES_A_UN_POINT_DU_MODELE_D_ISING_2D(spin__X__Y ,NEUT(X),ZERO ,NEUT(Y),ZERO ,PONDERATION_D_UN_POINT_DANS_Imodele_d_Ising_2D ); ACCES_A_UN_POINT_DU_MODELE_D_ISING_2D(spin_sX__Y ,SUCX(X),Imodele_d_Ising_2D_____delta_X ,NEUT(Y),Imodele_d_Ising_2D_____delta_Y ,Imodele_d_Ising_2D_____ponderation_du_point_sX__Y ); ACCES_A_UN_POINT_DU_MODELE_D_ISING_2D(spin__X_sY ,NEUT(X),Imodele_d_Ising_2D_____delta_X ,SUCY(Y),Imodele_d_Ising_2D_____delta_Y ,Imodele_d_Ising_2D_____ponderation_du_point__X_sY ); ACCES_A_UN_POINT_DU_MODELE_D_ISING_2D(spin_pX__Y ,PREX(X),Imodele_d_Ising_2D_____delta_X ,NEUT(Y),Imodele_d_Ising_2D_____delta_Y ,Imodele_d_Ising_2D_____ponderation_du_point_pX__Y ); ACCES_A_UN_POINT_DU_MODELE_D_ISING_2D(spin__X_pY ,NEUT(X),Imodele_d_Ising_2D_____delta_X ,PREY(Y),Imodele_d_Ising_2D_____delta_Y ,Imodele_d_Ising_2D_____ponderation_du_point__X_pY ); /* Spins des points utiles avec ponderation eventuelle. */ EGAL(cumul_des_spins_des_voisins_du_point__X__Y ,ADD4(spin_sX__Y ,spin__X_sY ,spin_pX__Y ,spin__X_pY ) ); /* Cumul des spins des voisins du point {X,Y}. */ Eblock ETes EGAL(variation_d_energie ,MUL3(Imodele_d_Ising_2D_____facteur_de_la_variation_d_energie ,constante_de_couplage_J ,MUL2(spin__X__Y ,cumul_des_spins_des_voisins_du_point__X__Y ) ) ); /* Valeur de la variation d'energie obtenue principalement avec les spins des 4 plus proches */ /* voisins. */ Test(IZLE(variation_d_energie)) Bblock EGAL(nouveau_spin__X__Y,NEGA(spin__X__Y)); /* Lorsque la variation d'energie est negative le spin est inverse a priori, puisque cela */ /* abaisse donc l'energie du systeme, ce qu'il "prefere"... */ Eblock ATes Bblock /* Lorsque la variation d'energie est positive, l'inversion du spin est aleatoire : */ GENERATION_D_UN_NOMBRE_ALEATOIRE_DU_MODELE_D_ISING_2D(valeur_aleatoire_courante ,PROBABILITE_NULLE ,PROBABILITE_UNITE ,graine_de_selection_des_points_a_basculer ); Test(IFLE(valeur_aleatoire_courante ,EXPX(NEGA(DIVZ(variation_d_energie ,MUL2(Imodele_d_Ising_2D_____constante_de_Boltzmann ,ACCES_A_LA_TEMPERATURE_DU_MODELE_D_ISING_2D(X,Y) ) ) ) ) ) ) Bblock EGAL(nouveau_spin__X__Y,NEGA(spin__X__Y)); /* Le spin est inverse aleatoirement... */ Eblock ATes Bblock EGAL(nouveau_spin__X__Y,NEUT(spin__X__Y)); /* Le spin est conserve aleatoirement... */ Eblock ETes Eblock ETes store_point(__DENORMALISE_NIVEAU(HOMO(nouveau_spin__X__Y ,Imodele_d_Ising_2D_____spin_negatif,Imodele_d_Ising_2D_____spin_positif ,______________NOIR_NORMALISE,______________BLANC_NORMALISE ) ) ,imageR ,X,Y ,FVARIABLE ); /* Le point courant {X,Y} est modifie... */ Eblock ATes Bblock store_point(load_point(imageA,X,Y) ,imageR ,X,Y ,FVARIABLE ); /* Le point courant {X,Y} n'est pas modifie... */ Eblock ETes Eblock end_image RETI(imageR); Eblock EFonctionP #undef NIVEAU_HORS_IMAGE_DANS_Imodele_d_Ising_2D #undef ACCES_A_LA_TEMPERATURE_DU_MODELE_D_ISING_2D #undef ACCES_A_UN_POINT_DU_MODELE_D_ISING_2D #undef GENERATION_D_UN_NOMBRE_ALEATOIRE_DU_MODELE_D_ISING_2D /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* M O D E L E D E I S I N G B I D I M E N S I O N N E L A T E M P E R A T U R E G L O B A L E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Imodele_d_Ising_2D(imageR ,imageA ,graine_de_selection_des_points_a_tester ,probabilite_de_selection_des_points_a_tester ,graine_de_selection_des_points_a_basculer ,constante_de_couplage_J ,temperature_globale ) ) ) ) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR=Ising(imageA). */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument a traiter par le modele d'Ising bidimensionnel. */ /* La notion d'increment des graines ci-apres a ete introduite le 20001211134636 afin de */ /* permettre des appels "iteratifs" de 'Imodele_d_Ising_2D(...)' avec la meme graine et */ /* sans que cela cree des artefacts. Une application de cela est de faire une simulation */ /* en deux temps en conservant donc une image intermediaire 'I' ; la poursuite du calcul */ /* sur l'image 'I' se fera en reprenant les memes graines que pour le calcul de 'I', mais */ /* en les incrementant de 'N' ou 'N' est le nombre d'iterations ayant conduit a 'I'... */ DEFV(Argument,DEFV(Int,graine_de_selection_des_points_a_tester)); DEFV(Argument,DEFV(Float,probabilite_de_selection_des_points_a_tester)); /* Pour choisir les points a tester. */ DEFV(Argument,DEFV(Int,graine_de_selection_des_points_a_basculer)); /* Pour determiner le basculement du spin des points a tester. */ DEFV(Argument,DEFV(Float,constante_de_couplage_J)); /* Constante de couplage 'J'. */ /* */ /* Le 20050831112247, le symbole 'energie_positive_J' a ete remplace par quelque chose de */ /* plus logique, a savoir 'constante_de_couplage_J'... */ DEFV(Argument,DEFV(Float,temperature_globale)); /* Temperature globale du modele (c'est-a-dire la meme quel que soit le point {X,Y}). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock BDEFV(imageF,temperature_locale); /* Image flottante donnant la temperature en chaque point {X,Y}. */ /*..............................................................................................................................*/ CALS(IFinitialisation(temperature_locale,temperature_globale)); /* Initialisation de la temperature en chaque point {X,Y} de facon uniforme. */ CALS(Imodele_d_Ising_2D_a_temperature_locale(imageR ,imageA ,graine_de_selection_des_points_a_tester ,probabilite_de_selection_des_points_a_tester ,graine_de_selection_des_points_a_basculer ,constante_de_couplage_J ,temperature_locale ) ); /* Et calcul avec la meme temperature en chaque point {X,Y}. */ EDEFV(imageF,temperature_locale); /* Image flottante donnant la temperature en chaque point {X,Y}. */ RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* G R A D I E N T " S I M P L I F I E " D ' U N E I M A G E F L O T T A N T E : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Logical,SINT(IFgradient_simplifie_____evaluer_le_gradient_local_moyen,FAUX))); /* Doit-on evaluer le gradient local moyen ('VRAI') ou bien faire la moyenne des modules */ /* et des arguments des gradients 3x3 ('FAUX'). */ DEFV(Common,DEFV(Logical,SINT(IFgradient_simplifie_____utiliser_les_4_premiers_voisins_et_aussi_les_4_seconds_voisins,FAUX))); /* Indique si l'on doit utiliser uniquement les 4 premiers voisins ('FAUX') ou les 4 */ /* premiers voisins associes aux 4 seconds voisins ('VRAI'). */ DEFV(Common,DEFV(Float,SINT(IFgradient_simplifie_____ponderation_des_voisins___Sud,FU))); DEFV(Common,DEFV(Float,SINT(IFgradient_simplifie_____ponderation_des_voisins_Ouest,FU))); DEFV(Common,DEFV(Float,SINT(IFgradient_simplifie_____ponderation_des_voisins__Nord,FU))); DEFV(Common,DEFV(Float,SINT(IFgradient_simplifie_____ponderation_des_voisins___Est,FU))); /* Ponderation des seconds voisins lorsque */ /* 'IL_FAUT(utiliser_les_4_premiers_voisins_et_aussi_les_4_seconds_voisins_dans_IFgrad...)'. */ DEFV(Common,DEFV(Logical,SINT(IFgradient_simplifie_____normaliser_les_gradients_3x3,FAUX))); /* Indique si l'on doit normaliser les gradients 3x3 ('VRAI') ou les laisser tels qu'ils */ /* sont calcules ('FAUX'). */ DEFV(Common,DEFV(Logical,SINT(IFgradient_simplifie_____calculer_l_histogramme,FAUX))); /* Indique si l'on doit calculer l'histogramme bidimensionnel du gradient ('VRAI') ou bien */ /* au choix le module 'rho' ou l'argument 'theta' ('FAUX'). */ DEFV(Common,DEFV(Logical,SINT(IFgradient_simplifie_____calculer_le_module,VRAI))); /* Indique si l'on doit calculer le module 'rho' ('VRAI') ou l'argument 'theta' ('FAUX'), */ /* et n'a de sens que si 'IL_NE_FAUT_PAS(IFgradient_simplifie_____calculer_l_histogramme)'. */ DEFV(Common,DEFV(Logical,SINT(IFgradient_simplifie_____periodiser_X,FAUX))); DEFV(Common,DEFV(Logical,SINT(IFgradient_simplifie_____periodiser_Y,FAUX))); /* Options par defaut de periodisation des axes. */ DEFV(Common,DEFV(Logical,SINT(IFgradient_simplifie_____symetriser_X,FAUX))); DEFV(Common,DEFV(Logical,SINT(IFgradient_simplifie_____symetriser_Y,FAUX))); /* Options par defaut de symetrisation des axes (introduites le 20050721103950). */ DEFV(Common,DEFV(Logical,SINT(IFgradient_simplifie_____prolonger_X,VRAI))); DEFV(Common,DEFV(Logical,SINT(IFgradient_simplifie_____prolonger_Y,VRAI))); /* Options par defaut de prolongement des axes (on notera le choix de 'VRAI' et non pas de */ /* 'FAUX' car, en effet, cela evite des sauts tres brutaux aux bords comme on peut le voir, */ /* par exemple, avec un champ gaussien...). */ DEFV(Common,DEFV(genere_Float,SINT(IFgradient_simplifie_____niveau_hors_image,FLOT__NOIR))); /* Options par defaut du niveau "hors-image". */ DEFV(Common,DEFV(Logical,SINT(IFgradient_simplifie_____domaine_circulaire,FAUX))); /* Indique si domaine est spherique ('VRAI') ou rectangulaire ('FAUX'). */ DEFV(Common,DEFV(Int,SINT(IFgradient_simplifie_____demi_dimension_X,ZERO))); DEFV(Common,DEFV(Int,SINT(IFgradient_simplifie_____demi_dimension_Y,ZERO))); /* Options par defaut des demi-dimensions du pave autour de {X,Y}. */ DEFV(Common,DEFV(Int,SINT(IFgradient_simplifie_____facteur_du_pas_en_X,UN))); DEFV(Common,DEFV(Int,SINT(IFgradient_simplifie_____facteur_du_pas_en_Y,UN))); /* Options par defaut des pas en {X,Y}. */ DEFV(Common,DEFV(Float,SINT(IFgradient_simplifie_____echelle_en_X_de_l_histogramme,FDU))); DEFV(Common,DEFV(Float,SINT(IFgradient_simplifie_____echelle_en_Y_de_l_histogramme,FDU))); /* Echelle des coordonnees {X,Y} de l'histogramme calculees a partir de {rho,theta} du */ /* gradient. */ DEFV(Common,DEFV(Float,SINT(IFgradient_simplifie_____translation_en_X_de_l_histogramme,FDU))); DEFV(Common,DEFV(Float,SINT(IFgradient_simplifie_____translation_en_Y_de_l_histogramme,FDU))); /* Translation des coordonnees {X,Y} de l'histogramme calculees a partir de {rho,theta} du */ /* gradient. */ #define X_point___Sud \ NEUT(X) #define Y_point___Sud \ nPREY(Y,IFgradient_simplifie_____facteur_du_pas_en_Y) /* Definition du point au "Sud" du point courant {X,Y}. */ #define X_point_Ouest \ nPREX(X,IFgradient_simplifie_____facteur_du_pas_en_X) #define Y_point_Ouest \ NEUT(Y) /* Definition du point au "Ouest" du point courant {X,Y}. */ #define X_point__Nord \ NEUT(X) #define Y_point__Nord \ nSUCY(Y,IFgradient_simplifie_____facteur_du_pas_en_Y) /* Definition du point au "Nord" du point courant {X,Y}. */ #define X_point___Est \ nSUCX(X,IFgradient_simplifie_____facteur_du_pas_en_X) #define Y_point___Est \ NEUT(Y) /* Definition du point au "Est" du point courant {X,Y}. */ DEFV(Common,DEFV(FonctionF,POINTERF(IFgradient_simplifie(imageR,imageA)))) DEFV(Argument,DEFV(imageF,imageR)); /* Image flottante Resultat, telle que : imageR=grad(imageA). */ DEFV(Argument,DEFV(imageF,imageA)); /* Image flottante Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Float,INIT(rayon_du_domaine_circulaire ,MOIT(MAX2(SUCC(IFgradient_simplifie_____demi_dimension_X) ,SUCC(IFgradient_simplifie_____demi_dimension_Y) ) ) ) ); /* Afin de connaitre le rayon du cercle circonscrit au domaine de calcul du gradient. */ /*..............................................................................................................................*/ Test(IL_FAUT(IFgradient_simplifie_____calculer_l_histogramme)) Bblock CALS(IFinitialisation(imageR,FZERO)); /* Initialisation de l'image Resultat a 0. On notera qu'il est assez rare d'initialiser */ /* dans une fonction une image Resultat, mais ici 'imageR' est en fait un compteur et il */ /* est donc essentiel qu'il soit initialise surement a 0. */ Eblock ATes Bblock Eblock ETes begin_image Bblock DEFV(Int,INIT(centre_de_la_boite_X,X)); DEFV(Int,INIT(centre_de_la_boite_Y,Y)); /* Definition du centre de la boite courante. */ DEFV(Int,INIT(nombre_de_points,ZERO)); /* Nombre de points ou le gradient 3x3 a ete calcule dans la boite courante. */ DEFV(deltaF_2D,gradient_local_moyen); /* Definition du vecteur gradient local "simplifie", */ DEFV(Float,INIT(module_du_gradient_local_moyen,FZERO)); DEFV(Float,INIT(argument_du_gradient_local_moyen,FZERO)); /* Et du couple {module,argument} associe... */ Test(IL_FAUT(IFgradient_simplifie_____evaluer_le_gradient_local_moyen)) Bblock INITIALISATION_ACCROISSEMENT_2D(gradient_local_moyen ,FZERO ,FZERO ); /* Initialisation du vecteur gradient local "simplifie". */ Eblock ATes Bblock Eblock ETes begin_imageQ(DoIn ,COYA(SOUS(COYR(centre_de_la_boite_Y),IFgradient_simplifie_____demi_dimension_Y)) ,COYA(ADD2(COYR(centre_de_la_boite_Y),IFgradient_simplifie_____demi_dimension_Y)) ,PasY ,DoIn ,COXA(SOUS(COXR(centre_de_la_boite_X),IFgradient_simplifie_____demi_dimension_X)) ,COXA(ADD2(COXR(centre_de_la_boite_X),IFgradient_simplifie_____demi_dimension_X)) ,PasX ) Bblock DEFV(deltaF_2D,rayon_vecteur_courant); DEFV(Float,INIT(module_du_rayon_vecteur_courant,FZERO)); /* Rayon vecteur du point courant {X,Y,Z} et son module. */ Test(IL_FAUT(IFgradient_simplifie_____domaine_circulaire)) Bblock INITIALISATION_ACCROISSEMENT_2D(rayon_vecteur_courant ,FLOT(SOUS(X,centre_de_la_boite_X)) ,FLOT(SOUS(Y,centre_de_la_boite_Y)) ); EGAL(module_du_rayon_vecteur_courant,longF2D(rayon_vecteur_courant)); /* Calcul du rayon vecteur du point courant {X,Y,Z} et de son module. */ Eblock ATes Bblock Eblock ETes Test(IFOU(IL_NE_FAUT_PAS(IFgradient_simplifie_____domaine_circulaire) ,IFET(IL_FAUT(IFgradient_simplifie_____domaine_circulaire) ,IFLE(module_du_rayon_vecteur_courant ,rayon_du_domaine_circulaire ) ) ) ) Bblock DEFV(genere_Float,INIT(niveau_point___Sud ,FFload_point(imageA ,X_point___Sud,Y_point___Sud ,IFgradient_simplifie_____periodiser_X ,IFgradient_simplifie_____periodiser_Y ,IFgradient_simplifie_____symetriser_X ,IFgradient_simplifie_____symetriser_Y ,IFgradient_simplifie_____prolonger_X ,IFgradient_simplifie_____prolonger_Y ,IFgradient_simplifie_____niveau_hors_image ) ) ); DEFV(genere_Float,INIT(niveau_point_Ouest ,FFload_point(imageA ,X_point_Ouest,Y_point_Ouest ,IFgradient_simplifie_____periodiser_X ,IFgradient_simplifie_____periodiser_Y ,IFgradient_simplifie_____symetriser_X ,IFgradient_simplifie_____symetriser_Y ,IFgradient_simplifie_____prolonger_X ,IFgradient_simplifie_____prolonger_Y ,IFgradient_simplifie_____niveau_hors_image ) ) ); DEFV(genere_Float,INIT(niveau_point__Nord ,FFload_point(imageA ,X_point__Nord,Y_point__Nord ,IFgradient_simplifie_____periodiser_X ,IFgradient_simplifie_____periodiser_Y ,IFgradient_simplifie_____symetriser_X ,IFgradient_simplifie_____symetriser_Y ,IFgradient_simplifie_____prolonger_X ,IFgradient_simplifie_____prolonger_Y ,IFgradient_simplifie_____niveau_hors_image ) ) ); DEFV(genere_Float,INIT(niveau_point___Est ,FFload_point(imageA ,X_point___Est,Y_point___Est ,IFgradient_simplifie_____periodiser_X ,IFgradient_simplifie_____periodiser_Y ,IFgradient_simplifie_____symetriser_X ,IFgradient_simplifie_____symetriser_Y ,IFgradient_simplifie_____prolonger_X ,IFgradient_simplifie_____prolonger_Y ,IFgradient_simplifie_____niveau_hors_image ) ) ); /* Niveaux des 4 premiers points voisins (suivant les pas courants) du point courant {X,Y}. */ DEFV(deltaF_2D,gradient_local_3x3); /* Definition du vecteur gradient local "simplifie" 3x3, */ DEFV(Float,INIT(module_du_gradient_local_3x3,FZERO)); DEFV(Float,INIT(argument_du_gradient_local_3x3,FZERO)); /* Et du couple {module,argument} associe... */ Test(IL_NE_FAUT_PAS(IFgradient_simplifie_____utiliser_les_4_premiers_voisins_et_aussi_les_4_seconds_voisins)) Bblock INITIALISATION_ACCROISSEMENT_2D(gradient_local_3x3 ,DIVI(SOUS(niveau_point___Est,niveau_point_Ouest) ,FLOT(SOUS(X_point___Est,X_point_Ouest)) ) ,DIVI(SOUS(niveau_point__Nord,niveau_point___Sud) ,FLOT(SOUS(Y_point__Nord,Y_point___Sud)) ) ); /* Evaluation du vecteur gradient local "simplifie" 3x3 avec les 4 premiers voisins. */ Eblock ATes Bblock DEFV(genere_Float,INIT(niveau_point___Sud_Ouest ,FFload_point(imageA ,X_point_Ouest,Y_point___Sud ,IFgradient_simplifie_____periodiser_X ,IFgradient_simplifie_____periodiser_Y ,IFgradient_simplifie_____symetriser_X ,IFgradient_simplifie_____symetriser_Y ,IFgradient_simplifie_____prolonger_X ,IFgradient_simplifie_____prolonger_Y ,IFgradient_simplifie_____niveau_hors_image ) ) ); DEFV(genere_Float,INIT(niveau_point__Nord_Ouest ,FFload_point(imageA ,X_point_Ouest,Y_point__Nord ,IFgradient_simplifie_____periodiser_X ,IFgradient_simplifie_____periodiser_Y ,IFgradient_simplifie_____symetriser_X ,IFgradient_simplifie_____symetriser_Y ,IFgradient_simplifie_____prolonger_X ,IFgradient_simplifie_____prolonger_Y ,IFgradient_simplifie_____niveau_hors_image ) ) ); DEFV(genere_Float,INIT(niveau_point__Nord___Est ,FFload_point(imageA ,X_point___Est,Y_point__Nord ,IFgradient_simplifie_____periodiser_X ,IFgradient_simplifie_____periodiser_Y ,IFgradient_simplifie_____symetriser_X ,IFgradient_simplifie_____symetriser_Y ,IFgradient_simplifie_____prolonger_X ,IFgradient_simplifie_____prolonger_Y ,IFgradient_simplifie_____niveau_hors_image ) ) ); DEFV(genere_Float,INIT(niveau_point___Sud___Est ,FFload_point(imageA ,X_point___Est,Y_point___Sud ,IFgradient_simplifie_____periodiser_X ,IFgradient_simplifie_____periodiser_Y ,IFgradient_simplifie_____symetriser_X ,IFgradient_simplifie_____symetriser_Y ,IFgradient_simplifie_____prolonger_X ,IFgradient_simplifie_____prolonger_Y ,IFgradient_simplifie_____niveau_hors_image ) ) ); /* Niveaux des 4 seconds points voisins (suivant les pas courants) du point courant {X,Y}. */ INITIALISATION_ACCROISSEMENT_2D(gradient_local_3x3 ,DIVI(MOY3(MUL2(IFgradient_simplifie_____ponderation_des_voisins___Sud ,SOUS(niveau_point___Sud___Est,niveau_point___Sud_Ouest) ) ,NEUT(SOUS(niveau_point___Est,niveau_point_Ouest)) ,MUL2(IFgradient_simplifie_____ponderation_des_voisins__Nord ,SOUS(niveau_point__Nord___Est,niveau_point__Nord_Ouest) ) ) ,FLOT(SOUS(X_point___Est,X_point_Ouest)) ) ,DIVI(MOY3(MUL2(IFgradient_simplifie_____ponderation_des_voisins_Ouest ,SOUS(niveau_point__Nord_Ouest,niveau_point___Sud_Ouest) ) ,NEUT(SOUS(niveau_point__Nord,niveau_point___Sud)) ,MUL2(IFgradient_simplifie_____ponderation_des_voisins___Est ,SOUS(niveau_point__Nord___Est,niveau_point___Sud___Est) ) ) ,FLOT(SOUS(Y_point__Nord,Y_point___Sud)) ) ); /* Evaluation du vecteur gradient local "simplifie" 3x3 avec les 8 premiers voisins. */ Eblock ETes Test(IL_FAUT(IFgradient_simplifie_____normaliser_les_gradients_3x3)) Bblock NORMALISATION_ACCROISSEMENT_2D(gradient_local_3x3); /* Evaluation finale du vecteur gradient local "simplifie". */ Eblock ATes Bblock Eblock ETes Test(IL_FAUT(IFgradient_simplifie_____evaluer_le_gradient_local_moyen)) Bblock INITIALISATION_ACCROISSEMENT_2D(gradient_local_moyen ,ADD2(ASD1(gradient_local_moyen,dx),ASD1(gradient_local_3x3,dx)) ,ADD2(ASD1(gradient_local_moyen,dy),ASD1(gradient_local_3x3,dy)) ); /* Evaluation du vecteur gradient local "simplifie". */ Eblock ATes Bblock EGAL(module_du_gradient_local_3x3,Rho_2D(ASD1(gradient_local_3x3,dx),ASD1(gradient_local_3x3,dy))); EGAL(argument_du_gradient_local_3x3,Theta_2D(ASD1(gradient_local_3x3,dx),ASD1(gradient_local_3x3,dy))); /* Et du couple {module,argument} associe ; on notera que tout cela n'est pas tres optimise */ /* car ces deux valeurs ne sont pas toutes les deux systematiquement utiles, mais c'est pour */ /* simplifier... */ INCR(module_du_gradient_local_moyen,module_du_gradient_local_3x3); INCR(argument_du_gradient_local_moyen,argument_du_gradient_local_3x3); /* Evaluation progressive du couple {module,argument} moyen... */ Eblock ETes INCR(nombre_de_points,I); /* Comptage des points... */ Eblock ATes Bblock Eblock ETes Eblock end_imageQ(EDoI,EDoI) Test(IZGT(nombre_de_points)) Bblock Test(IL_FAUT(IFgradient_simplifie_____evaluer_le_gradient_local_moyen)) Bblock INITIALISATION_ACCROISSEMENT_2D(gradient_local_moyen ,DIVI(ASD1(gradient_local_moyen,dx),FLOT(nombre_de_points)) ,DIVI(ASD1(gradient_local_moyen,dy),FLOT(nombre_de_points)) ); /* Evaluation finale du vecteur gradient local "simplifie". */ Eblock ATes Bblock EGAL(module_du_gradient_local_moyen,NEUT(DIVI(module_du_gradient_local_moyen,FLOT(nombre_de_points)))); EGAL(argument_du_gradient_local_moyen,CERC(DIVI(argument_du_gradient_local_moyen,FLOT(nombre_de_points)))); /* Evaluation progressive du couple {module,argument} moyen... */ Eblock ETes Eblock ATes Bblock PRINT_ERREUR("le nombre de points utilises pour le calcul d'un gradient 'simplifie' est negatif ou nul"); Eblock ETes Test(IL_FAUT(IFgradient_simplifie_____evaluer_le_gradient_local_moyen)) Bblock EGAL(module_du_gradient_local_moyen,Rho_2D(ASD1(gradient_local_moyen,dx),ASD1(gradient_local_moyen,dy))); EGAL(argument_du_gradient_local_moyen,Theta_2D(ASD1(gradient_local_moyen,dx),ASD1(gradient_local_moyen,dy))); /* Et du couple {module,argument} associe ; on notera que tout cela n'est pas tres optimise */ /* car ces deux valeurs ne sont pas toutes les deux systematiquement utiles, mais c'est pour */ /* simplifier... */ Eblock ATes Bblock Eblock ETes Test(IL_FAUT(IFgradient_simplifie_____calculer_l_histogramme)) Bblock /* Cas ou l'on calcule l'histogramme bidimensionnel du gradient : */ DEFV(Int,INIT(X_de_l_histogramme ,_cDENORMALISE_OX(AXPB(IFgradient_simplifie_____echelle_en_X_de_l_histogramme ,RECTANGLE_OX_PAR_RAPPORT_A_OY(Xcartesienne_2D(module_du_gradient_local_moyen ,argument_du_gradient_local_moyen ) ) ,IFgradient_simplifie_____translation_en_X_de_l_histogramme ) ) ) ); DEFV(Int,INIT(Y_de_l_histogramme ,_cDENORMALISE_OY(AXPB(IFgradient_simplifie_____echelle_en_Y_de_l_histogramme ,RECTANGLE_OY_PAR_RAPPORT_A_OY(Ycartesienne_2D(module_du_gradient_local_moyen ,argument_du_gradient_local_moyen ) ) ,IFgradient_simplifie_____translation_en_Y_de_l_histogramme ) ) ) ); /* Coordonnees {X,Y} de generation de l'histogramme. */ storeF_point_valide(SUCC(loadF_point_valide(imageR,X_de_l_histogramme,Y_de_l_histogramme)) ,imageR ,X_de_l_histogramme,Y_de_l_histogramme ); /* Et generation de l'histogramme... */ Eblock ATes Bblock /* Cas ou l'on calcule le module ou l'argument du gradient : */ storeF_point(COND(IL_FAUT(IFgradient_simplifie_____calculer_le_module) ,module_du_gradient_local_moyen ,argument_du_gradient_local_moyen ) ,imageR ,X,Y ); /* Jusqu'au 19980622095727, il y avait ici : */ /* */ /* storeF_point(longF2D(gradient_local) */ /* ,imageR */ /* ,X,Y */ /* ); */ /* */ /* mais l'introduction de l'option 'IFgradient_simplifie_____calculer_le_module' rend */ /* plus logique cette nouvelle ecriture... */ Eblock ETes Eblock end_image RETIF(imageR); Eblock #undef Y_point___Est #undef X_point___Est #undef Y_point__Nord #undef X_point__Nord #undef Y_point_Ouest #undef X_point_Ouest #undef Y_point___Sud #undef X_point___Sud EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* E P A I S S I S S E M E N T D ' U N P O I N T P A R U N N O Y A U : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Positive,SINT(Pepaississement_____nombre_de_points_sautes,NOMBRE_DE_POINTS_SAUTES_SUR_LA_SPIRALE))); /* Afin de pouvoir sauter des points sur la spirale utilisee par 'Pepaississement(...)' ; */ /* mais a l'etat initial, tous les points seront pris en compte... */ DEFV(Local,DEFV(FonctionF,Pepaississement(imageR ,imageA ,X,Y ,niveau_central ,niveaux_epaississables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ) ) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] epaissie par le */ /* noyau ; cela signifie que l'on entoure le point courant {X,Y}, lorsque */ /* cela est demande (voir l'argument 'niveaux_a_epaissir'), par une spirale */ /* faite de points dont le niveau est celui du point central {X,Y} pondere */ /* par le NOYAU(i,j) courant, mais uniquement la ou cela est autorise (voir */ /* l'argument 'niveaux_epaississables'). */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Int,X)); DEFV(Argument,DEFV(Int,Y)); /* Coordonnees entieres 'X' et 'Y' du point a epaissir. */ DEFV(Argument,DEFV(genere_p,niveau_central)); /* Niveau du point central. */ DEFV(Argument,DEFV(Logical,DTb0(niveaux_epaississables))); /* Definit ainsi pour chaque point d'une spirale s'il est epaississable ('VRAI') */ /* ou pas ('FAUX'), et ce lorsqu'il est dans le voisinage d'un point "a epaissir"... */ DEFV(Argument,DEFV(Int,nombre_de_points_du_noyau)); /* Nombre de points contenus dans le noyau, y compris son centre. */ DEFV(Argument,DEFV(Float,DTb0(noyau))); /* Noyau d'epaississement : il est defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ DEFV(Argument,DEFV(Logical,DTb0(inhibition_du_noyau))); /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock INIT_ERROR; /* ATTENTION : 'INIT_ERROR' est mis en tete des variables locales au cas ou des couples */ /* ('BDEFV','EDEFV') suivraient... */ DEFV(Int,INIT(X_courant,X)); /* Abscisse courante initialisee sur le point argument, */ DEFV(Int,INIT(Y_courant,Y)); /* Ordonnee courante initialisee sur le point argument. */ SPIRALE_DEFINITION /* Donnees de generation d'une spirale de parcours d'une image. */ DEFV(Int,INIT(numero_courant_de_point,UNDEF)); /* Numero du point courant sur une spirale lors de son parcours. */ /*..............................................................................................................................*/ SPIRALE_VALIDATION; /* Validation des pas de parcours (pasX,pasY) des images. */ VALIDATION_DE_____nombre_de_points_du_noyau; /* Mis sous cette forme le 20211020181331... */ DoIn(numero_courant_de_point,PREMIER_POINT,LSTX(PREMIER_POINT,nombre_de_points_du_noyau),I) Bblock Test(IFET(TEST_DANS_L_IMAGE(X_courant,Y_courant) ,EST_ACTIF(ITb0(inhibition_du_noyau,INDX(numero_courant_de_point,PREMIER_POINT))) ) ) Bblock Test(EST_VRAI(ITb0(niveaux_epaississables,INDX(load_point(imageA,X_courant,Y_courant),NOIR)))) Bblock store_point(GENP(NIVA(MUL2(ITb0(noyau,INDX(numero_courant_de_point,PREMIER_POINT)) ,FLOT(NIVR(niveau_central)) ) ) ) ,imageR ,X_courant,Y_courant ,FVARIABLE ); /* Et on range le point courant (X_courant,Y_courant) avec comme valeur celle du point */ /* central original pondere par le noyau courant, mais uniquement lorsque ce point */ /* courant est epaississable... */ /* ATTENTION : on notera l'usage de 'store_point(...)' et non de 'store_point_valide(...)' */ /* ce qui n'est pas dangereux puis qu'on est a l'interieur d'un 'TEST_DANS_L_IMAGE(...)'... */ Eblock ATes Bblock Eblock ETes Eblock ATes Bblock Eblock ETes SPIRALE_DEPLACEMENT_ET_PARCOURS(X_courant,Y_courant,Pepaississement_____nombre_de_points_sautes); /* Deplacement du point courant de la spirale... */ Eblock EDoI RETU_ERROR; Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* E P A I S S I S S E M E N T D ' U N E I M A G E P A R U N N O Y A U : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Iepaississement(imageR ,imageA ,niveaux_a_epaissir,niveaux_epaississables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ) ) ) ) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] epaissie par le */ /* noyau ; cela signifie que l'on entoure le point courant {X,Y}, lorsque */ /* cela est demande (voir l'argument 'niveaux_a_epaissir'), par une spirale */ /* faite de points dont le niveau est celui du point central {X,Y} pondere */ /* par le NOYAU(i,j) courant, mais uniquement la ou cela est autorise (voir */ /* l'argument 'niveaux_epaississables'). */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_a_epaissir,COULEURS))); /* Definit ainsi pour chaque point courant si son voisinage est a epaissir ('VRAI') */ /* ou pas ('FAUX'). */ DEFV(Argument,DEFV(Logical,DTb1(niveaux_epaississables,COULEURS))); /* Definit ainsi pour chaque point d'une spirale s'il est epaississable ('VRAI') */ /* ou pas ('FAUX'), et ce lorsqu'il est dans le voisinage d'un point "a epaissir"... */ DEFV(Argument,DEFV(Int,nombre_de_points_du_noyau)); /* Nombre de points contenus dans le noyau, y compris son centre. */ DEFV(Argument,DEFV(Float,DTb0(noyau))); /* Noyau d'epaississement : il est defini par une liste contenant une spirale */ /* carree parcourant le noyau de forme carree, et ce a partir de son centre ; */ /* le premier element donne le poids du centre, que l'on va noter NOYAU(0,0), */ /* puis le second donne NOYAU(1,0), puis NOYAU(1,1), NOYAU(0,1), NOYAU(-1,1), */ /* NOYAU(-1,0), NOYAU(-1,-1),... Cette spirale est parcourue dans le sens */ /* trigonometrique. */ DEFV(Argument,DEFV(Logical,DTb0(inhibition_du_noyau))); /* Precise pour chaque element du noyau s'il est 'ACTIF' (a utiliser dans */ /* les calculs) ou 'INACTIF' (a ignorer et a ne pas compter...). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(genere_p,INIT(niveau_central,NIVEAU_UNDEF)); /* Niveau du point central. */ /*..............................................................................................................................*/ SPIRALE_VALIDATION; VALIDATION_DE_____nombre_de_points_du_noyau; /* Mis sous cette forme le 20211020181331... */ begin_image Bblock EGAL(niveau_central,load_point(imageA,X,Y)); /* Niveau du point courant. */ Test(EST_VRAI(ITb1(niveaux_a_epaissir,INDX(niveau_central,NOIR)))) Bblock /* Traitement des points qui sont a epaissir... */ Pepaississement(imageR ,imageA ,X,Y ,niveau_central ,niveaux_epaississables ,nombre_de_points_du_noyau ,noyau,inhibition_du_noyau ); /* Et on epaissi point par point... */ Eblock ATes Bblock Eblock ETes Eblock end_image RETI(imageR); Eblock EFonctionP #undef VALIDATION_DE_____facteur_du_nombre_de_points #undef VALIDATION_DE_____facteur_du_nombre_de_points_____VALEUR_PAR_DEFAUT #undef VALIDATION_DE_____facteur_du_nombre_de_points_____BORNE_SUPERIEURE #undef VALIDATION_DE_____facteur_du_nombre_de_points_____BORNE_INFERIEURE #undef VALIDATION_DE_____nombre_de_points_du_noyau #undef VALIDATION_DE_____nombre_de_points_du_noyau_____VALEUR_PAR_DEFAUT #undef VALIDATION_DE_____nombre_de_points_du_noyau_____BORNE_SUPERIEURE #undef VALIDATION_DE_____nombre_de_points_du_noyau_____BORNE_INFERIEURE _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* F I L T R A G E D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ #define filtrage_pics \ FDU \ /* Facteur d'elimination des pics par filtrage. */ #define hfiltrage_pics \ filtrage_pics \ /* Facteur d'elimination des pics "horizontaux" par filtrage. */ #define vfiltrage_pics \ filtrage_pics \ /* Facteur d'elimination des pics "verticaux" par filtrage. */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* F I L T R A G E H O R I Z O N T A L D ' U N E I M A G E : */ /* */ /* */ /* Definition : */ /* */ /* Considerons un point courant M(x), */ /* et ses deux voisins de droite et de */ /* gauche A(x-1) et B(x+1) respectivement ; */ /* "Z" designant la valeur d'un pixel (par */ /* valeur scalaire d'un champ en ce point), */ /* on va tester la condition suivante : */ /* */ /* Z(M(x)) > Z(A(x-1)) et Z(M(x)) > Z(B(x+1)), */ /* */ /* si elle est realisee, on remplace Z(M(x)) */ /* par : */ /* */ /* alpha*(Z(A(x-1))+Z(B(x+1)))/2 + (1-alpha)*Z(M(x)). */ /* */ /* Ce qui signifie, que si le point 'M' */ /* est trop "au-dessus" de 'A' et 'B', il */ /* genere un "pli" : il faut donc le re- */ /* descendre. Enfin, on fait de meme "en- */ /* dessous"... */ /* */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Ihfiltrage(imageR,imageA)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, qui est une version filtree horizontalement de l'Argument. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Float,INIT(alpha,hfiltrage_pics)); /* Facteur d'elimination des pics par filtrage. Ce facteur varie */ /* dans le segment [0,1] ; lorsqu'il est nul, il n'y a pas de filtrage. */ DEFV(Float,INIT(alpham1,SOUS(W,hfiltrage_pics))); DEFV(genere_p,INIT(point_gauche,NIVEAU_UNDEF)); /* Point situe a gauche du point courant, */ DEFV(genere_p,INIT(point_courant,NIVEAU_UNDEF)); /* Point courant, */ DEFV(genere_p,INIT(point_droite,NIVEAU_UNDEF)); /* Point situe a droite du point courant, */ /*..............................................................................................................................*/ CALS(Inoir(imageR)); /* Nettoyage initial de l'image resultat... */ begin_image Bblock EGAL(point_courant,load_point(imageA,X,Y)); Test(IFOU(IFEQ(X,Xmin),IFEQ(X,Xmax))) Bblock store_point(point_courant,imageR,X,Y,FVARIABLE); /* Cas des extremites de ligne, les autres cas sont traites apres... */ Eblock ATes Bblock EGAL(point_gauche,load_point(imageA,PREX(X),Y)); EGAL(point_droite,load_point(imageA,SUCX(X),Y)); Test(IFGE(point_courant,point_gauche)) Bblock Test(IFGE(point_courant,point_droite)) Bblock store_point(VADD(VMULF(alpham1,FLOT(point_courant)) ,VMULF(alpha,FLOT(INTM(point_gauche,point_droite))) ) ,imageR ,X ,Y ,FVARIABLE ); /* Dans le cas ou le point courant est situe au-dessus des points de */ /* droite et de gauche, on le remplace par une combinaison lineaire */ /* de ces trois poinst (rappelons que cette operation n'est pas faite */ /* aux extremites de ligne). */ Eblock ATes Bblock Eblock ETes Eblock ATes Bblock Test(IFLT(point_courant,point_droite)) Bblock store_point(VADD(VMULF(alpham1,FLOT(point_courant)) ,VMULF(alpha,FLOT(INTM(point_gauche,point_droite))) ) ,imageR ,X ,Y ,FVARIABLE ); /* Dans le cas ou le point courant est situe au-dessous des points de */ /* droite et de gauche, on le remplace par une combinaison lineaire */ /* de ces trois poinst (rappelons que cette operation n'est pas faite */ /* aux extremites de ligne). */ Eblock ATes Bblock Eblock ETes Eblock ETes Eblock ETes Eblock end_image RETI(imageR); Eblock EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* F I L T R A G E V E R T I C A L D ' U N E I M A G E : */ /* */ /* */ /* Definition : */ /* */ /* Considerons un point courant M(y), */ /* et ses deux voisins du haut et du */ /* bas A(y-1) et B(y+1) respectivement ; */ /* "Z" designant la valeur d'un pixel (par */ /* valeur scalaire d'un champ en ce point), */ /* on va tester la condition suivante : */ /* */ /* Z(M(y)) > Z(A(y-1)) et Z(M(y)) > Z(B(y+1)), */ /* */ /* si elle est realisee, on remplace Z(M(y)) */ /* par : */ /* */ /* alpha*(Z(A(y-1))+Z(B(y+1)))/2 + (1-alpha)*Z(M(y)). */ /* */ /* Ce qui signifie, que si le point 'M' */ /* est trop "au-dessus" de 'A' et 'B', il */ /* genere un "pli" : il faut donc le re- */ /* descendre. Enfin, on fait de meme "en- */ /* dessous"... */ /* */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Ivfiltrage(imageR,imageA)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, qui est une version filtree verticalement de l'Argument. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Float,INIT(alpha,vfiltrage_pics)); /* Facteur d'elimination des pics par filtrage. Ce facteur varie */ /* dans le segment [0,1] ; lorsqu'il est nul, il n'y a pas de filtrage. */ DEFV(Float,INIT(alpham1,SOUS(W,vfiltrage_pics))); DEFV(genere_p,INIT(point_bas,NIVEAU_UNDEF)); /* Point situe en bas du point courant, */ DEFV(genere_p,INIT(point_courant,NIVEAU_UNDEF)); /* Point courant, */ DEFV(genere_p,INIT(point_haut,NIVEAU_UNDEF)); /* Point situe en haut du point courant, */ /*..............................................................................................................................*/ CALS(Inoir(imageR)); /* Nettoyage initial de l'image resultat... */ begin_image Bblock EGAL(point_courant,load_point(imageA,X,Y)); Test(IFOU(IFEQ(Y,Ymin),IFEQ(Y,Ymax))) Bblock store_point(point_courant,imageR,X,Y,FVARIABLE); /* Cas des extremites de colonne, les autres cas sont traites apres... */ Eblock ATes Bblock EGAL(point_bas,load_point(imageA,X,PREY(Y))); EGAL(point_haut,load_point(imageA,X,SUCY(Y))); Test(IFGE(point_courant,point_bas)) Bblock Test(IFGE(point_courant,point_haut)) Bblock store_point(VADD(VMULF(alpham1,FLOT(point_courant)) ,VMULF(alpha,FLOT(INTM(point_bas,point_haut))) ) ,imageR ,X ,Y ,FVARIABLE ); /* Dans le cas ou le point courant est situe au-dessus des points du */ /* haut et du bas, on le remplace par une combinaison lineaire */ /* de ces trois poinst (rappelons que cette operation n'est pas faite */ /* aux extremites de colonne). */ Eblock ATes Bblock Eblock ETes Eblock ATes Bblock Test(IFLT(point_courant,point_haut)) Bblock store_point(VADD(VMULF(alpham1,FLOT(point_courant)) ,VMULF(alpha,FLOT(INTM(point_bas,point_haut))) ) ,imageR ,X ,Y ,FVARIABLE ); /* Dans le cas ou le point courant est situe au-dessous des points du */ /* haut et du bas, on le remplace par une combinaison lineaire */ /* de ces trois poinst (rappelons que cette operation n'est pas faite */ /* aux extremites de colonne). */ Eblock ATes Bblock Eblock ETes Eblock ETes Eblock ETes Eblock end_image RETI(imageR); Eblock EFonctionP #undef filtrage_pics #undef hfiltrage_pics #undef vfiltrage_pics _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* R E D U C T I O N D E M O I T I E D ' U N E I M A G E " S T A N D A R D " : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(Logical,SINT(Ireduction_moitie_____compatibilite_20030611,FAUX))); /* Permet de generer des images suivant la methode anterieure au 20030611163611... */ DEFV(Common,DEFV(Logical,SINT(Ireduction_moitie_____calcul_du_minimum,FAUX))); /* Permet de renvoyer le niveau minimum, la valeur par defaut garantissant la compatibilite */ /* anterieure (possibilite introduite le 20190626085941 lors de la mise au point de */ /* 'v $xiia/VASA.27.256'). */ DEFV(Common,DEFV(FonctionP,POINTERp(Ireduction_moitie(imageR ,imageA ,ARGUMENT_POINTERs(translation) ,ARGUMENT_POINTERs(dimensions) ,tore_horizontal,tore_vertical ,calcul_de_la_moyenne ,ARGUMENT_FACULTATIF(calcul_du_maximum) ) ) ) ) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] */ /* reduite de moitie et translatee de 'translation' dans 'imageR'. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(deltaF_2D,POINTERs(translation))); /* Translation horizontale ('dx') et verticale ('dy') dans l'image Resultat. On */ /* n'oubliera pas que cette translation est exprimee dans des unites telles */ /* l'unite soit respectivement [Xmin,Xmax] et [Ymin,Ymax]. */ DEFV(Argument,DEFV(deltaI_2D,POINTERs(dimensions))); /* Nombre de points a traiter sur l'axe OX ('dx') et sur l'axe OY ('dy'). */ DEFV(Argument,DEFV(Logical,tore_horizontal)); /* La direction horizontale ('X') est-elle repliee sur elle-meme ('VRAI') */ /* ou non ('FAUX') dans 'imageR'. */ DEFV(Argument,DEFV(Logical,tore_vertical)); /* La direction verticale ('X') est-elle repliee sur elle-meme ('VRAI') */ /* ou non ('FAUX') dans 'imageR'. */ DEFV(Argument,DEFV(Logical,calcul_de_la_moyenne)); /* Cet argument precise si la generation de 'imageR' se fait par une moyenne */ /* sur 4 points voisins ('VRAI') ou par recherche d'un extremum ('FAUX'), c'est */ /* alors l'argument facultatif suivant qui discrimine entre 'MAX2' et 'RDN'. */ DEFV(Argument,DEFV(Logical,calcul_du_maximum)); /* Lorsqu'il s'agit d'une recherche d'extremum, cet argument precise si la */ /* generation de 'imageR' se fait par un maximum ('VRAI') ou par un choix */ /* aleatoire ('FAUX'). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Int,INIT(new_X,UNDEF)); /* Nouvelle coordonnee horizontale apres reduction, */ DEFV(Int,INIT(new_Y,UNDEF)); /* Et nouvelle coordonnee verticale... */ DEFV(genere_p,INIT(niveau_nXnY,NIVEAU_UNDEF)); /* Niveau du point {X,Y}, */ DEFV(genere_p,INIT(niveau_sXsY,NIVEAU_UNDEF)); /* Niveau du point (X+1,Y+1), */ DEFV(genere_p,INIT(niveau_sXnY,NIVEAU_UNDEF)); /* Niveau du point (X+1,Y), */ DEFV(genere_p,INIT(niveau_nXsY,NIVEAU_UNDEF)); /* Niveau du point (X,Y+1). */ DEFV(genere_p,INIT(niveau_minimal,NIVEAU_UNDEF)); /* Plus petit niveau dans le carre ((X,Y),(X+1,Y),(X+1,Y+1),(X,Y+1)), */ DEFV(genere_p,INIT(niveau_p_moyen,NIVEAU_UNDEF)); /* Petit niveau moyen dans le carre ((X,Y),(X+1,Y),(X+1,Y+1),(X,Y+1)) (inutilise...), */ DEFV(genere_p,INIT(niveau_g_moyen,NIVEAU_UNDEF)); /* Grand niveau moyen dans le carre ((X,Y),(X+1,Y),(X+1,Y+1),(X,Y+1)) (inutilise...), */ DEFV(genere_p,INIT(niveau_maximal,NIVEAU_UNDEF)); /* Plus grand niveau dans le carre ((X,Y),(X+1,Y),(X+1,Y+1),(X,Y+1)). */ /*..............................................................................................................................*/ begin_image Bblock Test(IFET(IFET(IFLE(DIMENSION(Xmin,X),ASI1(dimensions,dx)) ,IFLE(DIMENSION(Ymin,Y),ASI1(dimensions,dy)) ) ,IFET(DIVISIBLE(COXR(X),DOUB(pasX)) ,DIVISIBLE(COYR(Y),DOUB(pasY)) ) ) ) Bblock EGAL(new_X,COXA(ADD2(MOID(COXR(X)),_lDENORMALISE_OX(ASI1(translation,dx))))); EGAL(new_Y,COYA(ADD2(MOID(COYR(Y)),_lDENORMALISE_OY(ASI1(translation,dy))))); Test(IL_FAUT(tore_horizontal)) Bblock EGAL(new_X,MODX(new_X)); Eblock ATes Bblock Eblock ETes Test(IL_FAUT(tore_vertical)) Bblock EGAL(new_Y,MODY(new_Y)); Eblock ATes Bblock Eblock ETes Test(IL_FAUT(Ireduction_moitie_____compatibilite_20030611)) /* La methode anterieure au 20030611163611 possede un defaut lorsque l'option */ /* 'IL_FAUT(calcul_de_la_moyenne)' est active car, en effet, elle introduit des */ /* effets de bord tres visibles avec la commande 'v $xci/tapisserie$K'... */ Bblock EGAL(niveau_nXnY,load_point_valide(imageA,NEUT(X),NEUT(Y))); /* Niveau du point {X,Y}, */ EGAL(niveau_sXsY,load_point_valide(imageA,SUCX(X),SUCY(Y))); /* Niveau du point (X+1,Y+1), */ EGAL(niveau_sXnY,load_point_valide(imageA,SUCX(X),NEUT(Y))); /* Niveau du point (X+1,Y), */ EGAL(niveau_nXsY,load_point_valide(imageA,NEUT(X),SUCY(Y))); /* Niveau du point (X,Y+1). */ Eblock ATes Bblock DEFV(Int,INIT(coordonnee_nX,TRON(NEUT(X),Xmin,Xmax))); DEFV(Int,INIT(coordonnee_sX,TRON(SUCX(X),Xmin,Xmax))); DEFV(Int,INIT(coordonnee_nY,TRON(NEUT(Y),Ymin,Ymax))); DEFV(Int,INIT(coordonnee_sY,TRON(SUCY(Y),Ymin,Ymax))); /* Avec ces coordonnees auxiliaires qui ne sont jamais hors-ecran, on supprime les effets */ /* de bord. Le 20030612094122, j'ai remplace les definitions : */ /* */ /* DEFV(Int,INIT(coordonnee_nX,NEUT(X))); */ /* DEFV(Int,INIT(coordonnee_sX,COND(IFLT(X,Xmax),SUCX(X),NEUT(X)))); */ /* DEFV(Int,INIT(coordonnee_nY,NEUT(Y))); */ /* DEFV(Int,INIT(coordonnee_sY,COND(IFLT(Y,Ymax),SUCY(Y),NEUT(Y)))); */ /* */ /* par des definitions plus generales qui fonctionneraient aussi bien si l'on utilisait */ /* 'PRE?(...)' plutot que 'SUC?(...)'... */ EGAL(niveau_nXnY,load_point(imageA,coordonnee_nX,coordonnee_nY)); /* Niveau du point {X,Y}, */ EGAL(niveau_sXsY,load_point(imageA,coordonnee_sX,coordonnee_sY)); /* Niveau du point (X+1,Y+1), */ EGAL(niveau_sXnY,load_point(imageA,coordonnee_sX,coordonnee_nY)); /* Niveau du point (X+1,Y), */ EGAL(niveau_nXsY,load_point(imageA,coordonnee_nX,coordonnee_sY)); /* Niveau du point (X,Y+1). */ Eblock ETes EGAL(niveau_minimal ,GENP(MIN2(MIN2(niveau_nXnY ,niveau_sXsY ) ,MIN2(niveau_sXnY ,niveau_nXsY ) ) ) ); /* Plus petit niveau dans le carre ((X,Y),(X+1,Y),(X+1,Y+1),(X,Y+1)), */ EGAL(niveau_maximal ,GENP(MAX2(MAX2(niveau_nXnY ,niveau_sXsY ) ,MAX2(niveau_sXnY ,niveau_nXsY ) ) ) ); /* Plus grand niveau dans le carre ((X,Y),(X+1,Y),(X+1,Y+1),(X,Y+1)), */ EGAL(niveau_p_moyen ,GENP(MIN2(MIN2(COND(IFGT(niveau_nXnY,niveau_minimal),niveau_nXnY,niveau_maximal) ,COND(IFGT(niveau_sXsY,niveau_minimal),niveau_sXsY,niveau_maximal) ) ,MIN2(COND(IFGT(niveau_sXnY,niveau_minimal),niveau_sXnY,niveau_maximal) ,COND(IFGT(niveau_nXsY,niveau_minimal),niveau_nXsY,niveau_maximal) ) ) ) ); /* Petit niveau moyen dans le carre ((X,Y),(X+1,Y),(X+1,Y+1),(X,Y+1)) (inutilise...), */ EGAL(niveau_g_moyen ,GENP(MAX2(MAX2(COND(IFLT(niveau_nXnY,niveau_maximal),niveau_nXnY,niveau_minimal) ,COND(IFLT(niveau_sXsY,niveau_maximal),niveau_sXsY,niveau_minimal) ) ,MAX2(COND(IFLT(niveau_sXnY,niveau_maximal),niveau_sXnY,niveau_minimal) ,COND(IFLT(niveau_nXsY,niveau_maximal),niveau_nXsY,niveau_minimal) ) ) ) ); /* Grand niveau moyen dans le carre ((X,Y),(X+1,Y),(X+1,Y+1),(X,Y+1)) (inutilise...). */ store_point_valide(COND(IL_FAUT(calcul_de_la_moyenne) ,GENP(NIVA(INTM(INTM(FLOT(NIVR(niveau_nXnY)) ,FLOT(NIVR(niveau_sXsY)) ) ,INTM(FLOT(NIVR(niveau_sXnY)) ,FLOT(NIVR(niveau_nXsY)) ) ) ) ) ,COND(IL_FAUT(Ireduction_moitie_____calcul_du_minimum) ,niveau_minimal ,COND(IL_FAUT(calcul_du_maximum) ,niveau_maximal ,niveau_nXnY ) ) ) ,imageR ,new_X,new_Y ,FVARIABLE ); /* Donc, il y a trois possibilites : */ /* */ /* 1-calcul du niveau moyen, */ /* 2-calcul du niveau minimal (introduit le 20190626085941 en notant bien que le test */ /* 'Ireduction_moitie_____calcul_du_minimum' est fait avant celui de 'calcul_du_maximum' */ /* a cause de 'v $xci/tapisserie$K CALCUL_DU_MAXIMUM_DANS_UNE_DEMI_FENETRE', parametre */ /* qui n'est pas modifiable a l'execution...), */ /* 3-calcul du niveau maximal, */ /* 4-calcul d'un niveau aleatoire (on notera que je ne me fatigue pas beaucoup, en prenant */ /* en fait toujours le niveau au point {X,Y}, mais je crois que le resultat sera bon...). */ /* */ Eblock ATes Bblock Eblock ETes Eblock end_image RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* M O Y E N N A G E D ' U N E I M A G E " N O N S T A N D A R D " */ /* A L ' I N T E R I E U R D E P A V E S R E C T A N G U L A I R E S : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,POINTERF(IFmoyennage_dans_des_paves_rectangulaires(imageR,imageA,taille_du_pave_X,taille_du_pave_Y)))) /* Fonction introduite le 20080215153227... */ DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=moyenne(imageA[X][Y]). */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Positive,taille_du_pave_X)); DEFV(Argument,DEFV(Positive,taille_du_pave_Y)); /* Taille du pave... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock DEFV(pointI_2D,coin_bas_gauche_du_pave); INITIALISATION_POINT_2D(coin_bas_gauche_du_pave ,COXA(MULD(COXR(X),taille_du_pave_X)) ,COYA(MULD(COYR(Y),taille_du_pave_Y)) ); /* Definition du coin bas-gauche du pave courant (auquel appartient le point courant {X,Y}). */ Test(IFET(IFEQ(X,ASD1(coin_bas_gauche_du_pave,x)),IFEQ(Y,ASD1(coin_bas_gauche_du_pave,y)))) /* ATTENTION : ce dispositif fait l'hypothese implicite que {begin_image,end_image} */ /* parcourt les coordonnees {X,Y} de facon a ce que le coin bas-gauche du pave courant */ /* soit toujours accede (et positionne) avant que tout autre point de ce pave courant */ /* soit lui-meme positionne (justement a l'aide du coin bas-gauche...). Cela marche */ /* effectivement car les coordonnees {X,Y} sont incrementees (et non pas decrementees !). */ Bblock DEFV(Int,INIT(nombre_de_points_du_pave_courant,ZERO)); /* On notera qu'en general ce nombre vaut 'taille_du_pave_X*taille_du_pave_Y', sauf aux */ /* bords superieur et droite des images lorsque les tailles {dimX,dimY} ne sont pas des */ /* multiples de {taille_du_pave_X,taille_du_pave_Y}, d'ou le comptage explicite... */ DEFV(Float,INIT(cumul_des_niveaux,FZERO)); /* Cumul des niveaux du pave courant... */ begin_imageQ(DoIn ,NEUT(ASD1(coin_bas_gauche_du_pave,y)) ,nSUCY_TRON(ASD1(coin_bas_gauche_du_pave,y),TRMU(taille_du_pave_Y)) ,PasY ,DoIn ,NEUT(ASD1(coin_bas_gauche_du_pave,x)) ,nSUCX_TRON(ASD1(coin_bas_gauche_du_pave,x),TRMU(taille_du_pave_X)) ,PasX ) Bblock /* Lorsque le point {X,Y} courant est le coin bas-gauche du pave courant, il convient de */ /* calculer le niveau moyen de ce pave : */ INCR(cumul_des_niveaux,loadF_point(imageA,X,Y)); /* Cumul des niveaux du pave... */ INCR(nombre_de_points_du_pave_courant,I); /* Comptage des points du pave... */ Eblock end_imageQ(EDoI,EDoI) storeF_point(DIVI(cumul_des_niveaux,FLOT(nombre_de_points_du_pave_courant)),imageR,X,Y); /* Rangement de la moyenne des niveaux du pave courant dans son coin bas-gauche... */ Eblock ATes Bblock storeF_point(loadF_point(imageR,ASD1(coin_bas_gauche_du_pave,x),ASD1(coin_bas_gauche_du_pave,y)) ,imageR ,X,Y ); /* Lorsque le point {X,Y} courant n'est pas le coin bas-gauche du pave courant, il recoit */ /* le niveau de ce coin... */ Eblock ETes Eblock end_image RETIF(imageR); Eblock EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* R E D U C T I O N D E M O I T I E D ' U N E I M A G E " N O N S T A N D A R D " : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Logical,SINT(IFreduction_moitie_____compatibilite_20150123,FAUX))); /* Permet de generer des images suivant la methode anterieure au 20150123175450... */ DEFV(Common,DEFV(Logical,SINT(IFreduction_moitie_____calcul_du_minimum,FAUX))); /* Permet de renvoyer le niveau minimum, la valeur par defaut garantissant la compatibilite */ /* anterieure (possibilite introduite le 20190626085941). */ DEFV(Common,DEFV(FonctionF,POINTERF(IFreduction_moitie(imageR ,imageA ,ARGUMENT_POINTERs(translation) ,ARGUMENT_POINTERs(dimensions) ,tore_horizontal,tore_vertical ,calcul_de_la_moyenne ,ARGUMENT_FACULTATIF(calcul_du_maximum) ) ) ) ) DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] */ /* reduite de moitie et translatee de 'translation' dans 'imageR'. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(deltaF_2D,POINTERs(translation))); /* Translation horizontale ('dx') et verticale ('dy') dans l'image Resultat. On */ /* n'oubliera pas que cette translation est exprimee dans des unites telles */ /* l'unite soit respectivement [Xmin,Xmax] et [Ymin,Ymax]. */ DEFV(Argument,DEFV(deltaI_2D,POINTERs(dimensions))); /* Nombre de points a traiter sur l'axe OX ('dx') et sur l'axe OY ('dy'). */ DEFV(Argument,DEFV(Logical,tore_horizontal)); /* La direction horizontale ('X') est-elle repliee sur elle-meme ('VRAI') */ /* ou non ('FAUX') dans 'imageR'. */ DEFV(Argument,DEFV(Logical,tore_vertical)); /* La direction verticale ('X') est-elle repliee sur elle-meme ('VRAI') */ /* ou non ('FAUX') dans 'imageR'. */ DEFV(Argument,DEFV(Logical,calcul_de_la_moyenne)); /* Cet argument precise si la generation de 'imageR' se fait par une moyenne */ /* sur 4 points voisins ('VRAI') ou par recherche d'un extremum ('FAUX'), c'est */ /* alors l'argument facultatif suivant qui discrimine entre 'MAX2' et 'RDN'. */ DEFV(Argument,DEFV(Logical,calcul_du_maximum)); /* Lorsqu'il s'agit d'une recherche d'extremum, cet argument precise si la */ /* generation de 'imageR' se fait par un maximum ('VRAI') ou par un choix */ /* aleatoire ('FAUX'). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock Test(IFET(IFET(IFLE(DIMENSION(Xmin,X),ASI1(dimensions,dx)) ,IFLE(DIMENSION(Ymin,Y),ASI1(dimensions,dy)) ) ,IFET(DIVISIBLE(COXR(X),DOUB(pasX)) ,DIVISIBLE(COYR(Y),DOUB(pasY)) ) ) ) Bblock DEFV(Int,INIT(new_X,COXA(ADD2(MOID(COXR(X)),_lDENORMALISE_OX(ASI1(translation,dx)))))); /* Nouvelle coordonnee horizontale apres reduction, */ DEFV(Int,INIT(new_Y,COYA(ADD2(MOID(COYR(Y)),_lDENORMALISE_OY(ASI1(translation,dy)))))); /* Et nouvelle coordonnee verticale... */ DEFV(genere_Float,INIT(niveau_nXnY,FLOT__NIVEAU_UNDEF)); /* Niveau du point {X,Y}, */ DEFV(genere_Float,INIT(niveau_sXsY,FLOT__NIVEAU_UNDEF)); /* Niveau du point (X+1,Y+1), */ DEFV(genere_Float,INIT(niveau_sXnY,FLOT__NIVEAU_UNDEF)); /* Niveau du point (X+1,Y), */ DEFV(genere_Float,INIT(niveau_nXsY,FLOT__NIVEAU_UNDEF)); /* Niveau du point (X,Y+1). */ DEFV(genere_Float,INIT(niveau_minimal,FLOT__NIVEAU_UNDEF)); /* Plus petit niveau dans le carre ((X,Y),(X+1,Y),(X+1,Y+1),(X,Y+1)), */ DEFV(genere_Float,INIT(niveau_maximal,FLOT__NIVEAU_UNDEF)); /* Plus grand niveau dans le carre ((X,Y),(X+1,Y),(X+1,Y+1),(X,Y+1)). */ Test(IL_FAUT(IFreduction_moitie_____compatibilite_20150123)) /* La methode anterieure au 20030611163611 possede un defaut lorsque l'option */ /* 'IL_FAUT(calcul_de_la_moyenne)' est active car, en effet, elle introduit des */ /* effets de bord tres visibles avec la commande 'v $xci/tapisserie$K'... */ Bblock EGAL(niveau_nXnY,loadF_point_valide(imageA,NEUT(X),NEUT(Y))); /* Niveau du point {X,Y}, */ EGAL(niveau_sXsY,loadF_point_valide(imageA,SUCX(X),SUCY(Y))); /* Niveau du point (X+1,Y+1), */ EGAL(niveau_sXnY,loadF_point_valide(imageA,SUCX(X),NEUT(Y))); /* Niveau du point (X+1,Y), */ EGAL(niveau_nXsY,loadF_point_valide(imageA,NEUT(X),SUCY(Y))); /* Niveau du point (X,Y+1). */ Eblock ATes Bblock DEFV(Int,INIT(coordonnee_nX,TRON(NEUT(X),Xmin,Xmax))); DEFV(Int,INIT(coordonnee_sX,TRON(SUCX(X),Xmin,Xmax))); DEFV(Int,INIT(coordonnee_nY,TRON(NEUT(Y),Ymin,Ymax))); DEFV(Int,INIT(coordonnee_sY,TRON(SUCY(Y),Ymin,Ymax))); /* Avec ces coordonnees auxiliaires qui ne sont jamais hors-ecran, on supprime les effets */ /* de bord. */ EGAL(niveau_nXnY,loadF_point(imageA,coordonnee_nX,coordonnee_nY)); /* Niveau du point {X,Y}, */ EGAL(niveau_sXsY,loadF_point(imageA,coordonnee_sX,coordonnee_sY)); /* Niveau du point (X+1,Y+1), */ EGAL(niveau_sXnY,loadF_point(imageA,coordonnee_sX,coordonnee_nY)); /* Niveau du point (X+1,Y), */ EGAL(niveau_nXsY,loadF_point(imageA,coordonnee_nX,coordonnee_sY)); /* Niveau du point (X,Y+1). */ Eblock ETes Test(IL_FAUT(tore_horizontal)) Bblock EGAL(new_X,MODX(new_X)); Eblock ATes Bblock Eblock ETes Test(IL_FAUT(tore_vertical)) Bblock EGAL(new_Y,MODY(new_Y)); Eblock ATes Bblock Eblock ETes EGAL(niveau_minimal,MIN2(MIN2(niveau_nXnY,niveau_sXsY),MIN2(niveau_sXnY,niveau_nXsY))); /* Plus petit niveau dans le carre ((X,Y),(X+1,Y),(X+1,Y+1),(X,Y+1)), */ EGAL(niveau_maximal,MAX2(MAX2(niveau_nXnY,niveau_sXsY),MAX2(niveau_sXnY,niveau_nXsY))); /* Plus grand niveau dans le carre ((X,Y),(X+1,Y),(X+1,Y+1),(X,Y+1)), */ storeF_point_valide(COND(IL_FAUT(calcul_de_la_moyenne) ,INTM(INTM(niveau_nXnY,niveau_sXsY),INTM(niveau_sXnY,niveau_nXsY)) ,COND(IL_FAUT(IFreduction_moitie_____calcul_du_minimum) ,niveau_minimal ,COND(IL_FAUT(calcul_du_maximum) ,niveau_maximal ,niveau_nXnY ) ) ) ,imageR ,new_X,new_Y ); /* Donc, il y a trois possibilites : */ /* */ /* 1-calcul du niveau moyen, */ /* 2-calcul du niveau minimal (introduit le 20190626085941 en notant bien que le test */ /* 'IFreduction_moitie_____calcul_du_minimum' est fait avant celui de 'calcul_du_maximum' */ /* a cause de 'v $xci/tapisserie$K CALCUL_DU_MAXIMUM_DANS_UNE_DEMI_FENETRE', parametre */ /* qui n'est pas modifiable a l'execution...), */ /* 3-calcul du niveau maximal, */ /* 4-calcul d'un niveau aleatoire (on notera que je ne me fatigue pas beaucoup, en prenant */ /* en fait toujours le niveau au point {X,Y}, mais je crois que le resultat sera bon...). */ /* */ Eblock ATes Bblock Eblock ETes Eblock end_image RETIF(imageR); Eblock EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* A G R A N D I S S E M E N T D ' U N E I M A G E P A R D O U B L E M E N T : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(Logical,SINT(Iagrandissement_par_doublement_____fractaliser,FAUX))); DEFV(Common,DEFV(Int,SINT(Iagrandissement_par_doublement_____facteur_delta_old_X,DEUX))); DEFV(Common,DEFV(Int,SINT(Iagrandissement_par_doublement_____facteur_delta_old_Y,DEUX))); /* Introduit le 20201221121657 afin de permettre des effets "speciaux". La valeur par */ /* defaut ('FAUX') garantit la compatibilite anterieure puisqu'alors 'delta_old_X' et */ /* 'delta_old_Y' sont tous les deux nuls... */ DEFV(Common,DEFV(FonctionP,POINTERp(Iagrandissement_par_doublement(imageR ,imageA ,ARGUMENT_POINTERs(translation) ,tore_horizontal,tore_vertical ,il_faut_interpoler ) ) ) ) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=une moitie de imageA[X][Y] doublee */ /* et translatee. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(deltaF_2D,POINTERs(translation))); /* Translation horizontale ('dx') et verticale ('dy') de la moitie de l'image Argument */ /* a doubler. On n'oubliera pas que cette translation est exprimee dans des unites telles */ /* l'unite soit respectivement [Xmin,Xmax] et [Ymin,Ymax]. */ DEFV(Argument,DEFV(Logical,tore_horizontal)); /* La direction horizontale ('X') est-elle repliee sur elle-meme ('VRAI') */ /* ou non ('FAUX') dans 'imageA'. */ DEFV(Argument,DEFV(Logical,tore_vertical)); /* La direction verticale ('X') est-elle repliee sur elle-meme ('VRAI') */ /* ou non ('FAUX') dans 'imageA'. */ DEFV(Argument,DEFV(Logical,il_faut_interpoler)); /* Cet indicateur precise s'il faut interpoler entre les points voisins ('VRAI'), */ /* ou "betement" dupliquer ('FAUX'). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock DEFV(Int,INIT(old_X,COXA(ADD2(MOID(COXR(X)),_lDENORMALISE_OX(ASI1(translation,dx)))))); /* Ancienne coordonnee horizontale apres reduction, */ DEFV(Int,INIT(old_Y,COYA(ADD2(MOID(COYR(Y)),_lDENORMALISE_OY(ASI1(translation,dy)))))); /* Et ancienne coordonnee verticale... */ DEFV(Int,INIT(delta_old_X,COND(IL_NE_FAUT_PAS(Iagrandissement_par_doublement_____fractaliser),ZERO,PARI(COXR(X))))); DEFV(Int,INIT(delta_old_Y,COND(IL_NE_FAUT_PAS(Iagrandissement_par_doublement_____fractaliser),ZERO,PARI(COYR(Y))))); /* Introduit le 20201221121657 pour permettre la "fractalisation". Les valeurs par */ /* defaut garantissent la compatibilite anterieure grace a la nullite de 'delta_old_X' */ /* et de 'delta_old_Y'... */ DEFV(genere_p,INIT(niveau_XY,NIVEAU_UNDEF)); /* Niveau du point {X,Y}. */ Test(IL_FAUT(tore_horizontal)) Bblock EGAL(old_X,MODX(old_X)); Eblock ATes Bblock Eblock ETes Test(IL_FAUT(tore_vertical)) Bblock EGAL(old_Y,MODY(old_Y)); Eblock ATes Bblock Eblock ETes Test(IL_FAUT(il_faut_interpoler)) Bblock Test(IFET(DIVISIBLE(COXR(X),DOUB(pasX)),DIVISIBLE(COYR(Y),DOUB(pasY)))) Bblock EGAL(niveau_XY,load_point_valide(imageA,NEUT(old_X),NEUT(old_Y))); /* Lorsqu'il faut interpoler, et que l'on se trouve sur un noeud du reseau, on prend le */ /* niveau en ce noeud... */ Eblock ATes Bblock Eblock ETes Test(IFET(DIVISIBLE(COXR(X),DOUB(pasX)),NON_DIVISIBLE(COYR(Y),DOUB(pasY)))) Bblock EGAL(niveau_XY ,GENP(NIVA(INTM(FLOT(NIVR(load_point_valide(imageA,NEUT(old_X),NEUT(old_Y)))) ,FLOT(NIVR(load_point_valide(imageA,NEUT(old_X),SUCY(old_Y)))) ) ) ) ); /* Lorsqu'il faut interpoler, et que l'on se trouve entre sur une colonne de noeuds en 'X', */ /* mais entre deux noeuds en 'Y', on interpole le long de 'Y'. */ Eblock ATes Bblock Eblock ETes Test(IFET(NON_DIVISIBLE(COXR(X),DOUB(pasX)),DIVISIBLE(COYR(Y),DOUB(pasY)))) Bblock EGAL(niveau_XY ,GENP(NIVA(INTM(FLOT(NIVR(load_point_valide(imageA,NEUT(old_X),NEUT(old_Y)))) ,FLOT(NIVR(load_point_valide(imageA,SUCX(old_X),NEUT(old_Y)))) ) ) ) ); /* Lorsqu'il faut interpoler, et que l'on se trouve entre sur une colonne de noeuds en 'Y', */ /* mais entre deux noeuds en 'X', on interpole le long de 'X'. */ Eblock ATes Bblock Eblock ETes Test(IFET(NON_DIVISIBLE(COXR(X),DOUB(pasX)),NON_DIVISIBLE(COYR(Y),DOUB(pasY)))) Bblock EGAL(niveau_XY ,GENP(NIVA(INTM(INTM(FLOT(NIVR(load_point_valide(imageA,NEUT(old_X),NEUT(old_Y)))) ,FLOT(NIVR(load_point_valide(imageA,SUCX(old_X),NEUT(old_Y)))) ) ,INTM(FLOT(NIVR(load_point_valide(imageA,NEUT(old_X),NEUT(old_Y)))) ,FLOT(NIVR(load_point_valide(imageA,NEUT(old_X),SUCY(old_Y)))) ) ) ) ) ); /* Lorsqu'il faut interpoler, et que l'on se trouve entre deux noeuds en 'Y' et entre */ /* deux noeuds en 'X', on interpole le long de 'X' et de 'Y'... */ Eblock ATes Bblock Eblock ETes Eblock ATes Bblock EGAL(niveau_XY ,load_point_valide(imageA ,ADD2(old_X,MUL2(Iagrandissement_par_doublement_____facteur_delta_old_X,delta_old_X)) ,ADD2(old_Y,MUL2(Iagrandissement_par_doublement_____facteur_delta_old_Y,delta_old_Y)) ) ); /* Lorsqu'il ne faut pas interpoler, l'agrandissement est obtenu par duplication, ce */ /* qui signifie qu'un point de 'imageA' donne 2x2 points identiques dans 'imageR'. */ Eblock ETes store_point(niveau_XY,imageR,X,Y,FVARIABLE); /* Generation de l'image Resultat... */ Eblock end_image RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* R O T A T I O N D ' U N E I M A G E D E P L U S O U M O I N S P I S U R 2 : */ /* */ /*************************************************************************************************************************************/ DEFV(Common,DEFV(Logical,ZINT(NOUVELLES_COORDONNEES_ROTATION_DE_PLUS_OU_MOINS_PI_SUR_2_____compatibilite_20160205,FAUX))); /* Afin d'assurer la compatibilite anterieure au 20160205095953... */ #define NOUVELLES_COORDONNEES_ROTATION_DE_PLUS_OU_MOINS_PI_SUR_2 \ DEFV(Int,INIT(new_X \ ,OPC1(IL_FAUT(NOUVELLES_COORDONNEES_ROTATION_DE_PLUS_OU_MOINS_PI_SUR_2_____compatibilite_20160205) \ ,INTE \ ,ARRI \ ,COXA(LIN2(FLOT(SOUS(COXR(X),COXR(Xcentre))) \ ,NEUT(cosinus_de_l_angle) \ ,FLOT(SOUS(COYR(Y),COYR(Ycentre))) \ ,NEGA(sinus___de_l_angle) \ ,FLOT(COXR(Xcentre)) \ ) \ ) \ ) \ ) \ ); \ DEFV(Int,INIT(new_Y \ ,OPC1(IL_FAUT(NOUVELLES_COORDONNEES_ROTATION_DE_PLUS_OU_MOINS_PI_SUR_2_____compatibilite_20160205) \ ,INTE \ ,ARRI \ ,COXA(LIN2(FLOT(SOUS(COXR(X),COXR(Xcentre))) \ ,NEUT(sinus___de_l_angle) \ ,FLOT(SOUS(COYR(Y),COYR(Ycentre))) \ ,NEUT(cosinus_de_l_angle) \ ,FLOT(COYR(Ycentre)) \ ) \ ) \ ) \ ) \ ); \ /* Definition d'une rotation bidimensionnelle quelconque, valable meme si l'angle n'est */ \ /* plus egal a pi/2 (introduit le 20160114083225)... */ BFonctionP DEFV(Common,DEFV(Float,SINT(Irotation_de_plus_ou_moins_pi_sur_2_____angle_positif,NEUT(PI_SUR_2)))); DEFV(Common,DEFV(Float,SINT(Irotation_de_plus_ou_moins_pi_sur_2_____angle_negatif,NEGA(PI_SUR_2)))); /* Introduit le 20160114083225 afin de permettre d'autres rotations... */ DEFV(Common,DEFV(FonctionP,POINTERp(Irotation_de_plus_ou_moins_pi_sur_2(imageR,imageA,sens_trigonometrique)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=Rotation(imageA[X][Y]). */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Logical,sens_trigonometrique)); /* Indicateur selectionnant +pi/2 ('VRAI') ou -pi/2 ('FAUX'). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Float,INIT(cosinus_de_l_angle ,COSX(COND(IL_FAUT(sens_trigonometrique) ,Irotation_de_plus_ou_moins_pi_sur_2_____angle_positif ,Irotation_de_plus_ou_moins_pi_sur_2_____angle_negatif ) ) ) ); DEFV(Float,INIT(sinus___de_l_angle ,SINX(COND(IL_FAUT(sens_trigonometrique) ,Irotation_de_plus_ou_moins_pi_sur_2_____angle_positif ,Irotation_de_plus_ou_moins_pi_sur_2_____angle_negatif ) ) ) ); /* Sinus de plus ou moins pi/2... */ /*..............................................................................................................................*/ Test(IFOU(IFID(imageA,imageR),IFNE(dimX,dimY))) Bblock PRINT_ERREUR("les images Argument et Resultat sont identiques, ou les dimensions en 'X' et 'Y' sont inegales"); Eblock ATes Bblock CALS(Inoir(imageR)); /* Nettoyage initial de l'image resultat a cause du 'store_point_valide(...)' qui suit et */ /* qui fait que tous les points de 'imageR' ne sont peut-etre pas atteints... */ begin_image Bblock NOUVELLES_COORDONNEES_ROTATION_DE_PLUS_OU_MOINS_PI_SUR_2; /* Nouvelles coordonnees apres rotation (qui correspond a une multiplication par plus ou */ /* moins 'i'). */ store_point_valide(load_point(imageA,X,Y) ,imageR ,new_X,new_Y ,FVARIABLE ); Eblock end_image Eblock ETes RETI(imageR); Eblock EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* R O T A T I O N D ' U N E I M A G E D E P L U S O U M O I N S P I S U R 2 */ /* D ' U N E I M A G E F L O T T A N T E : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Float,SINT(IFrotation_de_plus_ou_moins_pi_sur_2_____angle_positif,NEUT(PI_SUR_2)))); DEFV(Common,DEFV(Float,SINT(IFrotation_de_plus_ou_moins_pi_sur_2_____angle_negatif,NEGA(PI_SUR_2)))); /* Introduit le 20160114083225 afin de permettre d'autres rotations... */ DEFV(Common,DEFV(FonctionF,POINTERF(IFrotation_de_plus_ou_moins_pi_sur_2(imageR,imageA,sens_trigonometrique)))) DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=Rotation(imageA[X][Y]. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Logical,sens_trigonometrique)); /* Indicateur selectionnant +pi/2 ('VRAI') ou -pi/2 ('FAUX'). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Float,INIT(cosinus_de_l_angle ,INTE(COSX(COND(IL_FAUT(sens_trigonometrique) ,IFrotation_de_plus_ou_moins_pi_sur_2_____angle_positif ,IFrotation_de_plus_ou_moins_pi_sur_2_____angle_negatif ) ) ) ) ); DEFV(Float,INIT(sinus___de_l_angle ,INTE(SINX(COND(IL_FAUT(sens_trigonometrique) ,IFrotation_de_plus_ou_moins_pi_sur_2_____angle_positif ,IFrotation_de_plus_ou_moins_pi_sur_2_____angle_negatif ) ) ) ) ); /* Sinus de plus ou moins pi/2... */ /*..............................................................................................................................*/ Test(IFOU(IFID(imageA,imageR),IFNE(dimX,dimY))) Bblock PRINT_ERREUR("les images Argument et Resultat sont identiques, ou les dimensions en 'X' et 'Y' sont inegales"); Eblock ATes Bblock CALS(IFinitialisation(imageR,FZERO)); /* Nettoyage initial de l'image resultat a cause du 'storeF_point_valide(...)' qui suit et */ /* qui fait que tous les points de 'imageR' ne sont peut-etre pas atteints... */ begin_image Bblock NOUVELLES_COORDONNEES_ROTATION_DE_PLUS_OU_MOINS_PI_SUR_2; /* Nouvelles coordonnees apres rotation (qui correspond a une multiplication par plus ou */ /* moins 'i'). */ storeF_point_valide(loadF_point(imageA,X,Y) ,imageR ,new_X,new_Y ); Eblock end_image Eblock ETes RETIF(imageR); Eblock EFonctionF #undef NOUVELLES_COORDONNEES_ROTATION_DE_PLUS_OU_MOINS_PI_SUR_2 _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* R O T A T I O N D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* C H O I X D E L A F A C O N D ' I N T E R P O L E R : */ /* */ /*************************************************************************************************************************************/ #nodefine INTERPOLATION_ROTATION_2D_VERSION_01 \ /* Cette facon d'interpoler reference explicitement l'interpolation bilineaire... */ #define INTERPOLATION_ROTATION_2D_VERSION_02 \ /* Cette facon d'interpoler considere les interpolations comme produit d'interpolations */ \ /* cubiques... */ #ifdef INTERPOLATION_ROTATION_2D_VERSION_01 /* Common,DEFV(Fonction,) : avec 'VERSION_01'. */ DEFV(Common,DEFV(Logical,_____INTERPOLATION_ROTATION_2D_VERSION_01)); #Aifdef INTERPOLATION_ROTATION_2D_VERSION_01 /* Common,DEFV(Fonction,) : avec 'VERSION_01'. */ #Eifdef INTERPOLATION_ROTATION_2D_VERSION_01 /* Common,DEFV(Fonction,) : avec 'VERSION_01'. */ #ifdef INTERPOLATION_ROTATION_2D_VERSION_02 /* Common,DEFV(Fonction,) : avec 'VERSION_02'. */ DEFV(Common,DEFV(Logical,_____INTERPOLATION_ROTATION_2D_VERSION_02)); #Aifdef INTERPOLATION_ROTATION_2D_VERSION_02 /* Common,DEFV(Fonction,) : avec 'VERSION_02'. */ #Eifdef INTERPOLATION_ROTATION_2D_VERSION_02 /* Common,DEFV(Fonction,) : avec 'VERSION_02'. */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* R O T A T I O N D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ #define ROTATION_ET_TRANSLATION_DES_COORDONNEES \ Bblock \ EGAL(coordonnee_u,SOUS(_____cNORMALISE_OX(X),ASI1(RAtranslation,dx))); \ EGAL(coordonnee_v,SOUS(_____cNORMALISE_OY(Y),ASI1(RAtranslation,dy))); \ EGAL(Xf \ ,F__cDENORMALISE_OX(LIN2(coordonnee_u,cosinus_courant \ ,coordonnee_v,NEGA(sinus_courant) \ ,ASI1(Atranslation,dx) \ ) \ ) \ ); \ EGAL(Yf \ ,F__cDENORMALISE_OY(LIN2(coordonnee_u,sinus_courant \ ,coordonnee_v,cosinus_courant \ ,ASI1(Atranslation,dy) \ ) \ ) \ ); \ /* Calcul de la transformation inverse en flottant... */ \ EGAL(new_X,INTX(Xf)); \ EGAL(new_Y,INTY(Yf)); \ /* Calcul de la transformation inverse en entier... */ \ Eblock \ /* Cubiques... */ #ifdef INTERPOLATION_ROTATION_2D_VERSION_02 # define NIVEAU_INFERIEUR_DE_L_IMAGE_A_TOURNER \ FLOT__NOIR \ /* Niveau minimum, */ # define NIVEAU_SUPERIEUR_DE_L_IMAGE_A_TOURNER \ FLOT__BLANC \ /* Niveau maximum. */ # define NIVEAU_DES_POINTS_NON_ATTEINTS_PAR_LA_ROTATION \ NIVEAU_INFERIEUR_DE_L_IMAGE_A_TOURNER \ /* Lors de la transformation, il est des points de l'image Resultat qui ne sont les */ \ /* transformes d'aucun point de l'image Argument ; c'est ainsi qu'on les marque. */ #Aifdef INTERPOLATION_ROTATION_2D_VERSION_02 #Eifdef INTERPOLATION_ROTATION_2D_VERSION_02 #define ROTATION_D_UNE_IMAGE_NON_STANDARD(imageR,imageA,interpolation_cubique) \ Bblock \ traite_image_BH_GD(BLOC(Bblock \ ROTATION_ET_TRANSLATION_DES_COORDONNEES; \ /* Calcul de la transformation inverse en flottant et en entier... */ \ \ Test(IL_NE_FAUT_PAS(interpoler)) \ Bblock \ EGAL(niveau_courant,loadF_point_valide(imageA,new_X,new_Y)); \ /* Il n'y a pas interpolation, le niveau est recupere "betement"... */ \ Eblock \ ATes \ Bblock \ loadF_point_continu(niveau_courant \ ,imageA \ ,Xf,Yf \ ,interpolation_cubique \ ); \ /* Il faut interpoler, et la c'est beaucoup moins simple... */ \ Eblock \ ETes \ \ storeF_point_valide(niveau_courant \ ,imageR \ ,ADD2(X,_lDENORMALISE_OX(ASI1(RRtranslation,dx))) \ ,ADD2(Y,_lDENORMALISE_OY(ASI1(RRtranslation,dy))) \ ); \ /* Et on met a jour l'image Resultat flottante. */ \ Eblock \ ) \ ); \ Eblock \ /* Procedure de rotation d'une image non standard (introduite le 20200123092928). */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* R O T A T I O N D ' U N E I M A G E S T A N D A R D : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(Logical,SINT(Irotation_image_____interpolation_cubique,VRAI))); /* Choix de la methode d'interpolation introduit le 20131230124640... */ DEFV(Common,DEFV(FonctionP,POINTERp(Irotation_image(imageR ,imageA ,nettoyer ,ARGUMENT_POINTERs(RRtranslation) ,ARGUMENT_POINTERs(RAtranslation) ,ARGUMENT_POINTERs(Atranslation) ,angle ,interpoler ) ) ) ) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] */ /* tournee de 'angle' radians et translatee de 'translation' dans 'imageR'. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Logical,nettoyer)); /* Indicateur demandant ('VRAI') ou pas ('FAUX') l'initialisation de l'image 'imageR'. La */ /* non initialisation permet la mise en oeuvre de processus iteratif (voir par exemple la */ /* commande 'v $xci/accumule.02$K' ou encore le programme 'v $xrc/julia.42$K')... */ DEFV(Argument,DEFV(deltaF_2D,POINTERs(RRtranslation))); /* Translation horizontale ('dx') et verticale ('dy') de l'image Resultat ; on */ /* n'oubliera pas que cette translation est exprimee dans des unites telles */ /* l'unite soit respectivement [Xmin,Xmax] et [Ymin,Ymax]. Cette translation est */ /* appliquee lors de la generation de l'image Resultat (d'ou le nom "RR..."). */ DEFV(Argument,DEFV(deltaF_2D,POINTERs(RAtranslation))); /* Translation horizontale ('dx') et verticale ('dy') de l'image Resultat ; on */ /* n'oubliera pas que cette translation est exprimee dans des unites telles */ /* l'unite soit respectivement [Xmin,Xmax] et [Ymin,Ymax]. Cette translation est */ /* appliquee lors de l'acces a l'image Argument (d'ou le nom "RA..."). ATTENTION, pendant */ /* tres longtemps, cet argument de translation sur l'image Resultat fut le seul (ce qui */ /* signifie que 'RRtranslation' n'existait pas), et il s'appelait alors 'Rtranslation' ; il */ /* a ete introduit pour permettre, par exemple, a la commande 'v $xci/accumule.02$K' et au */ /* programme 'v $xrc/julia.42$K' de faire des translations inferieures a un point (auquel */ /* cas d'ailleurs la rotation est d'angle nul...). */ DEFV(Argument,DEFV(deltaF_2D,POINTERs(Atranslation))); /* Translation horizontale ('dx') et verticale ('dy') de l'image Argument ; on */ /* n'oubliera pas que cette translation est exprimee dans des unites telles */ /* l'unite soit respectivement [Xmin,Xmax] et [Ymin,Ymax]. */ DEFV(Argument,DEFV(Float,angle)); /* Angle en radians de la rotation. */ DEFV(Argument,DEFV(Logical,interpoler)); /* Indique si l'on doit interpoler ('VRAI') ou pas ('FAUX') les niveaux a */ /* l'interieur de la transformee de la maille elementaire. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Float,INIT(Xf,FLOT__UNDEF)); DEFV(Float,INIT(Yf,FLOT__UNDEF)); /* Coordonnees flottantes 'X' et 'Y'. */ DEFV(Float,INIT(coordonnee_u,FLOT__UNDEF)); /* Valeur de-normalisee de 'X', */ DEFV(Float,INIT(coordonnee_v,FLOT__UNDEF)); /* Valeur de-normalisee de 'Y'. */ DEFV(Int,INIT(new_X,UNDEF)); /* Nouvelle coordonnee horizontale apres reduction, */ DEFV(Int,INIT(new_Y,UNDEF)); /* Et nouvelle coordonnee verticale... */ DEFV(Float,INIT(sinus_courant,FLOT__UNDEF)); /* Donne le 'sinus' de l'angle courant, */ DEFV(Float,INIT(cosinus_courant,FLOT__UNDEF)); /* Donne le 'cosinus' de l'angle courant. */ #ifdef INTERPOLATION_ROTATION_2D_VERSION_02 DEFV(genere_Float,INIT(niveau_courant,FLOT__NIVEAU_UNDEF)); /* Donne le niveau flottant courant apres l'eventuel interpolation... */ BDEFV(imageF,imageR_flottante); /* Image flottante Resultat apres l'interpolation. */ BDEFV(imageF,imageA_flottante); /* Image flottante Argument que l'on cherche a faire tourner. */ #Aifdef INTERPOLATION_ROTATION_2D_VERSION_02 #Eifdef INTERPOLATION_ROTATION_2D_VERSION_02 /*..............................................................................................................................*/ EGAL(sinus_courant,SINX(NEGA(angle))); EGAL(cosinus_courant,COSX(NEGA(angle))); /* Calcul des lignes trigonometriques de l'oppose de l'angle argument ; on */ /* utilise en effet la transformation "inverse" (donc d'angle oppose). */ #ifdef INTERPOLATION_ROTATION_2D_VERSION_01 /* Nota : l'optimisation due au test 'TEST_DANS_L_IMAGE(new_X,new_Y)' n'est faite que */ /* pour 'INTERPOLATION_ROTATION_2D_VERSION_01', car en effet, si elle etait faite pour */ /* 'INTERPOLATION_ROTATION_2D_VERSION_02', elle creerait sur les bords du bas et de */ /* gauche des defauts d'aliasing dus au fait que l'ensemble des points sur lesquels */ /* l'interpolation bi-cubique est faite ne possede pas de point central de symetrie : */ /* */ /* */ /* | | | | */ /* | | | | */ /* --------|-------------[ ( (X)),S(S(Y))]-----[ (S(X)),S(S(Y))]-------------|-------- */ /* | | | | */ /* | | | | */ /* | | | | */ /* | | | | */ /* [ (P(X)), (S(Y))]-----[ ( (X)), (S(Y))]-----[ (S(X)), (S(Y))]-----[S(S(X)), (S(Y))] */ /* | | | | */ /* | | | | */ /* | | | | */ /* | | | | */ /* [ (P(X)), ( (Y))]-----[ ( (X)), ( (Y))]-----[ (S(X)), ( (Y))]-----[S(S(X)), ( (Y))] */ /* | / | | | */ /* | / | | | */ /* | / | | | */ /* | / | | | */ /* --------|-------------[ ( (X)), (P(Y))]-----[ (S(X)), (P(Y))]-------------|-------- */ /* | / | | | */ /* | / | | | */ /* / */ /* / */ /* */ /* point de coordonnees entieres {X,Y} obtenues a partir de {Xf,Yf} ; ce point n'est donc */ /* pas au centre des 12 points utilises pour l'interpolation ('P' et 'S' designent */ /* respectivement les fonctions 'PREX'/'PREY' et 'SUCX'/'SUCY'). */ Test(IL_FAUT(nettoyer)) Bblock CALS(Inoir(imageR)); /* Nettoyage de l'image resultat. */ Eblock ATes Bblock Eblock ETes traite_image_BH_GD(BLOC(Bblock ROTATION_ET_TRANSLATION_DES_COORDONNEES; /* Calcul de la transformation inverse en flottant et en entier... */ Test(TEST_DANS_L_IMAGE(new_X,new_Y)) Bblock /* Et rangement du point de 'imageA' qui est l'image du point courant {X,Y} */ /* de 'imageR' par la transformation "inverse" -angle. */ store_point_valide(COND(IL_NE_FAUT_PAS(interpoler) ,load_point(imageA,new_X,new_Y) ,GENP(NIVA(DIVI(ADD2(ADD2(MUL2(NIVR(load_point_valide(imageA ,NEUT(new_X) ,NEUT(new_Y) ) ) ,MUL2(SOUS(FLOT(SUCX(new_X)),Xf) ,SOUS(FLOT(SUCY(new_Y)),Yf) ) ) ,MUL2(NIVR(load_point_valide(imageA ,SUCX(new_X) ,NEUT(new_Y) ) ) ,MUL2(SOUS(Xf,FLOT(NEUT(new_X))) ,SOUS(FLOT(SUCY(new_Y)),Yf) ) ) ) ,ADD2(MUL2(NIVR(load_point_valide(imageA ,NEUT(new_X) ,SUCY(new_Y) ) ) ,MUL2(SOUS(FLOT(SUCX(new_X)),Xf) ,SOUS(Yf,FLOT(NEUT(new_Y))) ) ) ,MUL2(NIVR(load_point_valide(imageA ,SUCX(new_X) ,SUCY(new_Y) ) ) ,MUL2(SOUS(Xf,FLOT(NEUT(new_X))) ,SOUS(Yf,FLOT(NEUT(new_Y))) ) ) ) ) ,ADD2(ADD2(MUL2(SOUS(FLOT(SUCX(new_X)),Xf) ,SOUS(FLOT(SUCY(new_Y)),Yf) ) ,MUL2(SOUS(Xf,FLOT(NEUT(new_X))) ,SOUS(FLOT(SUCY(new_Y)),Yf) ) ) ,ADD2(MUL2(SOUS(FLOT(SUCX(new_X)),Xf) ,SOUS(Yf,FLOT(NEUT(new_Y))) ) ,MUL2(SOUS(Xf,FLOT(NEUT(new_X))) ,SOUS(Yf,FLOT(NEUT(new_Y))) ) ) ) ) ) ) ) ,imageR ,ADD2(X,_lDENORMALISE_OX(ASI1(RRtranslation,dx))) ,ADD2(Y,_lDENORMALISE_OY(ASI1(RRtranslation,dy))) ,FVARIABLE ); /* Et rangement du point de 'imageA' qui est l'image du point courant {X,Y} */ /* de 'imageR' par la transformation "inverse" -angle. */ /* */ /* schema de l'interpolation sur la maille */ /* elementaire (BG,BD,HD,HG), lorsqu'elle est */ /* demandee : */ /* */ /* */ /* HG (NEUT(X),SUCY(Y)) HD (SUCX(X),SUCY(Y)) */ /* */ /* nHG <-----h3------> <---h4---> nHD */ /* *--------------------------* */ /* ^|\ . /|^ */ /* || \ . / || */ /* || \ . / || */ /* v1| 4 . 3 |v2 */ /* || \ . / || */ /* || \ . / || */ /* V| point\ ./ courant |V */ /* Yf ................#..........| */ /* ^| / .\ |^ */ /* || / . \ || */ /* v4| 1 . 2 |v3 */ /* || / . \ || */ /* V| / . \ |V */ /* *---------------.----------* */ /* nBG <-----h2------> <---h1---> nBD */ /* Xf */ /* BG (NEUT(X),NEUT(Y)) BD (SUCX(X),NEUT(Y)) */ /* */ /* */ /* le niveau 'N' du point courant (u,v) est */ /* donne par la formule d'interpolation : */ /* */ /* N = (nBG.h1.v1) + (nBD.h2.v2) + (nHG.h3.v3) + (nHD.h4.v4) */ /* */ Eblock ATes Bblock Eblock ETes Eblock ) ); #Aifdef INTERPOLATION_ROTATION_2D_VERSION_01 #Eifdef INTERPOLATION_ROTATION_2D_VERSION_01 #ifdef INTERPOLATION_ROTATION_2D_VERSION_02 /* Nota : l'optimisation due au test 'TEST_DANS_L_IMAGE(new_X,new_Y)' n'est faite que */ /* pour 'INTERPOLATION_ROTATION_2D_VERSION_01', car en effet, si elle etait faite pour */ /* 'INTERPOLATION_ROTATION_2D_VERSION_02', elle creerait sur les bords du bas et de */ /* gauche des defauts d'aliasing dus au fait que l'ensemble des points sur lesquels */ /* l'interpolation bi-cubique est faite ne possede pas de point central de symetrie : */ /* */ /* */ /* | | | | */ /* | | | | */ /* --------|-------------[ ( (X)),S(S(Y))]-----[ (S(X)),S(S(Y))]-------------|-------- */ /* | | | | */ /* | | | | */ /* | | | | */ /* | | | | */ /* [ (P(X)), (S(Y))]-----[ ( (X)), (S(Y))]-----[ (S(X)), (S(Y))]-----[S(S(X)), (S(Y))] */ /* | | | | */ /* | | | | */ /* | | | | */ /* | | | | */ /* [ (P(X)), ( (Y))]-----[ ( (X)), ( (Y))]-----[ (S(X)), ( (Y))]-----[S(S(X)), ( (Y))] */ /* | / | | | */ /* | / | | | */ /* | / | | | */ /* | / | | | */ /* --------|-------------[ ( (X)), (P(Y))]-----[ (S(X)), (P(Y))]-------------|-------- */ /* | / | | | */ /* | / | | | */ /* / */ /* / */ /* */ /* point de coordonnees entieres {X,Y} obtenues a partir de {Xf,Yf} ; ce point n'est donc */ /* pas au centre des 12 points utilises pour l'interpolation ('P' et 'S' designent */ /* respectivement les fonctions 'PREX'/'PREY' et 'SUCX'/'SUCY'). */ CALS(Istd_float(imageA_flottante,NIVEAU_INFERIEUR_DE_L_IMAGE_A_TOURNER,NIVEAU_SUPERIEUR_DE_L_IMAGE_A_TOURNER,imageA)); /* Conversion de l'image Argument en flottant (afin de pouvoir utiliser la fabuleuse */ /* macro-procedure 'loadF_point_continu'). */ Test(IL_FAUT(nettoyer)) Bblock CALS(IFinitialisation(imageR_flottante,NIVEAU_DES_POINTS_NON_ATTEINTS_PAR_LA_ROTATION)); /* Et on nettoie la matrice Resultat (flottante) ; on prend pour cela le plus petit niveau */ /* possible, qui fera donc peut-etre une bordure autour de l'image (la ou il n'y a rien). */ Eblock ATes Bblock CALS(Istd_float(imageR_flottante,NIVEAU_INFERIEUR_DE_L_IMAGE_A_TOURNER,NIVEAU_SUPERIEUR_DE_L_IMAGE_A_TOURNER,imageR)); /* Conversion de l'image Resultat en flottant. */ Eblock ETes ROTATION_D_UNE_IMAGE_NON_STANDARD(imageR_flottante,imageA_flottante,Irotation_image_____interpolation_cubique); /* Mis sous cette forme le 20200123092928... */ Test(IL_FAUT(nettoyer)) Bblock CALS(Ifloat_std_avec_renormalisation(imageR,imageR_flottante)); /* Conversion de l'image Resultat en une image standard avec renormalisation... */ Eblock ATes Bblock CALS(Ifloat_std(imageR,imageR_flottante,NIVEAU_INFERIEUR_DE_L_IMAGE_A_TOURNER,NIVEAU_SUPERIEUR_DE_L_IMAGE_A_TOURNER)); /* Conversion de l'image Resultat en une image standard sans renormalisation. En effet, */ /* lorsque le nettoyage n'est pas demande c'est qu'en general un processus iteratif est */ /* en cours, il est donc imperatif de conserver l'echelle des niveaux... */ Eblock ETes #Aifdef INTERPOLATION_ROTATION_2D_VERSION_02 #Eifdef INTERPOLATION_ROTATION_2D_VERSION_02 EDEFV(imageF,imageA_flottante); /* Image flottante Argument que l'on cherche a faire tourner. */ EDEFV(imageF,imageR_flottante); /* Image flottante Resultat apres l'interpolation. */ RETI(imageR); Eblock EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* R O T A T I O N D ' U N E I M A G E N O N S T A N D A R D : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Logical,SINT(IFrotation_image_____interpolation_cubique,VRAI))); /* Choix de la methode d'interpolation introduit le 20131230124640... */ DEFV(Common,DEFV(FonctionF,POINTERF(IFrotation_image(imageR ,imageA ,nettoyer ,ARGUMENT_POINTERs(RRtranslation) ,ARGUMENT_POINTERs(RAtranslation) ,ARGUMENT_POINTERs(Atranslation) ,angle ,interpoler ) ) ) ) /* Fonction introduite le 20200123092928... */ DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X][Y] */ /* tournee de 'angle' radians et translatee de 'translation' dans 'imageR'. */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Logical,nettoyer)); /* Indicateur demandant ('VRAI') ou pas ('FAUX') l'initialisation de l'image 'imageR'. La */ /* non initialisation permet la mise en oeuvre de processus iteratif (voir par exemple la */ /* commande 'v $xci/accumule.02$K' ou encore le programme 'v $xrc/julia.42$K')... */ DEFV(Argument,DEFV(deltaF_2D,POINTERs(RRtranslation))); /* Translation horizontale ('dx') et verticale ('dy') de l'image Resultat ; on */ /* n'oubliera pas que cette translation est exprimee dans des unites telles */ /* l'unite soit respectivement [Xmin,Xmax] et [Ymin,Ymax]. Cette translation est */ /* appliquee lors de la generation de l'image Resultat (d'ou le nom "RR..."). */ DEFV(Argument,DEFV(deltaF_2D,POINTERs(RAtranslation))); /* Translation horizontale ('dx') et verticale ('dy') de l'image Resultat ; on */ /* n'oubliera pas que cette translation est exprimee dans des unites telles */ /* l'unite soit respectivement [Xmin,Xmax] et [Ymin,Ymax]. Cette translation est */ /* appliquee lors de l'acces a l'image Argument (d'ou le nom "RA..."). ATTENTION, pendant */ /* tres longtemps, cet argument de translation sur l'image Resultat fut le seul (ce qui */ /* signifie que 'RRtranslation' n'existait pas), et il s'appelait alors 'Rtranslation' ; il */ /* a ete introduit pour permettre, par exemple, a la commande 'v $xci/accumule.02$K' et au */ /* programme 'v $xrc/julia.42$K' de faire des translations inferieures a un point (auquel */ /* cas d'ailleurs la rotation est d'angle nul...). */ DEFV(Argument,DEFV(deltaF_2D,POINTERs(Atranslation))); /* Translation horizontale ('dx') et verticale ('dy') de l'image Argument ; on */ /* n'oubliera pas que cette translation est exprimee dans des unites telles */ /* l'unite soit respectivement [Xmin,Xmax] et [Ymin,Ymax]. */ DEFV(Argument,DEFV(Float,angle)); /* Angle en radians de la rotation. */ DEFV(Argument,DEFV(Logical,interpoler)); /* Indique si l'on doit interpoler ('VRAI') ou pas ('FAUX') les niveaux a */ /* l'interieur de la transformee de la maille elementaire. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Float,INIT(Xf,FLOT__UNDEF)); DEFV(Float,INIT(Yf,FLOT__UNDEF)); /* Coordonnees flottantes 'X' et 'Y'. */ DEFV(Float,INIT(coordonnee_u,FLOT__UNDEF)); /* Valeur de-normalisee de 'X', */ DEFV(Float,INIT(coordonnee_v,FLOT__UNDEF)); /* Valeur de-normalisee de 'Y'. */ DEFV(Int,INIT(new_X,UNDEF)); /* Nouvelle coordonnee horizontale apres reduction, */ DEFV(Int,INIT(new_Y,UNDEF)); /* Et nouvelle coordonnee verticale... */ DEFV(Float,INIT(sinus_courant,FLOT__UNDEF)); /* Donne le 'sinus' de l'angle courant, */ DEFV(Float,INIT(cosinus_courant,FLOT__UNDEF)); /* Donne le 'cosinus' de l'angle courant. */ #ifdef INTERPOLATION_ROTATION_2D_VERSION_02 DEFV(genere_Float,INIT(niveau_courant,FLOT__NIVEAU_UNDEF)); /* Donne le niveau flottant courant apres l'eventuel interpolation... */ #Aifdef INTERPOLATION_ROTATION_2D_VERSION_02 #Eifdef INTERPOLATION_ROTATION_2D_VERSION_02 /*..............................................................................................................................*/ EGAL(sinus_courant,SINX(NEGA(angle))); EGAL(cosinus_courant,COSX(NEGA(angle))); /* Calcul des lignes trigonometriques de l'oppose de l'angle argument ; on */ /* utilise en effet la transformation "inverse" (donc d'angle oppose). */ #ifdef INTERPOLATION_ROTATION_2D_VERSION_01 Test(IL_FAUT(nettoyer)) Bblock CALS(IFinitialisation(imageR,FZERO)); /* Nettoyage de l'image resultat. */ Eblock ATes Bblock Eblock ETes PRINT_ATTENTION("la rotation d'une image non standard n'est pas implementee."); #Aifdef INTERPOLATION_ROTATION_2D_VERSION_01 #Eifdef INTERPOLATION_ROTATION_2D_VERSION_01 #ifdef INTERPOLATION_ROTATION_2D_VERSION_02 Test(IL_FAUT(nettoyer)) Bblock CALS(IFinitialisation(imageR,NIVEAU_DES_POINTS_NON_ATTEINTS_PAR_LA_ROTATION)); /* Et on nettoie la matrice Resultat (flottante) ; on prend pour cela le plus petit niveau */ /* possible, qui fera donc peut-etre une bordure autour de l'image (la ou il n'y a rien). */ Eblock ATes Bblock Eblock ETes ROTATION_D_UNE_IMAGE_NON_STANDARD(imageR,imageA,IFrotation_image_____interpolation_cubique); /* Mis sous cette forme le 20200123092928... */ #Aifdef INTERPOLATION_ROTATION_2D_VERSION_02 #Eifdef INTERPOLATION_ROTATION_2D_VERSION_02 RETIF(imageR); Eblock EFonctionF #undef ROTATION_D_UNE_IMAGE_NON_STANDARD #ifdef INTERPOLATION_ROTATION_2D_VERSION_02 # undef NIVEAU_DES_POINTS_NON_ATTEINTS_PAR_LA_ROTATION # undef NIVEAU_SUPERIEUR_DE_L_IMAGE_A_TOURNER # undef NIVEAU_INFERIEUR_DE_L_IMAGE_A_TOURNER #Aifdef INTERPOLATION_ROTATION_2D_VERSION_02 #Eifdef INTERPOLATION_ROTATION_2D_VERSION_02 #undef INTERPOLATION_ROTATION_2D_VERSION_02 #undef ROTATION_ET_TRANSLATION_DES_COORDONNEES _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E F I N I T I O N P A R A M E T R I Q U E D ' U N E M I S E A L ' E C H E L L E : */ /* */ /* */ /* Equations : */ /* */ /* X(U,V) = Tx+(Kx.U), */ /* Y(U,V) = Ty+(Ky.V). */ /* */ /* avec : */ /* */ /* U E [0,1], */ /* V E [0,1]. */ /* */ /*************************************************************************************************************************************/ DEFV(Common,DEFV(Float,ZINT(Fmise_a_l_echelle_x_____translation,FZERO))); DEFV(Common,DEFV(Float,ZINT(Fmise_a_l_echelle_y_____translation,FZERO))); /* La translation de mise a l'echelle est place dans une variable commune, afin */ /* de faire que 'Fx' et 'Fy' ne soient que des fonctions de (u,v)... */ DEFV(Common,DEFV(Float,ZINT(Fmise_a_l_echelle_x_____facteur,FU))); DEFV(Common,DEFV(Float,ZINT(Fmise_a_l_echelle_y_____facteur,FU))); /* Le facteur de mise a l'echelle est place dans une variable commune, afin */ /* de faire que 'Fx' et 'Fy' ne soient que des fonctions de (u,v)... */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E F I N I T I O N ' F x ' D E L A M I S E A L ' E C H E L L E : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,Fmise_a_l_echelle_x(u,v))) DEFV(Argument,DEFV(Float,u)); DEFV(Argument,DEFV(Float,v)); /* Coordonnees parametriques de la mise a l'echelle. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Float,INIT(fx,AXPB(Fmise_a_l_echelle_x_____facteur,u,Fmise_a_l_echelle_x_____translation))); /*..............................................................................................................................*/ RETU(fx); Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E F I N I T I O N ' F y ' D E L A M I S E A L ' E C H E L L E : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,Fmise_a_l_echelle_y(u,v))) DEFV(Argument,DEFV(Float,u)); DEFV(Argument,DEFV(Float,v)); /* Coordonnees parametriques de la mise a l'echelle. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Float,INIT(fy,AXPB(Fmise_a_l_echelle_y_____facteur,v,Fmise_a_l_echelle_y_____translation))); /*..............................................................................................................................*/ RETU(fy); Eblock EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E F I N I T I O N P A R A M E T R I Q U E D ' U N E R O T A T I O N : */ /* */ /* */ /* Equations : */ /* */ /* X(U,V) = Tx+(+U.cos(theta)+V.sin(theta)), */ /* Y(U,V) = Ty+(-U.sin(theta)+V.cos(theta)). */ /* */ /* avec : */ /* */ /* U E [0,1], */ /* V E [0,1]. */ /* */ /*************************************************************************************************************************************/ DEFV(Common,DEFV(Float,ZINT(Frotation_x_____translation,FZERO))); DEFV(Common,DEFV(Float,ZINT(Frotation_y_____translation,FZERO))); /* La translation de rotation est place dans une variable commune, afin */ /* de faire que 'Fx' et 'Fy' ne soient que des fonctions de (u,v)... */ DEFV(Common,DEFV(Float,ZINT(Frotation_x__Frotation_y_____angle,FZERO))); /* L'angle de rotation argument est place dans une variable commune, afin */ /* de faire que 'Fx' et 'Fy' ne soient que des fonctions de (u,v)... */ DEFV(Local,DEFV(Float,INIT(Frotation_x__Frotation_y_____angle_courant,FLOT__UNDEF))); /* Donne l'angle de rotation argument dont on a pre-calcule les 'sinus' */ /* et 'cosinus' (et ceux apres initialisation ; on notera les valeurs */ /* initiales 'FZERO' et 'UNDEF'). */ DEFV(Local,DEFV(Float,INIT(Frotation_x__Frotation_y_____sinus_courant,FLOT__UNDEF))); /* Donne le 'sinus' de l'angle courant, */ DEFV(Local,DEFV(Float,INIT(Frotation_x__Frotation_y_____cosinus_courant,FLOT__UNDEF))); /* Donne le 'cosinus' de l'angle courant, mais seulement lorsque les */ /* deux angles ('Frotation_x__Frotation_y_____angle' et 'angle_courant_de_rotation') sont */ /* egaux. */ #define INITIALISATION_SINUS_ET_COSINUS \ Bblock \ Test(IFNE(Frotation_x__Frotation_y_____angle_courant,Frotation_x__Frotation_y_____angle)) \ Bblock \ EGAL(Frotation_x__Frotation_y_____angle_courant,Frotation_x__Frotation_y_____angle); \ /* Lorsque l'angle argument a change (c'est en particulier le cas de */ \ /* l'initialisation), on le positionne, et on calcule ses lignes */ \ /* trigonometriques. */ \ EGAL(Frotation_x__Frotation_y_____sinus_courant,SINX(Frotation_x__Frotation_y_____angle_courant)); \ EGAL(Frotation_x__Frotation_y_____cosinus_courant,COSX(Frotation_x__Frotation_y_____angle_courant)); \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ /* Sequence d'initialisation des sinus et cosinus. */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E F I N I T I O N ' F x ' D E L A R O T A T I O N : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,Frotation_x(u,v))) DEFV(Argument,DEFV(Float,u)); DEFV(Argument,DEFV(Float,v)); /* Coordonnees parametriques de la rotation. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Float,INIT(fx,FLOT__UNDEF)); /* Valeur finale de la fonction. */ /*..............................................................................................................................*/ INITIALISATION_SINUS_ET_COSINUS; EGAL(fx,ADD2(ADD2(MUL2(u,Frotation_x__Frotation_y_____cosinus_courant) ,MUL2(v,NEGA(Frotation_x__Frotation_y_____sinus_courant)) ) ,Frotation_x_____translation ) ); RETU(fx); Eblock EFonctionF /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E F I N I T I O N ' F y ' D E L A R O T A T I O N : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(FonctionF,Frotation_y(u,v))) DEFV(Argument,DEFV(Float,u)); DEFV(Argument,DEFV(Float,v)); /* Coordonnees parametriques de la rotation. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Float,INIT(fy,FLOT__UNDEF)); /* Valeur finale de la fonction. */ /*..............................................................................................................................*/ INITIALISATION_SINUS_ET_COSINUS; EGAL(fy,ADD2(ADD2(MUL2(u,Frotation_x__Frotation_y_____sinus_courant) ,MUL2(v,Frotation_x__Frotation_y_____cosinus_courant) ) ,Frotation_y_____translation ) ); RETU(fy); Eblock EFonctionF #undef INITIALISATION_SINUS_ET_COSINUS _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* S E P A R A T I O N " P O I D S F A I B L E S " / " P O I D S F O R T S " : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(Int,SINT(Iseparation_poids_faibles_poids_forts_____facteur_____du_logarithme_base_2,UN))); DEFV(Common,DEFV(Int,SINT(Iseparation_poids_faibles_poids_forts_____translation_du_logarithme_base_2,ZERO))); /* Translation introduite le 20171129132101... */ DEFV(Common,DEFV(FonctionP,POINTERp(Iseparation_poids_faibles_poids_forts(imageR ,imageA ,ponderation_poids_faibles ,ponderation_poids_forts__ ) ) ) ) /* Fonction introduite le 20171129103245... */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Float,ponderation_poids_faibles)); DEFV(Argument,DEFV(Float,ponderation_poids_forts__)); /* Ponderations d'extraction des poids faibles et de poids forts... */ /* */ /* On notera le 20171129172717 que faire : */ /* */ /* ponderation_poids_faibles = ponderation_poids_forts__ = 1 */ /* */ /* donne une 'imageR' identique a 'imageA'... */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock DEFV(Int,INIT(niveau_courantA,INTE(load_point(imageA,X,Y)))); DEFV(Int,INIT(niveau_courantR,INTE(NOIR))); /* Afin de pouvoir faire de l'arithmetique, on utile 'Int' et non pas 'genere_p"... */ Test(IZGT(niveau_courantA)) /* Et oui, afin d'eviter un 'LO2X(...)' d'un nombre nul (ou negatif, mais ce cas est a */ /* piori impossible par definition de 'genere_p'...). */ Bblock DEFV(Int,INIT(logarithme_base_2_du_niveau_courantA,UNDEF)); DEFV(Int,INIT(exponentielle_base_2_du_logarithme_base_2_du_niveau_courantA,UNDEF)); DEFV(Int,INIT(poids_faibles,UNDEF)); DEFV(Int,INIT(poids_forts__,UNDEF)); /* Afin de pouvoir faire de l'arithmetique, on utile 'Int' et non pas 'genere_p"... */ EGAL(logarithme_base_2_du_niveau_courantA ,AXPB(Iseparation_poids_faibles_poids_forts_____facteur_____du_logarithme_base_2 ,INTE(LO2X(FLOT(niveau_courantA))) ,Iseparation_poids_faibles_poids_forts_____translation_du_logarithme_base_2 ) ); EGAL(exponentielle_base_2_du_logarithme_base_2_du_niveau_courantA ,INTE(EX02(FLOT(logarithme_base_2_du_niveau_courantA))) ); Test(IZGT(exponentielle_base_2_du_logarithme_base_2_du_niveau_courantA)) Bblock EGAL(poids_forts__,MULD(niveau_courantA,exponentielle_base_2_du_logarithme_base_2_du_niveau_courantA)); /* Calcul de la composante dite "cartoon". */ EGAL(poids_faibles,REST(niveau_courantA,exponentielle_base_2_du_logarithme_base_2_du_niveau_courantA)); /* Calcul de la composante dite "texture". */ Eblock ATes Bblock EGAL(poids_forts__,niveau_courantA); EGAL(poids_faibles,INTE(NOIR)); Eblock ETes EGAL(niveau_courantR ,GENP(LIZ2(ponderation_poids_forts__,FLOT(poids_forts__) ,ponderation_poids_faibles,FLOT(poids_faibles) ) ) ); /* Selection des poids a renvoyer. */ /* */ /* On notera le 20171129172717 que faire : */ /* */ /* ponderation_poids_faibles = ponderation_poids_forts__ = 1 */ /* */ /* donne une 'imageR' identique a 'imageA'... */ Eblock ATes Bblock Eblock ETes store_point(niveau_courantR ,imageR ,X,Y ,FVARIABLE ); Eblock end_image RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* P E R M U T A T I O N D E D E U X B I T S D E S C O O R D O N N E E S ' X ' E T ' Y ' */ /* D O N T L E " C A R R E " E S T L A T R A N S F O R M A T I O N U N I T E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Ipermutation_de_deux_bits_des_coordonnees(imageR ,imageA ,numero_a_droite_de_bit1_X,numero_a_droite_de_bit2_X ,numero_a_droite_de_bit1_Y,numero_a_droite_de_bit2_Y ) ) ) ) /* Fonction introduite le 20250110095410... */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[p(X)][p(Y)] avec permutation de deux */ /* bits des coordonnees 'X' et 'Y'... */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Positive,numero_a_droite_de_bit1_X)); DEFV(Argument,DEFV(Positive,numero_a_droite_de_bit2_X)); /* Definition de la permutation de deux bits des coordonnees 'X'. */ DEFV(Argument,DEFV(Positive,numero_a_droite_de_bit1_Y)); DEFV(Argument,DEFV(Positive,numero_a_droite_de_bit2_Y)); /* Definition de la permutation de deux bits des coordonnees 'Y'. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Positive,INIT(numero_a_gauche_de_bit1_X,TRMU(bSOU(NBITMO,MODU(numero_a_droite_de_bit1_X,ZERO,TRMU(NBITMO)))))); DEFV(Positive,INIT(numero_a_gauche_de_bit2_X,TRMU(bSOU(NBITMO,MODU(numero_a_droite_de_bit2_X,ZERO,TRMU(NBITMO)))))); DEFV(Positive,INIT(numero_a_gauche_de_bit1_Y,TRMU(bSOU(NBITMO,MODU(numero_a_droite_de_bit1_Y,ZERO,TRMU(NBITMO)))))); DEFV(Positive,INIT(numero_a_gauche_de_bit2_Y,TRMU(bSOU(NBITMO,MODU(numero_a_droite_de_bit2_Y,ZERO,TRMU(NBITMO)))))); /*..............................................................................................................................*/ begin_image Bblock DEFV(genere_p,INIT(niveau_courant,load_point(imageA,X,Y))); DEFV(Int,INIT(coordonnee_X_permutee,X)); DEFV(Int,INIT(coordonnee_Y_permutee,Y)); Test(IFNE(numero_a_gauche_de_bit1_X,numero_a_gauche_de_bit2_X)) Bblock DEFV(Int,INIT(bit1_coordonnee_X,TBIT(X,numero_a_gauche_de_bit1_X))); DEFV(Int,INIT(bit2_coordonnee_X,TBIT(X,numero_a_gauche_de_bit2_X))); Test(IFNE(bit1_coordonnee_X,bit2_coordonnee_X)) Bblock EGAL(coordonnee_X_permutee,CBIT(coordonnee_X_permutee,numero_a_gauche_de_bit2_X,bit1_coordonnee_X)); EGAL(coordonnee_X_permutee,CBIT(coordonnee_X_permutee,numero_a_gauche_de_bit1_X,bit2_coordonnee_X)); EGAL(coordonnee_X_permutee,MODX(coordonnee_X_permutee)); Eblock ATes Bblock Eblock ETes Eblock ATes Bblock Eblock ETes Test(IFNE(numero_a_gauche_de_bit1_Y,numero_a_gauche_de_bit2_Y)) Bblock DEFV(Int,INIT(bit1_coordonnee_Y,TBIT(Y,numero_a_gauche_de_bit1_Y))); DEFV(Int,INIT(bit2_coordonnee_Y,TBIT(Y,numero_a_gauche_de_bit2_Y))); Test(IFNE(bit1_coordonnee_Y,bit2_coordonnee_Y)) Bblock EGAL(coordonnee_Y_permutee,CBIT(coordonnee_Y_permutee,numero_a_gauche_de_bit2_Y,bit1_coordonnee_Y)); EGAL(coordonnee_Y_permutee,CBIT(coordonnee_Y_permutee,numero_a_gauche_de_bit1_Y,bit2_coordonnee_Y)); EGAL(coordonnee_Y_permutee,MODY(coordonnee_Y_permutee)); Eblock ATes Bblock Eblock ETes Eblock ATes Bblock Eblock ETes store_point(niveau_courant ,imageR ,coordonnee_X_permutee,coordonnee_Y_permutee ,FVARIABLE ); Eblock end_image RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* P E R M U T A T I O N D E R E G R O U P E M E N T */ /* D E S B I T S D E M E M E P O I D S D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ /* Les parametres par defaut 'TAILLE_PAR_DEFAUT_DES_PAQUETS_DE_PERMUTATION_DES_BITS' et */ /* 'TRANSLATION_PAR_DEFAUT_DES_INDEX_DE_BITS' sont dans v $xiii/di_image$DEF 20130707181135' */ /* le 20130707181124... */ #define VALIDATION_PERMUTATION_DES_BITS(taille_des_paquets_de_bits,translation_des_index_de_bits) \ Bblock \ DEFV(Logical,INIT(la_taille_des_paquets_est_acceptable,FAUX)); \ /* A priori, il y a un probleme avec la taille des paquets de bits... */ \ \ Test(INCLff(taille_des_paquets_de_bits,UN,NOCMO)) \ Bblock \ Test(DIVISIBLE(NOCMO,taille_des_paquets_de_bits)) \ /* On notera que l'on ne peut pas regrouper dans un meme tests via un 'IFET(...)' les */ \ /* deux tests precedents a cause du cas ou la taille serait nul ce qui provoquerait une */ \ /* division par 0 dans 'DIVISIBLE(...)'. */ \ Bblock \ EGAL(la_taille_des_paquets_est_acceptable,VRAI); \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ Test(EST_FAUX(la_taille_des_paquets_est_acceptable)) \ Bblock \ PRINT_ERREUR("la taille des paquets de permutation des bits est incorrecte"); \ CAL1(Prer4("(la valeur %d etait demandee (non dans [%d,%d] ou ne divisant pas %d) " \ ,taille_des_paquets_de_bits \ ,UN,NOCMO \ ,NOCMO \ ) \ ); \ \ EGAL(taille_des_paquets_de_bits,TAILLE_PAR_DEFAUT_DES_PAQUETS_DE_PERMUTATION_DES_BITS); \ \ CAL1(Prer1("et la valeur par defaut %d est donc retablie)\n",taille_des_paquets_de_bits)); \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ Test(IFOU(NINCff(translation_des_index_de_bits,SOUS(BIT0,BIT0),SOUS(BIT7,BIT0)) \ ,NON_DIVISIBLE(translation_des_index_de_bits,taille_des_paquets_de_bits) \ ) \ ) \ Bblock \ PRINT_ERREUR("la translation des index de permutation des bits est incorrecte"); \ CAL1(Prer4("(la valeur %d etait demandee (non dans [%d,%d] ou non divisible par la taille des paquets (%d) " \ ,translation_des_index_de_bits \ ,SOUS(BIT0,BIT0),SOUS(BIT7,BIT0) \ ,taille_des_paquets_de_bits \ ) \ ); \ \ EGAL(translation_des_index_de_bits,TRANSLATION_PAR_DEFAUT_DES_INDEX_DE_BITS); \ \ CAL1(Prer1("et la valeur par defaut %d est donc retablie)\n",translation_des_index_de_bits)); \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ Test(IZNE(NOIR)) \ Bblock \ PRINT_ERREUR("les operations logiques de permutation des bits ne fonctionneront pas correctement"); \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ CALS(Inoir(imageR)); \ /* Initialisation de l'image Resultat. */ \ Eblock \ /* Procedure de validation et d'initialisation introduite le 20130703164818... */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* P E R M U T A T I O N D I R E C T E D E R E G R O U P E M E N T */ /* D E S B I T S D E M E M E P O I D S D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(Positive,SINT(Ipermutation_directe_de_regroupement_des_bits_de_meme_poids_____taille_des_paquets_de_bits ,TAILLE_PAR_DEFAUT_DES_PAQUETS_DE_PERMUTATION_DES_BITS ) ) ); /* Introduit le 20130703091501... */ DEFV(Common,DEFV(Int,SINT(Ipermutation_directe_de_regroupement_des_bits_de_meme_poids_____translation_des_index_de_bits ,TRANSLATION_PAR_DEFAUT_DES_INDEX_DE_BITS ) ) ); /* Introduit le 20130707102837... */ DEFV(Common,DEFV(FonctionP,POINTERp(Ipermutation_directe_de_regroupement_des_bits_de_meme_poids(imageR,imageA)))) /* Fonction introduite le 20130702093635... */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=PERMUTATION_DES_BITS(imageA[X][Y]). */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Int,INIT(index_de_bitA,UNDEF)); /* L'acces aux bits de l'image Argument utilise {X,Y,index_de_bitA}. */ DEFV(Int,INIT(coordonnee_XR,Xmin)); DEFV(Int,INIT(coordonnee_YR,Ymin)); DEFV(Int,INIT(index_de_bitR,BIT0)); /* L'acces aux bits de l'image Resultat utilise {coordonnee_XR,coordonnee_YR,index_de_bitR}. */ /*..............................................................................................................................*/ VALIDATION_PERMUTATION_DES_BITS(Ipermutation_directe_de_regroupement_des_bits_de_meme_poids_____taille_des_paquets_de_bits ,Ipermutation_directe_de_regroupement_des_bits_de_meme_poids_____translation_des_index_de_bits ); /* Introduit sous cette forme le 20130703164818... */ DoIn(index_de_bitA ,BIT0 ,BIT7 ,Ipermutation_directe_de_regroupement_des_bits_de_meme_poids_____taille_des_paquets_de_bits ) Bblock begin_image Bblock DEFV(genere_p,INIT(niveau_courantA,load_point(imageA,X,Y))); /* Octet courant de 'imageA' dont on doit recopier le bit 'index_de_bitA' dans 'imageR'. */ DEFV(Positive,INIT(increment_de_index_de_bitA,ZERO)); /* Afin de gerer les paquets de bits... */ Repe(Ipermutation_directe_de_regroupement_des_bits_de_meme_poids_____taille_des_paquets_de_bits) Bblock DEFV(genere_p,INIT(niveau_courantR,load_point(imageR,coordonnee_XR,coordonnee_YR))); /* Octet courant de 'imageR' qui doit recevoir le bit 'index_de_bitA' de 'imageA'. */ #define translation_des_index_de_bits \ Ipermutation_directe_de_regroupement_des_bits_de_meme_poids_____translation_des_index_de_bits \ /* Afin de raccourcir certaines lignes ci-apres... */ EGAL(niveau_courantR ,CBITo(niveau_courantR ,index_de_bitR ,TBITo(niveau_courantA ,MODS(ADD2(ADD2(index_de_bitA,increment_de_index_de_bitA) ,translation_des_index_de_bits ) ,BIT0 ,BIT7 ) ) ) ); /* Copie d'un bit de 'imageA' vers 'imageR' (mise sous cette forme le 20130703112537). */ /* */ /* Le 20130707112250, je note que le 'MODS(...)' est redondant avec ce qui est fait dans */ /* 'VALIDATION_PERMUTATION_DES_BITS(...)' dans le cas ou 'translation_des_index_de_bits' */ /* possede une valeur incorrecte... */ #undef translation_des_index_de_bits store_point(niveau_courantR ,imageR ,coordonnee_XR,coordonnee_YR ,FVARIABLE ); /* Generation progressive (c'est-a-dire "paquet de bits par paquet de bits") de l'image */ /* Resultat. */ INCR(index_de_bitR,I); /* Progression de l'index des bits de l'image Resultat. */ Test(IFGT(index_de_bitR,BIT7)) Bblock EGAL(index_de_bitR,BIT0); INCR(coordonnee_XR,pasX); /* En cas de debordement de l'index des bits de l'image Resultat, c'est 'coordonnee_XR' */ /* qui doit progresser. */ Test(IFGT(coordonnee_XR,Xmax)) Bblock EGAL(coordonnee_XR,Xmin); INCR(coordonnee_YR,pasY); /* En cas de debordement 'coordonnee_XR', c'est 'coordonnee_YR' qui doit progresser. */ Eblock ATes Bblock Eblock ETes Eblock ATes Bblock Eblock ETes INCR(increment_de_index_de_bitA,I); Eblock ERep Eblock end_image Eblock EDoI RETI(imageR); Eblock EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* P E R M U T A T I O N I N V E R S E D E R E G R O U P E M E N T */ /* D E S B I T S D E M E M E P O I D S D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(Positive,SINT(Ipermutation_inverse_de_regroupement_des_bits_de_meme_poids_____taille_des_paquets_de_bits ,TAILLE_PAR_DEFAUT_DES_PAQUETS_DE_PERMUTATION_DES_BITS ) ) ); /* Introduit le 20130703091501... */ DEFV(Common,DEFV(Int,SINT(Ipermutation_inverse_de_regroupement_des_bits_de_meme_poids_____translation_des_index_de_bits ,TRANSLATION_PAR_DEFAUT_DES_INDEX_DE_BITS ) ) ); /* Introduit le 20130707102837... */ DEFV(Common,DEFV(FonctionP,POINTERp(Ipermutation_inverse_de_regroupement_des_bits_de_meme_poids(imageR,imageA)))) /* Fonction introduite le 20130702093635... */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=PERMUTATION_DES_BITS(imageA[X][Y]). */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Int,INIT(index_de_bitA,UNDEF)); /* L'acces aux bits de l'image Argument utilise {X,Y,index_de_bitA}. */ DEFV(Int,INIT(coordonnee_XR,Xmin)); DEFV(Int,INIT(coordonnee_YR,Ymin)); DEFV(Int,INIT(index_de_bitR,BIT0)); /* L'acces aux bits de l'image Resultat utilise {coordonnee_XR,coordonnee_YR,index_de_bitR}. */ /*..............................................................................................................................*/ VALIDATION_PERMUTATION_DES_BITS(Ipermutation_inverse_de_regroupement_des_bits_de_meme_poids_____taille_des_paquets_de_bits ,Ipermutation_inverse_de_regroupement_des_bits_de_meme_poids_____translation_des_index_de_bits ); /* Introduit sous cette forme le 20130703164818... */ begin_image Bblock DEFV(genere_p,INIT(niveau_courantA,load_point(imageA,X,Y))); /* Octet courant de 'imageA' dont on doit repartir les bits sur huit octets de 'imageR'. */ DoIn(index_de_bitA ,BIT0 ,BIT7 ,Ipermutation_inverse_de_regroupement_des_bits_de_meme_poids_____taille_des_paquets_de_bits ) Bblock DEFV(genere_p,INIT(niveau_courantR,load_point(imageR,coordonnee_XR,coordonnee_YR))); /* Octet courant de 'imageR' qui doit recevoir le bit 'index_de_bitA' de 'imageA'. */ DEFV(Positive,INIT(increment_des_index_de_bitA__et__index_de_bitR,ZERO)); /* Afin de gerer les paquets de bits... */ Repe(Ipermutation_inverse_de_regroupement_des_bits_de_meme_poids_____taille_des_paquets_de_bits) Bblock #define translation_des_index_de_bits \ Ipermutation_inverse_de_regroupement_des_bits_de_meme_poids_____translation_des_index_de_bits \ /* Afin de raccourcir certaines lignes ci-apres... */ EGAL(niveau_courantR ,CBITo(niveau_courantR ,MODS(ADD2(ADD2(index_de_bitR,increment_des_index_de_bitA__et__index_de_bitR) ,translation_des_index_de_bits ) ,BIT0 ,BIT7 ) ,TBITo(niveau_courantA,ADD2(index_de_bitA,increment_des_index_de_bitA__et__index_de_bitR)) ) ); /* Copie d'un bit de 'imageA' vers 'imageR' (mise sous cette forme le 20130703112537). */ /* */ /* Le 20130707112250, je note que le 'MODS(...)' est redondant avec ce qui est fait dans */ /* 'VALIDATION_PERMUTATION_DES_BITS(...)' dans le cas ou 'translation_des_index_de_bits' */ /* possede une valeur incorrecte... */ #undef translation_des_index_de_bits INCR(increment_des_index_de_bitA__et__index_de_bitR,I); Eblock ERep store_point(niveau_courantR ,imageR ,coordonnee_XR,coordonnee_YR ,FVARIABLE ); /* Generation progressive (c'est-a-dire "paquet de bits par paquet de bits") de l'image */ /* Resultat. */ INCR(coordonnee_XR,pasX); /* Progression de 'coordonnee_XR'. */ Test(IFGT(coordonnee_XR,Xmax)) Bblock EGAL(coordonnee_XR,Xmin); INCR(coordonnee_YR,pasY); /* En cas de debordement 'coordonnee_XR', c'est 'coordonnee_YR' qui doit progresser. */ Test(IFGT(coordonnee_YR,Ymax)) Bblock EGAL(coordonnee_YR,Ymin); INCR(index_de_bitR ,Ipermutation_inverse_de_regroupement_des_bits_de_meme_poids_____taille_des_paquets_de_bits ); /* En cas de debordement de 'coordonnee_YR', c'est l'index des bits de l'image Resultat */ /* qui doit progresser. */ Eblock ATes Bblock Eblock ETes Eblock ATes Bblock Eblock ETes Eblock EDoI Eblock end_image RETI(imageR); Eblock EFonctionP #undef VALIDATION_PERMUTATION_DES_BITS _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* C O M P R E S S I O N V E R T I C A L E D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Local,DEFV(FonctionP,POINTERp(Icompression_verticale(imageR,imageA)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y/2]=imageA[X][Y] ; */ /* */ /* */ /* ------------------ ------------------ */ /* | | | / / / / / / / / /| */ /* | | | / / / / / / / / /| */ /* | | | / / / / / / / / /| */ /* | | | / / / / / / / / /| */ /* | | --O--> |------------------| */ /* | | | | */ /* | | | | */ /* | | | | */ /* | | | | */ /* ------------------ ------------------ */ /* */ /* */ /* on notera que la moitie superieure de imageR n'est pas re-initialisee. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock store_point(NIVA(INTM(NIVR(load_point(imageA,X,COYA(PAR0(COYR(Y))))) ,NIVR(load_point(imageA,X,COYA(PAR1(COYR(Y))))) ) ) ,imageR ,X,COYA(MOIT(COYR(Y))) ,FVARIABLE ); Eblock end_image RETI(imageR); Eblock EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* P E R M U T A T I O N D E D E U X S O U S - I M A G E S C A R R E E S */ /* S I T U E E S E N H A U T A G A U C H E E T E N B A S A D R O I T E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Ipermutation_BD_HG(imageR,imageA)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR_BG[X][Y]=imageA_BG[X][Y], */ /* imageR_HD[X][Y]=imageA_HD[X][Y], */ /* */ /* et : imageR_BD[X][Y]=imageA_HG[X][Y], */ /* imageR_HG[X][Y]=imageA_BD[X][Y], */ /* */ /* */ /* HG HD */ /* ------------------- ------------------- */ /* | | | | | | */ /* | | | | | | */ /* | 3 | 4 | | 2 | 4 | */ /* | | | | | | */ /* | | | | | | */ /* |---------|---------| --O--> |---------|---------| */ /* | | | | | | */ /* | | | | | | */ /* | 1 | 2 | | 1 | 3 | */ /* | | | | | | */ /* | | | | | | */ /* ------------------- ------------------- */ /* BG BD */ /* */ /* */ /* ou 'BG' signifie 'Bas-Gauche', */ /* 'HD', 'Haut-Droit', */ /* 'BD', 'Bas-Droit', */ /* et 'HG', 'Haut-Gauche'. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(genere_p,INIT(niveau1,NIVEAU_UNDEF)); DEFV(genere_p,INIT(niveau2,NIVEAU_UNDEF)); /* Deux niveaux de manoeuvre... */ /*..............................................................................................................................*/ begin_image Bblock Test(IFOU(IFET(IFLE(X,Xmax2) ,IFLE(Y,Ymax2) ) ,IFET(IFGE(X,Xmin2) ,IFGE(Y,Ymin2) ) ) ) Bblock store_point(load_point(imageA,X,Y) ,imageR ,X ,Y ,FVARIABLE ); /* Pour les demi-images 'BG' et 'HD', il n'y a pas de permutation... */ Eblock ATes Bblock /* Pour les demi-images 'BD' et 'HG', il y a permutation : */ Test(IFET(IFLE(X,Xmax2) ,IFGE(Y,Ymin2) ) ) /* Nota : seul le test sur 'X' (par exemple) aurait suffit, mais */ /* on met les deux par symetrie entre les deux coordonnees. */ Bblock DEFV(Int,INIT(X_translate,COXA(ADD2(dimX2,COXR(X))))); DEFV(Int,INIT(Y_translate,COYA(SOUS(COYR(Y),dimY2)))); /* Introduit le 20161114135703 pour simplifier ce qui suit... */ EGAL(niveau1 ,load_point(imageA ,X ,Y ) ); /* Recuperation de l'image 'HG', */ EGAL(niveau2 ,load_point(imageA ,X_translate ,Y_translate ) ); /* Recuperation de l'image 'BD'. */ store_point(niveau2 ,imageR ,X ,Y ,FVARIABLE ); store_point(niveau1 ,imageR ,X_translate ,Y_translate ,FVARIABLE ); /* Puis permutation des deux demi-images 'BD' et 'HG'. */ Eblock ATes Bblock Eblock ETes Eblock ETes Eblock end_image RETI(imageR); Eblock EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D I L A T A T I O N H O R I Z O N T A L E D ' U N E I M A G E : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Local,DEFV(FonctionP,POINTERp(Idilatation_horizontale(imageR,imageA)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X/2][Y] ; */ /* */ /* */ /* ------------------- ------------------- */ /* | | / / / / | | | */ /* | | / / / / | | | */ /* | 2 | / / / / | | 2 | */ /* | | / / / / | | | */ /* | | / / / / | | | */ /* |---------|---------| --O--> |-------------------| */ /* | | / / / / | | | */ /* | | / / / / | | | */ /* | 1 | / / / / | | 1 | */ /* | | / / / / | | | */ /* | | / / / / | | | */ /* ------------------- ------------------- */ /* */ /* */ /* on notera que la moitie droite de imageR est perdue... */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock store_point(load_point(imageA,COXA(MOIT(COXR(X))),Y) ,imageR ,X,Y ,FVARIABLE ); Eblock end_image RETI(imageR); Eblock EFonctionP /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* T R A N S F O R M A T I O N D I T E " D U B O U L A N G E R " : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(FonctionP,POINTERp(Itransformation_du_boulanger(imageR,imageA)))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=imageA[X/2][Y] transformee par */ /* l'operation dite "du boulanger", qui revient a : */ /* */ /* 1 - contracter dans un rapport 2 verticalement, */ /* 2 - dilater dans un rapport 2 horizontalement, */ /* 3 - et enfin recouvrir horizontalement la droite au-dessus de la gauche. */ /* */ /* ce qui fait que l'integralite des niveaux est conservee ; les points sont simplement */ /* deplaces... */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock BDEFV(image,imageM1); /* Image de Manoeuvre 1, */ BDEFV(image,imageM2); /* Image de Manoeuvre 2. */ /*..............................................................................................................................*/ CALS(Inoir(imageM1)); /* Initialisation de la premiere image de Manoeuvre. */ CALS(Icompression_verticale(imageM1,imageA)); /* Contraction verticale de rapport 2 de l'image Argument : */ /* */ /* A M1 */ /* ------------------ ------------------ */ /* | | | / / / / / / / / /| */ /* | | | / / / / / / / / /| */ /* | | | / / / / / / / / /| */ /* | | | / / / / / / / / /| */ /* | | --O--> |------------------| */ /* | | | | */ /* | | | | */ /* | | | | */ /* | | | | */ /* ------------------ ------------------ */ /* */ CALS(Ipermutation_BD_HG(imageM2,imageM1)); /* Permutation de deux demi-images 'BD' et 'HG' afin de simuler le */ /* recouvrement horizontal de la droite (2=BD) sur la gauche (1=BG) : */ /* */ /* M 1 M 2 */ /* HG HD */ /* ------------------- ------------------- */ /* | / / / / | / / / / | | | / / / / | */ /* | / / / / | / / / / | | | / / / / | */ /* | / /3/ / | / /4/ / | | 2 | / /4/ / | */ /* | / / / / | / / / / | | | / / / / | */ /* | / / / / | / / / / | | | / / / / | */ /* |---------|---------| --O--> |---------|---------| */ /* | | | | | / / / / | */ /* | | | | | / / / / | */ /* | 1 | 2 | | 1 | / /3/ / | */ /* | | | | | / / / / | */ /* | | | | | / / / / | */ /* ------------------- ------------------- */ /* BG BD */ /* */ CALS(Idilatation_horizontale(imageR,imageM2)); /* Dilatation horizontale de rapport 2 : */ /* */ /* ------------------- ------------------- */ /* | | / / / / | | | */ /* | | / / / / | | | */ /* | 2 | / / / / | | 2 | */ /* | | / / / / | | | */ /* | | / / / / | | | */ /* |---------|---------| --O--> |-------------------| */ /* | | / / / / | | | */ /* | | / / / / | | | */ /* | 1 | / / / / | | 1 | */ /* | | / / / / | | | */ /* | | / / / / | | | */ /* ------------------- ------------------- */ /* */ EDEFV(image,imageM2); /* Image de Manoeuvre 2, */ EDEFV(image,imageM1); /* Image de Manoeuvre 1. */ RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* T R A N S F O R M A T I O N D I T E " P H O T O M A T O N " */ /* ( U T I L E S U R T O U T P O U R L E S F O R M A T S D ' I M A G E P U I S S A N C E S D E 2 ) : */ /* */ /*************************************************************************************************************************************/ BFonctionP DEFV(Common,DEFV(Int,SINT(Itransformation_photomaton_____facteur_de_reduction_en_X,DEUX))); DEFV(Common,DEFV(Int,SINT(Itransformation_photomaton_____facteur_de_reduction_en_Y,DEUX))); /* Facteurs de reduction en 'X' et 'Y'... */ DEFV(Common,DEFV(FonctionP,POINTERp(Itransformation_photomaton(imageR,imageA)))) /* Cette fonction introduite le 20031223110804 procede a la transformation de 'imageA' */ /* de facon a ce que l'integralite des niveaux soit conservee ; les points sont simplement */ /* deplaces... */ DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock /*..............................................................................................................................*/ begin_image Bblock store_point(load_point(imageA,X,Y) ,imageR ,COXA(AXPB(REST(COXR(X),Itransformation_photomaton_____facteur_de_reduction_en_X) ,DIVI(dimX,Itransformation_photomaton_____facteur_de_reduction_en_X) ,DIVI(COXR(X),Itransformation_photomaton_____facteur_de_reduction_en_X) ) ) ,COYA(AXPB(REST(COYR(Y),Itransformation_photomaton_____facteur_de_reduction_en_Y) ,DIVI(dimY,Itransformation_photomaton_____facteur_de_reduction_en_Y) ,DIVI(COYR(Y),Itransformation_photomaton_____facteur_de_reduction_en_Y) ) ) ,FVARIABLE ); /* Je note le 20081008101649 qu'evidemment cette transformation ne retombe sur ses pieds */ /* au bout de N iterations que si 'dimX' et 'dimY' sont egales et egales a une puissance */ /* de 2 (en mode 'Std', N=9 c'est-a-dire le logarithme en base 2 de 'dimX' et de 'dimY'). */ /* Ceci bien sur si les facteurs de reduction en 'X' et en 'Y' sont tous les deux egaux */ /* a 'DEUX' (valeur par defaut...). */ Eblock end_image RETI(imageR); Eblock EFonctionP _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* T R A C E D ' U N P R O F I L H O R I Z O N T A L E T I N T E G R A T I O N N U M E R I Q U E : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Float,SINT(Iprofil_horizontal_____echelle_des_segments,FU))); /* Lorsque 'IL_FAUT(marquer_les_coupes_par_un_segment)', donne le facteur d'echelle des */ /* ordonnees des segments traces. */ DEFV(Common,DEFV(Logical,SINT(Iprofil_horizontal_____marquer_le_NOIR,VRAI))); /* Introduit le 20200506124723 afin de pouvoir inhiber le marquage des points de la coupe */ /* possedant un niveau NOIR (et ce pour 'v $Fdivers GProfilP'...). */ DEFV(Common,DEFV(FonctionF,Iprofil_horizontal(imageR,imageA,Y_du_profil,niveau_du_trace,marquer_les_coupes_par_un_segment))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=profil de la ligne horizontale d'ordonnee */ /* Y = 'Y_du_profil'. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Float,Y_du_profil)); /* Ordonnee dans [0,1] de la ligne horizontale dont on veut le profil. */ DEFV(Argument,DEFV(genere_p,niveau_du_trace)); /* Niveau dans lequel tracer le profil horizontal. */ DEFV(Argument,DEFV(Logical,marquer_les_coupes_par_un_segment)); /* Indique s'il faut marquer les coupes par un segment ('VRAI') ou bien a l'aide d'un */ /* point isole ('FAUX'). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Float,INIT(integrale_de_la_coupe,FZERO)); /* A priori l'integrale de la coupe consideree comme une courbe du plan va etre calculee... */ /*..............................................................................................................................*/ begin_ligne Bblock DEFV(Int,INIT(ordonnee_de_la_coupe ,_cDENORMALISE_OY(MUL2(Iprofil_horizontal_____echelle_des_segments ,______NORMALISE_NIVEAU(NIVR(load_point_valide(imageA ,X ,_cDENORMALISE_OY(Y_du_profil) ) ) ) ) ) ) ); /* Ordonnee du point courant de la coupe. */ Test(IFET(IL_NE_FAUT_PAS(Iprofil_horizontal_____marquer_le_NOIR) ,IFEQ(ordonnee_de_la_coupe,Ymin) ) ) Bblock EGAL(ordonnee_de_la_coupe,PREY(ordonnee_de_la_coupe)); /* Ainsi, l'elimination se fera via le 'store_point_valide(...)' ci-apres... */ Eblock ATes Bblock Eblock ETes begin_colonne Bblock Test(IFOU(IFET(IL_FAUT(marquer_les_coupes_par_un_segment) ,IFLE(Y,ordonnee_de_la_coupe) ) ,IFET(IL_NE_FAUT_PAS(marquer_les_coupes_par_un_segment) ,IFEQ(Y,ordonnee_de_la_coupe) ) ) ) Bblock store_point_valide(niveau_du_trace ,imageR ,X,Y ,FVARIABLE ); /* Marquage de la coupe par des points isoles ou par des segments... */ Eblock ATes Bblock Eblock ETes Eblock end_colonne INCR(integrale_de_la_coupe,MUL2(COYR(ordonnee_de_la_coupe),pasX)); /* A priori l'integrale de la coupe consideree comme une courbe du plan est calculee a */ /* l'aide de la methode des trapezes... */ Eblock end_ligne RETU(integrale_de_la_coupe); Eblock EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* T R A C E D ' U N P R O F I L V E R T I C A L E T I N T E G R A T I O N N U M E R I Q U E : */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Float,SINT(Iprofil_vertical_____echelle_des_segments,FU))); /* Lorsque 'IL_FAUT(marquer_les_coupes_par_un_segment)', donne le facteur d'echelle des */ /* abscisses des segments traces. */ DEFV(Common,DEFV(Logical,SINT(Iprofil_vertical_____marquer_le_NOIR,VRAI))); /* Introduit le 20200506124723 afin de pouvoir inhiber le marquage des points de la coupe */ /* possedant un niveau NOIR (et ce pour 'v $Fdivers GProfilP'...). */ DEFV(Common,DEFV(FonctionF,Iprofil_vertical(imageR,imageA,X_du_profil,niveau_du_trace,marquer_les_coupes_par_un_segment))) DEFV(Argument,DEFV(image,imageR)); /* Image Resultat, telle que : imageR[X][Y]=profil de la ligne vertical d'abscisse */ /* X = 'X_du_profil'. */ DEFV(Argument,DEFV(image,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Float,X_du_profil)); /* Abscisse dans [0,1] de la ligne vertical dont on veut le profil. */ DEFV(Argument,DEFV(genere_p,niveau_du_trace)); /* Niveau dans lequel tracer le profil vertical. */ DEFV(Argument,DEFV(Logical,marquer_les_coupes_par_un_segment)); /* Indique s'il faut marquer les coupes par un segment ('VRAI') ou bien a l'aide d'un */ /* point isole ('FAUX'). */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Float,INIT(integrale_de_la_coupe,FZERO)); /* A priori l'integrale de la coupe consideree comme une courbe du plan va etre calculee... */ /*..............................................................................................................................*/ begin_colonne Bblock DEFV(Int,INIT(abscisse_de_la_coupe ,_cDENORMALISE_OX(MUL2(Iprofil_vertical_____echelle_des_segments ,______NORMALISE_NIVEAU(NIVR(load_point_valide(imageA ,_cDENORMALISE_OX(X_du_profil) ,Y ) ) ) ) ) ) ); /* Abscisse du point courant de la coupe. */ Test(IFET(IL_NE_FAUT_PAS(Iprofil_vertical_____marquer_le_NOIR) ,IFEQ(abscisse_de_la_coupe,Xmin) ) ) Bblock EGAL(abscisse_de_la_coupe,PREX(abscisse_de_la_coupe)); /* Ainsi, l'elimination se fera via le 'store_point_valide(...)' ci-apres... */ Eblock ATes Bblock Eblock ETes begin_ligne Bblock Test(IFOU(IFET(IL_FAUT(marquer_les_coupes_par_un_segment) ,IFLE(X,abscisse_de_la_coupe) ) ,IFET(IL_NE_FAUT_PAS(marquer_les_coupes_par_un_segment) ,IFEQ(X,abscisse_de_la_coupe) ) ) ) Bblock store_point_valide(niveau_du_trace ,imageR ,X,Y ,FVARIABLE ); /* Marquage de la coupe par des points isoles ou par des segments... */ Eblock ATes Bblock Eblock ETes Eblock end_ligne INCR(integrale_de_la_coupe,MUL2(COXR(abscisse_de_la_coupe),pasY)); /* A priori l'integrale de la coupe consideree comme une courbe du plan est calculee a */ /* l'aide de la methode des trapezes... */ Eblock end_colonne RETU(integrale_de_la_coupe); Eblock EFonctionF _______________________________________________________________________________________________________________________________________ _______________________________________________________________________________________________________________________________________ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E N S I T E D ' U N E I M A G E : */ /* */ /* */ /* Definition : */ /* */ /* En chaque point {X,Y} on definit une */ /* densite par : */ /* ______ */ /* \ -Ke.distance({X,Y},{X ,Y }) */ /* \ c c */ /* densite(X,Y) = Kn. / niveau(X ,Y ).e */ /* /_____ c c */ /* */ /* ou les points {Xc,Yc} sont les points */ /* d'un voisinage circulaire de {X,Y}. */ /* */ /* */ /*************************************************************************************************************************************/ BFonctionF DEFV(Common,DEFV(Logical,SINT(IFdensite_____compatibilite_20110908,FAUX))); /* Permet de generer des images suivant la methode anterieure au 20110908080501 en */ /* ce qui concerne une seconde renormalisation des exponentielles a l'interieur du */ /* cercle inscrit... */ DEFV(Common,DEFV(Logical,SINT(IFdensite_____compatibilite_2014010308,FAUX))); /* Permet de generer des images suivant la methode anterieure au 20140103085308... */ DEFV(Common,DEFV(Logical,SINT(IFdensite_____compatibilite_2014010310,FAUX))); /* Permet de generer des images suivant la methode anterieure au 20140103104022... */ #define DIMENSION_DE_LA_BOITE_X \ DOUP(demi_dimension_X) #define DIMENSION_DE_LA_BOITE_Y \ DOUP(demi_dimension_Y) /* Dimension de la boite a utiliser. */ #define ACCES_EXPONENTIELLE_PONDEREE_D_UNE_DISTANCE(Xc,Yc,x,y) \ IdTb2(matrice_des_distances \ ,INDX(SOUS(x,Xc),X_gauche) \ ,DIMENSION_DE_LA_BOITE_X \ ,INDX(SOUS(y,Yc),Y_bas___) \ ,DIMENSION_DE_LA_BOITE_Y \ ) \ /* Acces a la distance entre le point courant {x,y} et le centre {Xc,Yc} de la boite. */ #define RENORM_EXPONENTIELLES(exponentielle) \ Bblock \ EGAL(exponentielle \ ,NORZ(exponentielle \ ,minimum_des_exponentielles \ ,maximum_des_exponentielles \ ,ZNE2(minimum_des_exponentielles \ ,maximum_des_exponentielles \ ,COORDONNEE_BARYCENTRIQUE_MAXIMALE \ ) \ ) \ ); \ Eblock \ /* Procedure introduite le 20140103085530... */ DEFV(Common,DEFV(Logical,SINT(IFdensite_____version_simplifiee,FAUX))); /* Afin de pouvoir acceder a une version simplifiee introduite le 20170730095518... */ DEFV(Common,DEFV(genere_Float,SINT(IFdensite_____ponderation_RdisF2D,FU))); DEFV(Common,DEFV(genere_Float,SINT(IFdensite_____ponderation_ASdisF2D,FZERO))); /* Choix de la distance {RdisF2D,ASdisF2D} introduit le 20170730105144... */ DEFV(Common,DEFV(Logical,SINT(IFdensite_____periodiser_X,FAUX))); DEFV(Common,DEFV(Logical,SINT(IFdensite_____periodiser_Y,FAUX))); /* Options par defaut de periodisation des axes. */ DEFV(Common,DEFV(Logical,SINT(IFdensite_____symetriser_X,FAUX))); DEFV(Common,DEFV(Logical,SINT(IFdensite_____symetriser_Y,FAUX))); /* Options par defaut de symetrisation des axes (introduites le 20050721103950). */ DEFV(Common,DEFV(Logical,SINT(IFdensite_____prolonger_X,FAUX))); DEFV(Common,DEFV(Logical,SINT(IFdensite_____prolonger_Y,FAUX))); /* Options par defaut de prolongement des axes. */ DEFV(Common,DEFV(genere_Float,SINT(IFdensite_____niveau_hors_image,FZERO))); /* Options par defaut du niveau "hors-image". */ DEFV(Common,DEFV(FonctionF,POINTERF(IFdensite(imageR,imageA,demi_dimension_X,demi_dimension_Y,facteurN,facteurD,exposantD,renorm)))) DEFV(Argument,DEFV(imageF,imageR)); /* Image Resultat, telle que : imageR[X][Y]=densite(imageA[X][Y]). */ DEFV(Argument,DEFV(imageF,imageA)); /* Image Argument. */ DEFV(Argument,DEFV(Positive,demi_dimension_X)); DEFV(Argument,DEFV(Positive,demi_dimension_Y)); /* Demi-dimension de la boite centree en chaque point {X,Y} dans laquelle on calcule la */ /* densite. */ DEFV(Argument,DEFV(Float,facteurN)); /* Facteur du niveau. */ DEFV(Argument,DEFV(Float,facteurD)); /* Facteur de la distance. */ DEFV(Argument,DEFV(Float,exposantD)); /* Exposant de la distance. */ DEFV(Argument,DEFV(Logical,renorm)); /* Faut-il renormaliser les exponentielles ? */ /*-----------------------------------------------------------------------------------------------------------------------------------*/ Bblock DEFV(Float,DdTb2(POINTERf ,matrice_des_distances ,DIMENSION_DE_LA_BOITE_X ,DIMENSION_DE_LA_BOITE_Y ,ADRESSE_NON_ENCORE_DEFINIE ) ); /* Definition de la matrice des distances. */ DEFV(Float,INIT(exponentielle_du_rayon_du_cercle_inscrit ,COND(IL_FAUT(IFdensite_____compatibilite_2014010310) ,F_MOINS_L_INFINI ,F_INFINI ) ) ); /* Exponentielle du rayon du cercle inscrit dans la boite. */ /* */ /* ATTENTION : jusqu'au 20091124115242 il y avait ci-dessus 'F_INFINI' par erreur. Mais */ /* le 20140103104022, je me suis rendu compte que ce n'etait pas une erreur ! */ DEFV(Int,INIT(X_gauche,NEGA(demi_dimension_X))); DEFV(Int,INIT(X_centre,UNDEF)); DEFV(Int,INIT(X_droite,NEUT(demi_dimension_X))); /* Points interessants de l'axe 'OX'. */ DEFV(Int,INIT(Y_bas___,NEGA(demi_dimension_Y))); DEFV(Int,INIT(Y_centre,UNDEF)); DEFV(Int,INIT(Y_haut__,NEUT(demi_dimension_Y))); /* Points interessants de l'axe 'OY'. */ DEFV(Float,INIT(minimum_des_exponentielles,F_INFINI)); DEFV(Float,INIT(maximum_des_exponentielles,F_MOINS_L_INFINI)); /* Extrema des exponentielles en vue d'une eventuelle renormalisation... */ /*..............................................................................................................................*/ EGAL(X_centre,MOYE(X_gauche,X_droite)); EGAL(Y_centre,MOYE(Y_bas___,Y_haut__)); /* Calcul des centres relatifs aux axes 'OX' et 'OY'. */ Test(IFOU(IZNE(X_centre),IZNE(Y_centre))) Bblock PRINT_ERREUR("le centre 'relatif' de la boite de calcul de la densite doit etre {0,0}"); Eblock ATes Bblock Eblock ETes MdTb2(matrice_des_distances ,DIMENSION_DE_LA_BOITE_X ,DIMENSION_DE_LA_BOITE_Y ,Float ,ADRESSE_NON_ENCORE_DEFINIE ); /* Allocation de la matrice des distances. */ CALS(IFinitialisation(imageR,FZERO)); /* Initialisation a priori... */ SAUVEGARDE_DE_LA_SUPER_ECHELLE; SUPER_ECHELLE_PETIT_CARRE; /* De facon a ce que le referentiel soit norme... */ begin_imageQ(DoIn,Y_bas___,Y_haut__,PasY ,DoIn,X_gauche,X_droite,PasX ) Bblock DEFV(Float,INIT(exponentielle_de_la_distance_courante ,MUL2(facteurN ,EXEX(NEGA(MUL2(facteurD ,PUIX(LIO2(IFdensite_____ponderation_RdisF2D ,RdisF2D(SUPER_cNORMALISE_OX(X_centre) ,SUPER_cNORMALISE_OY(Y_centre) ,SUPER_cNORMALISE_OX(X) ,SUPER_cNORMALISE_OY(Y) ) ,IFdensite_____ponderation_ASdisF2D ,ASdisF2D(SUPER_cNORMALISE_OX(X_centre) ,SUPER_cNORMALISE_OY(Y_centre) ,SUPER_cNORMALISE_OX(X) ,SUPER_cNORMALISE_OY(Y) ) ,FZERO ) ,exposantD ) ) ) ) ) ) ); /* Exponentielle distance entre le point courant et le centre de la boite. */ /* */ /* On notera au passage que le calcul de la racine carree dans 'RdisF2D(...)' pourrait etre */ /* considere comme redondant avec le calcul de puissance 'PUIX(RdisF2D(...),exposantD)'. */ /* En fait, cela n'est vrai que si l'exposant 'exposantD' est egal a 2 (cas par defaut) ; */ /* n'oublions pas le le soucis de generalite... */ EGAL(ACCES_EXPONENTIELLE_PONDEREE_D_UNE_DISTANCE(X_centre,Y_centre,X,Y) ,exponentielle_de_la_distance_courante ); /* Initialisation de la matrice des distances. */ Test(IL_FAUT(renorm)) Bblock EGAL(minimum_des_exponentielles ,MIN2(exponentielle_de_la_distance_courante,minimum_des_exponentielles) ); EGAL(maximum_des_exponentielles ,MAX2(exponentielle_de_la_distance_courante,maximum_des_exponentielles) ); /* Extrema des exponentielles en vue de leur renormalisation... */ Eblock ATes Bblock Eblock ETes Test(IFOU(IFET(IFEQ(X,CHOI(X_gauche,X_droite)) ,IFEQ(Y,Y_centre) ) ,IFET(IFEQ(X,X_centre) ,IFEQ(Y,CHOI(Y_bas___,Y_haut__)) ) ) ) Bblock EGAL(exponentielle_du_rayon_du_cercle_inscrit ,OPC2(IL_FAUT(IFdensite_____compatibilite_2014010310) ,MAX2 ,MIN2 ,exponentielle_de_la_distance_courante ,exponentielle_du_rayon_du_cercle_inscrit ) ); /* L'exponentielle du rayon du cercle inscrit dans la boite est calculee pour les points */ /* extremes de la boite, c'est-a-dire les points situes sur les axes. */ /* */ /* ATTENTION : jusqu'au 20091124115242 il y avait ci-dessus 'MIN2(...)' par erreur car, en */ /* effet, il y a ci-apres un 'IFGE(...,exponentielle_du_rayon_du_cercle_inscrit)'... */ /* Mais le 20140103104022, je me suis rendu compte que ce n'etait pas une erreur ! */ /* */ /* On notera de plus que le rapport du nombre de points du carre a celui du cercle vaut : */ /* */ /* 2 */ /* 2 */ /* ---- ~ 1.27 */ /* pi */ /* */ /* */ Eblock ATes Bblock Eblock ETes Eblock end_imageQ(EDoI,EDoI) Test(IL_FAUT(renorm)) Bblock begin_imageQ(DoIn,Y_bas___,Y_haut__,PasY ,DoIn,X_gauche,X_droite,PasX ) Bblock RENORM_EXPONENTIELLES(ACCES_EXPONENTIELLE_PONDEREE_D_UNE_DISTANCE(X_centre,Y_centre,X,Y)); /* Renormalisation des exponentielles... */ /* */ /* Le 20110907171420, le 'NORM(...)' a ete remplace par un 'NORZ(...). */ Eblock end_imageQ(EDoI,EDoI) RENORM_EXPONENTIELLES(exponentielle_du_rayon_du_cercle_inscrit); /* Renormalisation du rayon du cercle inscrit dans la boite... */ /* */ /* Le 20110907171420, le 'NORM(...)' a ete remplace par un 'NORZ(...). */ Test(IFNE(minimum_des_exponentielles,maximum_des_exponentielles)); Bblock EGAL(minimum_des_exponentielles,COORDONNEE_BARYCENTRIQUE_MINIMALE); EGAL(maximum_des_exponentielles,COORDONNEE_BARYCENTRIQUE_MAXIMALE); /* Introduit le 20110907171331 pour preparer l'avenir... */ Eblock ATes Bblock EGAL(minimum_des_exponentielles,COORDONNEE_BARYCENTRIQUE_MAXIMALE); EGAL(maximum_des_exponentielles,COORDONNEE_BARYCENTRIQUE_MAXIMALE); Eblock ETes Eblock ATes Bblock Eblock ETes RESTAURATION_DE_LA_SUPER_ECHELLE; /* Restauration du referentiel a priori... */ begin_image Bblock DEFV(Int,INIT(centre_de_la_boite_X,X)); DEFV(Int,INIT(centre_de_la_boite_Y,Y)); /* Definition du centre de la boite courante. */ DEFV(Float,INIT(densite_courante,FZERO)); /* Definition de la densite dans la boite courante... */ begin_imageQ(DoIn ,COYA(SOUS(COYR(centre_de_la_boite_Y),demi_dimension_Y)) ,COYA(ADD2(COYR(centre_de_la_boite_Y),demi_dimension_Y)) ,PasY ,DoIn ,COXA(SOUS(COXR(centre_de_la_boite_X),demi_dimension_X)) ,COXA(ADD2(COXR(centre_de_la_boite_X),demi_dimension_X)) ,PasX ) Bblock DEFV(Float,INIT(exponentielle_de_la_distance_courante ,ACCES_EXPONENTIELLE_PONDEREE_D_UNE_DISTANCE(centre_de_la_boite_X,centre_de_la_boite_Y,X,Y) ) ); DEFV(Float,INIT(exponentielle_de_la_distance_courante_eventuellement_renormalisee,FLOT__UNDEF)); /* Exponentielle de la distance entre le point courant et le centre de la boite. */ EGAL(exponentielle_de_la_distance_courante_eventuellement_renormalisee,exponentielle_de_la_distance_courante); Test(IL_FAUT(IFdensite_____compatibilite_2014010308)) Bblock Eblock ATes Bblock Test(IL_FAUT(renorm)) Bblock RENORM_EXPONENTIELLES(exponentielle_de_la_distance_courante_eventuellement_renormalisee); /* Introduit le 20140103083835 car, en effet, cela manquait... */ Eblock ATes Bblock Eblock ETes Eblock ETes Test(IFGE(exponentielle_de_la_distance_courante_eventuellement_renormalisee,exponentielle_du_rayon_du_cercle_inscrit)) /* Seuls les points situes a l'interieur du cercle inscrit dans la boite courante vont etre */ /* etre traites. On notera au passage le test 'IFGE(...)' qui est inverse de celui que l'on */ /* ferait, a savoir 'IFLE(...)', si l'on testait directement les distances et non pas leurs */ /* exponentielles apres changement de signe... */ Bblock DEFV(Float,INIT(exponentielle_de_la_distance_courante_dans_le_cercle_inscrit ,exponentielle_de_la_distance_courante ) ); Test(IL_FAUT(IFdensite_____compatibilite_20110908)) Bblock Eblock ATes Bblock Test(IL_FAUT(IFdensite_____compatibilite_2014010308)) Bblock EGAL(exponentielle_de_la_distance_courante_dans_le_cercle_inscrit ,HOMZ(exponentielle_de_la_distance_courante ,exponentielle_du_rayon_du_cercle_inscrit ,maximum_des_exponentielles ,minimum_des_exponentielles ,maximum_des_exponentielles ,COORDONNEE_BARYCENTRIQUE_MAXIMALE ) ); Eblock ATes Bblock EGAL(exponentielle_de_la_distance_courante_dans_le_cercle_inscrit ,exponentielle_de_la_distance_courante_eventuellement_renormalisee ); /* En effet, le minimum n'est pas dans le cercle inscrit, mais a l'exterieur (et localise */ /* aux quatre coins du carre...). En fait, le minimum "effectif" est situe sur la */ /* circonference du cercle, d'ou cette renormalisation... */ Eblock ETes Eblock ETes INCR(densite_courante ,MUL2(COND(IL_FAUT(IFdensite_____version_simplifiee) ,loadF_point_valide(imageA,X,Y) ,FFload_point(imageA ,X,Y ,IFdensite_____periodiser_X,IFdensite_____periodiser_Y ,IFdensite_____symetriser_X,IFdensite_____symetriser_Y ,IFdensite_____prolonger_X,IFdensite_____prolonger_Y ,IFdensite_____niveau_hors_image ) ) ,exponentielle_de_la_distance_courante_dans_le_cercle_inscrit ) ); /* Calcul de la densite dans la boite courante... */ Eblock ATes Bblock Eblock ETes Eblock end_imageQ(EDoI,EDoI) storeF_point(densite_courante,imageR,X,Y); /* Memorisation de la densite au point {X,Y}... */ Eblock end_image FdTb2(matrice_des_distances,DIMENSION_DE_LA_BOITE_X,DIMENSION_DE_LA_BOITE_Y,Float,ADRESSE_NON_ENCORE_DEFINIE); /* Liberation de la matrice des distances. */ /* */ /* Le 'ADRESSE_NON_ENCORE_DEFINIE' a ete introduit le 20050221164113... */ RETIF(imageR); Eblock #undef RENORM_EXPONENTIELLES #undef ACCES_EXPONENTIELLE_PONDEREE_D_UNE_DISTANCE #undef DIMENSION_DE_LA_BOITE_Y #undef DIMENSION_DE_LA_BOITE_X EFonctionF _______________________________________________________________________________________________________________________________________