_______________________________________________________________________________________________________________________________________
/*************************************************************************************************************************************/
/* */
/* F O N C T I O N S D E B A S E E T S T A N D A R D S */
/* D ' E D I T I O N A L P H A - N U M E R I Q U E D E S I M A G E S : */
/* */
/* */
/* Definition : */
/* */
/* Ce fichier contient toutes les fonctions */
/* de base d'edition alpha-numerique standards */
/* des images raster, quelle que soit la definition. */
/* */
/* */
/* Author of '$xiida/fonction$FON' : */
/* */
/* Jean-Francois Colonna (LACTAMME, 19880000000000). */
/* */
/*************************************************************************************************************************************/
/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/* */
/* D E F I N I T I O N S D E S V E R S I O N S : */
/* */
/*************************************************************************************************************************************/
#ifdef LISTE_IMAGE_ALPHA_NUMERIQUE_VERSION_01 /* Common,DEFV(Fonction,) : avec 'VERSION_01'. */
DEFV(Common,DEFV(Logical,_____LISTE_IMAGE_ALPHA_NUMERIQUE_VERSION_01));
#Aifdef LISTE_IMAGE_ALPHA_NUMERIQUE_VERSION_01 /* Common,DEFV(Fonction,) : avec 'VERSION_01'. */
#Eifdef LISTE_IMAGE_ALPHA_NUMERIQUE_VERSION_01 /* Common,DEFV(Fonction,) : avec 'VERSION_01'. */
#ifdef LISTE_IMAGE_ALPHA_NUMERIQUE_VERSION_02 /* Common,DEFV(Fonction,) : avec 'VERSION_02'. */
DEFV(Common,DEFV(Logical,_____LISTE_IMAGE_ALPHA_NUMERIQUE_VERSION_02));
#Aifdef LISTE_IMAGE_ALPHA_NUMERIQUE_VERSION_02 /* Common,DEFV(Fonction,) : avec 'VERSION_02'. */
#Eifdef LISTE_IMAGE_ALPHA_NUMERIQUE_VERSION_02 /* Common,DEFV(Fonction,) : avec 'VERSION_02'. */
#ifdef LISTE_IMAGE_ALPHA_NUMERIQUE_VERSION_03 /* Common,DEFV(Fonction,) : avec 'VERSION_03'. */
DEFV(Common,DEFV(Logical,_____LISTE_IMAGE_ALPHA_NUMERIQUE_VERSION_03));
#Aifdef LISTE_IMAGE_ALPHA_NUMERIQUE_VERSION_03 /* Common,DEFV(Fonction,) : avec 'VERSION_03'. */
#Eifdef LISTE_IMAGE_ALPHA_NUMERIQUE_VERSION_03 /* Common,DEFV(Fonction,) : avec 'VERSION_03'. */
/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/* */
/* D U M P C A R A C T E R E D ' U N E I M A G E : */
/* */
/*************************************************************************************************************************************/
BFonctionI
DEFV(Common,DEFV(Logical,SINT(Idumpc_image_____editer_le_message_d_introduction,FAUX)));
DEFV(Common,DEFV(FonctionI,Idumpc_image(imageA)))
/* Fonction introduite le 20081216113445... */
DEFV(Argument,DEFV(image,imageA));
/* Image argument a dumper en format caractere... */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
Bblock
INIT_ERROR;
/*..............................................................................................................................*/
Test(IL_FAUT(Idumpc_image_____editer_le_message_d_introduction))
Bblock
CAL2(Prin0("Dump d'une IMAGE :\n\n"));
Eblock
ATes
Bblock
Eblock
ETes
begin_colonne_back
Bblock
begin_ligne
Bblock
CAL2(Prin1("%c",load_point(imageA,X,Y)));
Eblock
end_ligne
CAL2(Prin0("\n"));
/* Changement de ligne. */
Eblock
end_colonne_back
RETU_ERROR;
Eblock
EFonctionI
/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/* */
/* D U M P D E C I M A L D ' U N E I M A G E : */
/* */
/*************************************************************************************************************************************/
BFonctionI
DEFV(Common,DEFV(Logical,SINT(Idumpd_image_____editer_le_message_d_introduction,FAUX)));
/* Cet indicateur est passe de 'VRAI' a 'FAUX' le 20070620110936 car, en effet, ce message */
/* n'est pas d'une tres grande utilite... */
DEFV(Common,DEFV(FonctionI,Idumpd_image(imageA)))
/* Fonction introduite le 20070620102510... */
DEFV(Argument,DEFV(image,imageA));
/* Image argument a dumper en format decimal. */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
Bblock
INIT_ERROR;
/*..............................................................................................................................*/
Test(IL_FAUT(Idumpd_image_____editer_le_message_d_introduction))
Bblock
CAL2(Prin0("Dump decimal d'une IMAGE :\n\n"));
Eblock
ATes
Bblock
Eblock
ETes
begin_colonne_back
Bblock
begin_ligne
Bblock
CAL2(Prin2(" %*d",NOMBRE_DE_CHIFFRES_DECIMAUX(MAX2(NOIR,BLANC)),load_point(imageA,X,Y)));
Eblock
end_ligne
CAL2(Prin0("\n"));
/* Changement de ligne. */
Eblock
end_colonne_back
RETU_ERROR;
Eblock
EFonctionI
_______________________________________________________________________________________________________________________________________
_______________________________________________________________________________________________________________________________________
/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/* */
/* D U M P H E X A - D E C I M A L D ' U N E I M A G E : */
/* */
/*************************************************************************************************************************************/
#define LONGUEUR_D_UN_POINT_CONVERTI_EN_HEXA_DECIMAL \
DIVI(Bsize_p,NBITHX) \
/* Longueur d'un point d'une composante lorsqu'il est converti en hexa-decimal... */
#define FORMAT_HEXA_DECIMAL_SANS_ESPACE \
EGAs(chain_Aconcaten4(C_POUR_CENT \
,C_0 \
,EGAs(chain_numero(LONGUEUR_D_UN_POINT_CONVERTI_EN_HEXA_DECIMAL \
,SOUS(SIZC(C_0),SIZC(C_VIDE)) \
) \
) \
,C_HEXA_DECIMAL \
) \
) \
/* Format de dump d'un point en hexa-decimal sans un espace de separation. */
BFonctionI
DEFV(Common,DEFV(Logical,SINT(Idumpx_image_____editer_sous_la_forme_niveau_coordonnees_X_et_Y,FAUX)));
DEFV(Common,DEFV(Logical,SINT(Idumpx_image_____editer_sous_la_forme_niveau_coordonnees_X_et_Y_somme_difference,FAUX)));
DEFV(Common,DEFV(Logical,SINT(Idumpx_image_____former_une_combinaison_lineaire_des_coordonnees_X_et_Y,FAUX)));
DEFV(Common,DEFV(Logical,SINT(Idumpx_image_____mettre_des_zeros_devant_les_coordonnees_X_et_Y,VRAI)));
DEFV(Common,DEFV(Logical,SINT(Idumpx_image_____les_valeurs_sont_signees,VRAI)));
/* Indicateurs introduits le 20151210102603 et completes le 20151213103311, puis le */
/* 20151215094501... */
/* */
/* Voir la commande 'v $xrv/anti_dumpx$K' qui permet a priori de reconstituer l'image */
/* decrite par les listes niveau/index ainsi generees... */
DEFV(Common,DEFV(CHAR,SINS(DTb0(Idumpx_image_____separateur__niveau_index)
,Ichaine01(K_POINT)
)
)
);
/* Introduit le 20151211150301 afin de pouvoir parametrer le seprateur entre un niveau */
/* et l'index. Je n'ai, malheureusement, pas trouve de solution plus simple pour convertir */
/* 'K_POINT' en une chaine de caracteres tout en permettant son entree en parametre de */
/* 'v $xci/dumpx$K Idumpx_image_____separateur__niveau_index'... */
DEFV(Common,DEFV(Logical,SINT(Idumpx_image_____editer_le_message_d_introduction,FAUX)));
/* Indicateur introduit le 20070620102510... */
/* */
/* Cet indicateur est passe de 'VRAI' a 'FAUX' le 20070620110936 car, en effet, ce message */
/* n'est pas d'une tres grande utilite... */
#define NOMBRE_DE_ZEROS(dimension) \
COND(IL_FAUT(Idumpx_image_____mettre_des_zeros_devant_les_coordonnees_X_et_Y) \
,NOMBRE_DE_CHIFFRES_DECIMAUX(dimension) \
,ZERO \
)
#define NOMBRE_DE_ZEROS_NON_SIGNES(dimension) \
NOMBRE_DE_ZEROS(dimension)
#define NOMBRE_DE_ZEROS_____SIGNES(dimension) \
ADD2(NOMBRE_DE_ZEROS(dimension) \
,COND(EST_VRAI(Idumpx_image_____les_valeurs_sont_signees) \
,UN \
,ZERO \
) \
)
/* Afin de mettre ou pas des '0's devant un nombre (introduit le 20151213103311). On notera */
/* que la presence de '0's devant un nombre permet de garantir que lors d'un tri les ordres */
/* numeriques et lexicographiques sont les memes... */
#define SIGNE_EVENTUEL \
COND(IL_FAUT(Idumpx_image_____les_valeurs_sont_signees) \
,C_PLUS \
,C_VIDE \
) \
/* Afin de signer ou pas les valeurs numeriques (introduit le 20151215101212). */
#define FORMAT_HEXA_DECIMAL_AVEC_ESPACE \
EGAs(chain_Aconcaten2(C_BLANC \
,FORMAT_HEXA_DECIMAL_SANS_ESPACE \
) \
) \
/* Format de dump d'un point en hexa-decimal avec un espace de separation. */
DEFV(Common,DEFV(FonctionI,Idumpx_image(imageA)))
DEFV(Argument,DEFV(image,imageA));
/* Image argument a dumper en format hexa-decimal. */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
Bblock
INIT_ERROR;
/*..............................................................................................................................*/
Test(IL_FAUT(Idumpx_image_____editer_sous_la_forme_niveau_coordonnees_X_et_Y))
/* Possibilite introduite le 20151210102603... */
Bblock
DEFV(Int,INIT(index_des_points,INDEX0));
/* Cet index est defini meme s'il est inutile et ce afin de simplifier... */
begin_image
Bblock
Test(IL_FAUT(Idumpx_image_____former_une_combinaison_lineaire_des_coordonnees_X_et_Y))
/* Test introduit le 20151213103311... */
Bblock
DEFV(Int,INIT(validation_index_des_points,ADD2(AXPB(COYR(Y),dimX,COXR(X)),INDEX0)));
CAL2(Prin4("%d%s%0*d\n"
,load_point(imageA,X,Y)
,Idumpx_image_____separateur__niveau_index
,NOMBRE_DE_ZEROS_NON_SIGNES(dimXY)
,index_des_points
)
);
/* L'edition se fait donc sous la forme d'un nombre 'Float' dont la partie entiere est le */
/* niveau (en decimal) et la partie decimale l'index (en decimal avec un nombre de chiffres */
/* constant). */
Test(IFNE(index_des_points,validation_index_des_points))
Bblock
PRINT_ERREUR("l'index des points est incorrect");
CAL1(Prer4("(IndexIncremental=%d IndexCalcule=%d X=%d Y=%d)\n"
,index_des_points
,validation_index_des_points
,X,Y
)
);
/* On notera que l'index est du type : */
/* */
/* index = Y.dimY + X */
/* */
/* Voir a ce propos 'v $xrv/anti_dumpx$K validation_index_des_points'. */
Eblock
ATes
Bblock
Eblock
ETes
INCR(index_des_points,I);
Eblock
ATes
Bblock
Test(IL_FAUT(Idumpx_image_____editer_sous_la_forme_niveau_coordonnees_X_et_Y_somme_difference))
/* Possibilite introduite le 20151215094501... */
Bblock
DEFV(CHAR,INIC(POINTERc(format_EGAq_1____Idumpx_image)
,chain_Aconcaten9(C_POUR_CENT,SIGNE_EVENTUEL,"0*d "
,C_POUR_CENT,SIGNE_EVENTUEL,"0*d "
,C_POUR_CENT,SIGNE_EVENTUEL,"0*d\n"
)
)
);
CAL2(Prin6(format_EGAq_1____Idumpx_image
,NOMBRE_DE_ZEROS_____SIGNES(COULEURS),load_point(imageA,X,Y)
,NOMBRE_DE_ZEROS_____SIGNES(ADD2(dimX,dimY)),ADD2(X,Y)
,NOMBRE_DE_ZEROS_____SIGNES(ADD2(dimX,dimY)),SOUS(X,Y)
)
);
/* L'edition se fait alors sous la forme d'un triplet {niveau,X+Y,X-Y} (ceci a ete introduit */
/* le 20151215094501). */
CALZ_FreCC(format_EGAq_1____Idumpx_image);
Eblock
ATes
Bblock
DEFV(CHAR,INIC(POINTERc(format_EGAq_2____Idumpx_image)
,chain_Aconcaten9(C_POUR_CENT,SIGNE_EVENTUEL,"0*d "
,C_POUR_CENT,SIGNE_EVENTUEL,"0*d "
,C_POUR_CENT,SIGNE_EVENTUEL,"0*d\n"
)
)
);
CAL2(Prin6(format_EGAq_2____Idumpx_image
,NOMBRE_DE_ZEROS_____SIGNES(COULEURS),load_point(imageA,X,Y)
,NOMBRE_DE_ZEROS_____SIGNES(dimX),X
,NOMBRE_DE_ZEROS_____SIGNES(dimY),Y
)
);
/* L'edition se fait alors sous la forme d'un triplet {niveau,X,Y} (ceci a ete introduit */
/* le 20151213103311). */
CALZ_FreCC(format_EGAq_2____Idumpx_image);
Eblock
ETes
Eblock
ETes
Eblock
end_image
Eblock
ATes
Bblock
Test(IL_FAUT(Idumpx_image_____editer_le_message_d_introduction))
Bblock
CAL2(Prin0("Dump hexa-decimal d'une IMAGE :\n\n"));
Eblock
ATes
Bblock
Eblock
ETes
begin_colonne_back
Bblock
begin_ligne
Bblock
CAL2(Prin1(Cara(FORMAT_HEXA_DECIMAL_AVEC_ESPACE),load_point(imageA,X,Y)));
Eblock
end_ligne
CAL2(Prin0("\n"));
/* Changement de ligne. */
Eblock
end_colonne_back
Eblock
ETes
RETU_ERROR;
Eblock
#undef FORMAT_HEXA_DECIMAL_AVEC_ESPACE
#undef SIGNE_EVENTUEL
#undef NOMBRE_DE_ZEROS_____SIGNES
#undef NOMBRE_DE_ZEROS_NON_SIGNES
#undef NOMBRE_DE_ZEROS
EFonctionI
_______________________________________________________________________________________________________________________________________
_______________________________________________________________________________________________________________________________________
/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/* */
/* D U M P P o s t S c r i p t D ' U N E I M A G E : */
/* */
/* */
/* Format a donner a ce fichier pour qu'il y ait affichage sur 'SYSTEME_SG4D..._IRIX' : */
/* */
/* #!/usr/NeWS/bin/psh */
/* /win framebuffer /new DefaultWindow send def */
/* % creation de la fenetre. % */
/* { */
/* /PaintClient */
/* { */
/* dx dy translate */
/* ex ey scale */
/* % definition de la position et de l'echelle de l'image dans la fenetre. % */
/* dimX dimY Bsize_p [dimX 0 0 dimY 0 0] {< ... >} image */
/* % recuperation de l'image. % */
/* showpage */
/* % "impression" de cette image dans la fenetre courante. % */
/* } def */
/* } win send */
/* x y dimX dimY /reshape win send */
/* % dimensionnement de la fenetre. % */
/* /map win send */
/* % affichage (ou "mapping") de la fenetre. % */
/* */
/* */
/* Pre-visualisation d'un fichier PostScript sur un ecran : */
/* */
/* /users/com/ghostview sur 'SYSTEME_HP7??_HPUX', */
/* /usr/sbin/xpsview sur 'SYSTEME_SGIND???_IRIX'. */
/* */
/* */
/*************************************************************************************************************************************/
DEFV(Common,DEFV(Positive,ZINT(IPostScript_image_____version_du_PostScript,PostScript_Version_2)));
/* Version du 'PostScript' a generer (introduit le 20031129111708 avec une compatibilite */
/* des generations anterieures a cette date). */
DEFV(Common,DEFV(Logical,ZINT(IPostScript_image_____inserer_la_BoundingBox_dans_le_fichier,FAUX)));
/* Cet indicateur a ete introduit le 20090130125910 car il semblerait que ce soit la */
/* presence de '%%BoundingBox: ' qui cree les difficultes rencontrees : l'image generee */
/* ensuite a parir du fichier 'PostScrip' etant en general "noyee" dans une grande page */
/* (a titre d'exemple l'image 'v $xiirc/$Fnota xiirc.ZETA.31.m' de dimensions 6000x6000 */
/* etait dans une page 25000x25000 soit 2 metres par 2 metres !). */
DEFV(Common,DEFV(Logical,ZINT(IPostScript_image_____inserer_le_PageSize_dans_le_fichier,FAUX)));
/* Cet indicateur a ete introduit le 20090130131857 pour "completer" ce qui precede et est */
/* relatif a la "BoundingBox"... */
DEFV(Common,DEFV(Logical,ZINT(IPostScript_image_____conserver_les_echelles_horizontale_et_verticale,FAUX)));
/* Cet indicateur a ete introduit le 20030601130006 dans le but de permettre l'utilisation */
/* de fichiers '$PostScript' pour generer des fichiers de type '$MPEG'. La valeur par defaut */
/* permet d'assurer la compatibilite anterieure... */
#define LE_SERVEUR_PostScript_EST_RECONNU \
OUI18(LE_SERVEUR_PostScript_EST_CELUI_DE("CMAP23") \
,LE_SERVEUR_PostScript_EST_CELUI_DE("CMAP24") \
,LE_SERVEUR_PostScript_EST_CELUI_DE("CMAP26") \
,LE_SERVEUR_PostScript_EST_CELUI_DE("CMAP28") \
,LE_SERVEUR_PostScript_EST_CELUI_DE("LACT12") \
,LE_SERVEUR_PostScript_EST_CELUI_DE("LACT14") \
,LE_SERVEUR_PostScript_EST_CELUI_DE("LACT15") \
,LE_SERVEUR_PostScript_EST_CELUI_DE("LACT16") \
,LE_SERVEUR_PostScript_EST_CELUI_DE("LACT17") \
,LE_SERVEUR_PostScript_EST_CELUI_DE("LACT18") \
,LE_SERVEUR_PostScript_EST_CELUI_DE("LACT19") \
,LE_SERVEUR_PostScript_EST_CELUI_DE("LACT1A") \
,LE_SERVEUR_PostScript_EST_CELUI_DE("LACT1B") \
,LE_SERVEUR_PostScript_EST_CELUI_DE("LACT71") \
,LE_SERVEUR_PostScript_EST_CELUI_DE("LACT27") \
,LE_SERVEUR_PostScript_EST_CELUI_DE("LACT28") \
,LE_SERVEUR_PostScript_EST_CELUI_DE("LACT29") \
,TOUJOURS_FAUX \
) \
/* Liste des serveurs 'PostScript' reconnus (introduite le 20030219092354). */ \
/* */ \
/* '$LACT14' et '$LACT15' ont ete introduites le 20030217123637. */ \
/* */ \
/* '$LACT16' a ete introduite le 20031020162009. */ \
/* */ \
/* '$LACT1A' a ete introduite le 20160909133333. */ \
/* */ \
/* '$LACT1B' a ete introduite le 20210701140705. */
#define LONGUEUR_D_UNE_LIGNE_HEXA_DECIMALE_PostScript(nombre_d_elements) \
ADD2(ADD2(MUL2(nombre_d_elements,LONGUEUR_D_UN_POINT_CONVERTI_EN_HEXA_DECIMAL) \
,MUL2(QUOE(nombre_d_elements,NOMBRE_DE_VALEURS_PAR_LIGNE),SIZC(C_VIDE)) \
) \
,SIZC(C_VIDE) \
) \
/* Longueur d'une ligne de composante lorsqu'elle est convertie en hexa-decimal PostScript. */ \
/* La serie de 'SIZC(C_VIDE)' correspond a l'ensemble des caracteres 'K_LF' qui terminent */ \
/* chaque ligne physique, alors que le dernier 'SIZC(C_VIDE)' correspond au caractere */ \
/* 'K_NULL' qui termine la ligne logique 'ligne_PostScript_courante'. Enfin, on utilise */ \
/* un quotient par exces 'QUOE(...)' car en effet, le nombre d'elements par ligne physique */ \
/* 'NOMBRE_DE_VALEURS_PAR_LIGNE' ne divise pas en general la dimension horizontale 'dimX' */ \
/* des images... */
#define PostScript_rangement_d_un_caractere_hexa_decimal(caractere_hexa_decimal,index_relatif_du_caractere_courant) \
Bblock \
EGAL(ITb1(ligne_PostScript_courante \
,ADD2(index_courant_de_la_ligne_PostScript_courante \
,index_relatif_du_caractere_courant \
) \
) \
,caractere_hexa_decimal \
); \
Eblock \
/* Generation d'un caractere hexa-decimal dans la ligne courante... */
#define PostScript_valeur_hexa_decimale(valeur_hexa_decimale,caractere_hexa_decimal) \
Bblock \
Ca1e(valeur_hexa_decimale) \
Bblock \
PostScript_rangement_d_un_caractere_hexa_decimal(caractere_hexa_decimal \
,index_courant_de_la_valeur_courante \
); \
Eblock \
ECa1 \
Eblock \
/* Test d'une valeur, et generation eventuel d'un caractere hexa-decimal... */
#define PostScript_ligne(composante) \
Bblock \
DEFV(Int,INIT(nombre_de_valeurs_par_ligne,NOMBRE_DE_VALEURS_PAR_LIGNE)); \
/* Nombre de points (exprimes en hexa-decimal) a editer par ligne. On notera que cette */ \
/* variable est locale afin d'etre reinitialisee a 'NOMBRE_DE_VALEURS_PAR_LIGNE' pour */ \
/* chaque ligne d'une composante d'une image en couleurs... */ \
Test(IL_FAUT(optimiser_la_conversion_PostScript)) \
Bblock \
DEFV(CHAR,DdTb1(POINTERc \
,ligne_PostScript_courante \
,LONGUEUR_D_UNE_LIGNE_HEXA_DECIMALE_PostScript(dimX) \
,kMalo(LONGUEUR_D_UNE_LIGNE_HEXA_DECIMALE_PostScript(dimX)) \
) \
); \
/* Ligne courante convertie en une chaine hexa-decimale (introduit sous la forme dynamique */ \
/* -'dimX' remplacant 'KK___dimX'- le 20050503142726). */ \
DEFV(Int,INIT(index_courant_de_la_ligne_PostScript_courante,PREMIER_CARACTERE)); \
/* Index courant de conversion dans la ligne courante... */ \
\
begin_ligne \
Bblock \
/* ATTENTION, la solution suivante a ete essayee : */ \
/* */ \
/* #define LONGUEUR_D_UNE_LIGNE_HEXA_DECIMALE_PostScript(nombre_d_elements) \ */ \
/* ADD2(MUL2(nombre_d_elements \ */ \
/* ,LONGUEUR_D_UN_POINT_CONVERTI_EN_HEXA_DECIMAL \ */ \
/* ) \ */ \
/* ,SIZC(C_VIDE) \ */ \
/* ) */ \
/* */ \
/* CALS(SPrin1(ADRESSE(ITb1(ligne_PostScript_courante \ */ \
/* ,index_courant_de_la_ligne_PostScript_courante \ */ \
/* ) \ */ \
/* ) \ */ \
/* ,Cara(FORMAT_HEXA_DECIMAL_SANS_ESPACE) \ */ \
/* ,load_point(composante,X,Y) \ */ \
/* ) \ */ \
/* ); \ */ \
/* */ \
/* mais, malheureusement, elle n'allait pas plus vite (voire moins vite...) que la methode */ \
/* non optimisee ; a titre d'exemple, en mode 'Sud' la generation du fichier PostScript */ \
/* prenait 169 secondes avec la fonction 'SPrin1(...)', et ne prend plus que 1.3 seconde */ \
/* avec cette nouvelle methode "manuelle"... */ \
DEFV(genere_p,INIT(valeur_courante,load_point(composante,X,Y))); \
/* Valeur courante a convertir en hexa-decimal... */ \
DEFV(Int,INIT(index_courant_de_la_valeur_courante \
,LSTX(PREMIER_CARACTERE,LONGUEUR_D_UN_POINT_CONVERTI_EN_HEXA_DECIMAL) \
) \
); \
/* Index courant de conversion de la valeur courante... */ \
\
Repe(LONGUEUR_D_UN_POINT_CONVERTI_EN_HEXA_DECIMAL) \
Bblock \
DEFV(genere_p,INIT(reste_de_la_valeur_courante,REST(valeur_courante,BASE16))); \
/* Chiffre hexa-decimal courant exprime en binaire. */ \
\
Choi(reste_de_la_valeur_courante) \
Bblock \
\
/* Nota : cette facon de faire pour assurer la conversion des chiffres hexa-decimaux en */ \
/* caracteres pourrait etre consideree par certains comme extremement lourde et maladroite, */ \
/* mais en fait, il n'en est rien, car en effet, le but est ici d'etre completement */ \
/* independant des codes des caracteres... */ \
\
PostScript_valeur_hexa_decimale(ZERO,K_0) \
PostScript_valeur_hexa_decimale(UN,K_1) \
PostScript_valeur_hexa_decimale(DEUX,K_2) \
PostScript_valeur_hexa_decimale(TROIS,K_3) \
PostScript_valeur_hexa_decimale(QUATRE,K_4) \
PostScript_valeur_hexa_decimale(CINQ,K_5) \
PostScript_valeur_hexa_decimale(SIX,K_6) \
PostScript_valeur_hexa_decimale(SEPT,K_7) \
PostScript_valeur_hexa_decimale(HUIT,K_8) \
PostScript_valeur_hexa_decimale(NEUF,K_9) \
PostScript_valeur_hexa_decimale(DIX,K_A) \
PostScript_valeur_hexa_decimale(ONZE,K_B) \
PostScript_valeur_hexa_decimale(DOUZE,K_C) \
PostScript_valeur_hexa_decimale(TREIZE,K_D) \
PostScript_valeur_hexa_decimale(QUATORZE,K_E) \
PostScript_valeur_hexa_decimale(QUINZE,K_F) \
Defo \
Bblock \
PRINT_ERREUR("une valeur non hexa-decimale a ete rencontree"); \
Eblock \
EDef \
Eblock \
ECho \
\
EGAL(valeur_courante,DIVI(valeur_courante,BASE16)); \
/* Valeur courante a convertir en hexa-decimal. On notera que l'on utilise une methode tres */ \
/* bestiale, mais qui a l'avantage de la generalite (elle est en effet independante de la */ \
/* valeur de la base, ne traviallant pas a l'aide de decalage... */ \
DECR(index_courant_de_la_valeur_courante,I); \
/* Et progression de l'index courant de rangement (qui a lieu a l'envers, rappelons-le...). */ \
Eblock \
ERep \
\
INCR(index_courant_de_la_ligne_PostScript_courante,LONGUEUR_D_UN_POINT_CONVERTI_EN_HEXA_DECIMAL); \
/* Et progression de l'index courant de rangement... */ \
\
DECR(nombre_de_valeurs_par_ligne,I); \
/* Decomptage des points a ecrire sur la ligne courante. */ \
Test(IZEQ(nombre_de_valeurs_par_ligne)) \
Bblock \
PostScript_rangement_d_un_caractere_hexa_decimal(K_LF,PREMIER_CARACTERE); \
/* Lorsqu'il y a suffisamment de points, on passe a la ligne suivante... */ \
INCR(index_courant_de_la_ligne_PostScript_courante,I); \
/* Et progression de l'index courant de rangement... */ \
EGAL(nombre_de_valeurs_par_ligne,NOMBRE_DE_VALEURS_PAR_LIGNE); \
/* Puis on reinitialise le processus... */ \
Eblock \
ATes \
Bblock \
Eblock \
ETes \
Eblock \
end_ligne \
\
Test(IFGT(index_courant_de_la_ligne_PostScript_courante \
,SUCC(LSTX(PREMIER_CARACTERE,LONGUEUR_D_UNE_LIGNE_HEXA_DECIMALE_PostScript(dimX))) \
) \
) \
Bblock \
PRINT_ERREUR("probleme de conversion hexa-decimale d'une ligne PostScript"); \
Eblock \
ATes \
Bblock \
Eblock \
ETes \
\
PostScript_rangement_d_un_caractere_hexa_decimal(K_NULL,PREMIER_CARACTERE); \
/* Et on "ferme" la ligne courante... */ \
CALS(fastPrin1("%s",ligne_PostScript_courante)); \
/* Et enfin, envoi de la ligne courante... */ \
\
FdTb1(ligne_PostScript_courante \
,LONGUEUR_D_UNE_LIGNE_HEXA_DECIMALE_PostScript(dimX) \
,CHAR \
,ADRESSE_PLUS_DEFINIE \
); \
/* Ligne courante convertie en une chaine hexa-decimale (introduit sous la forme dynamique */ \
/* -'dimX' remplacant 'KK___dimX'- le 20050503142726). */ \
Eblock \
ATes \
Bblock \
begin_ligne \
Bblock \
CALS(fastPrin1(Cara(FORMAT_HEXA_DECIMAL_SANS_ESPACE),load_point(composante,X,Y))); \
/* Envoi des points hexa-decimaux un a un... */ \
\
DECR(nombre_de_valeurs_par_ligne,I); \
/* Decomptage des points a ecrire sur la ligne courante. */ \
Test(IZEQ(nombre_de_valeurs_par_ligne)) \
Bblock \
CALS(fastPrin0("\n")); \
/* Lorsqu'il y a suffisamment de points, on passe a la ligne suivante... */ \
EGAL(nombre_de_valeurs_par_ligne,NOMBRE_DE_VALEURS_PAR_LIGNE); \
/* Puis on reinitialise le processus... */ \
Eblock \
ATes \
Bblock \
nCALS(fastPrin0(" ")); \
/* Dans le cas contraire, on met un espace de separation avec 'CALS(...)' ou pas, et ce afin */ \
/* d'optimiser les espaces disques, les temps de transmission et de traitement, lorsqu'on */ \
/* utilise 'nCALS(...)'... */ \
Eblock \
ETes \
Eblock \
end_ligne \
Eblock \
ETes \
\
Test(IFNE(nombre_de_valeurs_par_ligne,NOMBRE_DE_VALEURS_PAR_LIGNE)) \
Bblock \
CALS(fastPrin0("\n")); \
/* Lorsqu'il y a une ligne incomplete en cours, on la ferme... */ \
Eblock \
ATes \
Bblock \
Eblock \
ETes \
Eblock \
/* Squelette general d'edition d'une ligne d'une composante. */
#define PostScript_composante(edition_d_une_ligne) \
Bblock \
begin_colonne \
Bblock \
BLOC(edition_d_une_ligne); \
/* Edition d'une ligne de l'image... */ \
Eblock \
end_colonne \
Eblock \
/* Squelette general d'edition d'une composante d'une image, ce qui signifie soit l'image */ \
/* elle-meme en Noir et Blanc, soit l'une de ses composantes chromatiques en couleurs. */
#define PostScript_image(definition_des_chaines,edition_de_l_en_tete,editions_des_points,edition_du_pied) \
Bblock \
Test(IFOU(LE_SERVEUR_PostScript_EST_CELUI_DE("LACT21") \
,TOUJOURS_FAUX \
) \
) \
Bblock \
CALS(fastPrin0("#!/usr/NeWS/bin/psh")); \
CALS(fastPrin0("\n/win framebuffer /new DefaultWindow send def")); \
CALS(fastPrin0("\n {")); \
CALS(fastPrin0("\n /PaintClient")); \
CALS(fastPrin0("\n {")); \
CALS(fastPrin2("\n %04d %04d translate",translation_horizontale,translation_verticale)); \
CALS(fastPrin2("\n %04d %04d scale",echelle_horizontale,echelle_verticale)); \
CALS(fastPrin1("\n %04d rotate",ZERO)); \
/* Generation de l'en-tete du programme. ATTENTION : rappelons que cette en-tete n'a de sens */ \
/* que sur les systemes du type 'SYSTEME_SG4D..._IRIX' parce qu'elle reference explicitement */ \
/* le programme '/usr/NeWS/bin/psh'. Enfin, on ecrit : */ \
/* */ \
/* CALS(fastPrin0("#!/usr/NeWS/bin/psh")); */ \
/* */ \
/* et non pas : */ \
/* */ \
/* CALS(fastPrin0("\n#!/usr/NeWS/bin/psh")); */ \
/* */ \
/* car cette ligne est la premiere du fichier... */ \
CALS(fastPrin0("\n")); \
/* Ceci est du au traitement particulier de la ligne suivante du fichier qui ne commence */ \
/* pas par un "\n..." (voir son commentaire). */ \
Eblock \
ATes \
Bblock \
Eblock \
ETes \
\
Test(LE_SERVEUR_PostScript_EST_RECONNU) \
Bblock \
CALS(fastPrin1("%%!PS-Adobe-%d.0" \
,IPostScript_image_____version_du_PostScript \
) \
); \
\
Test(IL_FAUT(IPostScript_image_____inserer_la_BoundingBox_dans_le_fichier)) \
/* Test introduit le 20090130125910... */ \
Bblock \
CALS(fastPrin4("\n%%%%BoundingBox: %d %d %d %d" \
,translation_horizontale \
,translation_verticale \
,ADD2(translation_horizontale,MUL2(echelle_horizontale,PasX)) \
,ADD2(translation_verticale,MUL2(echelle_verticale,PasY)) \
) \
); \
Eblock \
ATes \
Bblock \
Eblock \
ETes \
\
CALS(fastPrin0("\n%%%%BeginSetUp")); \
\
Test(IL_FAUT(IPostScript_image_____inserer_le_PageSize_dans_le_fichier)) \
/* Test introduit le 20090130131857... */ \
Bblock \
CALS(fastPrin1("\n%%%%IncludeFeature: %s","*PageSize A4")); \
Eblock \
ATes \
Bblock \
Eblock \
ETes \
\
CALS(fastPrin0("\n%%%%EndSetUp")); \
\
CALS(fastPrin0("\n%%%%Pages: 1")); \
CALS(fastPrin2("\n%%%%Title: . Dimensions: %d x %d (columns x rows)",dimX,dimY)); \
CALS(fastPrin0("\n%%%%Creator: John F. Colonna")); \
CALS(fastPrin0("\n%%%%EndComments")); \
CALS(fastPrin0("\n%%%%Page: 1 1")); \
/* Generation de l'en-tete du programme. On notera que l'on ecrit : */ \
/* */ \
/* CALS(fastPrin0("%%!PS-Adobe-2.0")); */ \
/* */ \
/* et non pas : */ \
/* */ \
/* CALS(fastPrin0("\n%%!PS-Adobe-2.0")); */ \
/* */ \
/* car cette ligne est la premiere du fichier. On notera de plus que pendant un temps j'ai */ \
/* utilise (a cause de 'SYSTEME_HP7??_HPUX') : */ \
/* */ \
/* CALS(fastPrin0("%%!PS-Adobe-2.0 EPSF-2.0")); */ \
/* */ \
/* mais qu'a cause de 'SYSTEME_SGIND???_IRIX' j'ai du enlever le " EPSF-2.0"... */ \
/* */ \
/* On notera l'utilisation de "%s" pour genererer "*PageSize A4" car, en effet, on ne peut */ \
/* ecrire directement : */ \
/* */ \
/* CALS(fastPrin0("\n%%%%IncludeFeature: *PageSize A4")); */ \
/* */ \
/* a cause des processus d'optimisation de '$xcc/cpp$Z'... */ \
\
BLOC(definition_des_chaines); \
/* Generation des differentes chaines (1 ou 3) necessaires au traitement. */ \
\
CALS(fastPrin0("\n/setundercolorremoval where {pop {pop 0} setundercolorremoval} {} ifelse")); \
CALS(fastPrin0("\n/setblackoverprint where {pop true setblackoverprint} {} ifelse")); \
/* Gestion eventuel d'un "beau" niveau de noir. Dans les deux cas, on teste la pre-existence */ \
/* de l'operateur correspondant. L'operateur 'where' renvoie les informations suivantes : */ \
/* */ \
/* /OPERATEUR where --> DICTIONNAIRE TRUE si 'OPERATEUR' existe dans le */ \
/* | dictionnaire 'DICTIONNAIRE' */ \
/* | (d'ou le premier 'pop' destine */ \
/* | a depiler 'DICTIONNAIRE'), */ \
/* | */ \
/* --> FALSE si 'OPERATEUR' n'existe pas. */ \
/* */ \
/* d'autre part, 'ifelse' fonctionne de la facon suivante : */ \
/* */ \
/* BOOLEEN PROCEDURE_SI_TRUE PROCEDURE_SI_FALSE ifelse */ \
/* */ \
/* 'ifelse' depile les trois entrees 'BOOLEEN', 'PROCEDURE_SI_TRUE' et 'PROCEDURE_SI_FALSE' */ \
/* puis execute 'PROCEDURE_SI_TRUE' ou 'PROCEDURE_SI_FALSE' suivant que 'BOOLEEN' est 'TRUE' */ \
/* ou 'FALSE'... */ \
/* */ \
/* Au cas ou ces deux instructions seraient inutiles, il est possible de remplacer les */ \
/* 'CALS(...)' par des 'nCALS(...)'. */ \
\
CALS(fastPrin2("\n%04d %04d translate" \
,translation_horizontale \
,translation_verticale \
) \
); \
CALS(fastPrin2("\n%04d %04d scale" \
,COND(IL_FAUT(IPostScript_image_____conserver_les_echelles_horizontale_et_verticale) \
,echelle_horizontale \
,MIN2(echelle_horizontale,dimX_BASE) \
) \
,COND(IL_FAUT(IPostScript_image_____conserver_les_echelles_horizontale_et_verticale) \
,echelle_verticale \
,INTE(SCAL(echelle_verticale,echelle_horizontale,MIN2(echelle_horizontale,dimX_BASE))) \
) \
) \
); \
CALS(fastPrin1("\n%04d rotate",ZERO)); \
/* Generation des differents parametres geometriques... */ \
CALS(fastPrin0("\n")); \
/* Ceci est du au traitement particulier de la ligne suivante du fichier qui ne commence */ \
/* pas par un "\n..." (voir son commentaire). */ \
Eblock \
ATes \
Bblock \
Eblock \
ETes \
\
begin_nouveau_block \
Bblock \
DEFV(CHAR,INIC(POINTERc(format_EGAq____PostScript_image) \
,chain_Aconcaten4("%04d %04d %04d " \
,"%%" \
," dimension XxYxBits d'une composante de l'image " \
,"%%" \
) \
) \
); \
\
CALS(fastPrin3(format_EGAq____PostScript_image \
,dimX,dimY \
,INTE(Bsize_p) \
) \
); \
/* Transmission de la largeur, de la hauteur et du nombre de bits par point de l'image. */ \
/* */ \
/* On notera qu'il faut ecrire ci-dessus : */ \
/* */ \
/* CALS(fastPrin3("%04d %04d %04d %% ... %%",dimX,dimY,Bsize_p)); */ \
/* */ \
/* et non pas : */ \
/* */ \
/* CALS(fastPrin3("\n%04d %04d %04d %% ... %%",dimX,dimY,Bsize_p)); */ \
/* */ \
/* au cas ou cette ligne serait la premiere du fichier... De plus on notera que l'ecriture */ \
/* "%%" a contraint a supprimer l'operateur ' %% ' de concatenation traite lors de la */ \
/* '$PASSE_3' de '$xcc/cpp$Z'. Le 20090130101041 fut introduit 'chain_Aconcaten4(...)' */ \
/* pour la meme raison... */ \
/* */ \
/* Le 19980127085200 j'ai remplace 'Bsize_p' par 'INTE(Bsize_p)' suite a l'introduction des */ \
/* compilateurs '$nC_RELEASE=702000000' sur '$LACT29' qui exigent un "cast" ici... */ \
\
CALZ_FreCC(format_EGAq____PostScript_image); \
Eblock \
end_nouveau_block \
\
CALS(fastPrin3("\n[%04d %04d %04d",dimX,ZERO,ZERO)); \
CALS(fastPrin3(chain_Aconcaten6("\n" \
," " \
,"%04d %04d %04d] " \
,"%%" \
," matrice de transformation " \
,"%%" \
) \
,dimY \
,ZERO \
,ZERO \
) \
); \
/* Transmission de la matrice de transformation telle que l'axe 'OY' soit oriente dans le */ \
/* sens direct. On notera que pour inverser l'axe 'OY', il suffit d'ecrire : */ \
/* */ \
/* CALS(fastPrin3("\n %04d %04d %04d]",NEGA(dimY),ZERO,dimY)); */ \
/* */ \
/* Le 20090130101041 fut introduit 'chain_Aconcaten6(...)' pour la meme raison que */ \
/* ci-dessus... */ \
\
BLOC(edition_de_l_en_tete); \
/* Generation du "pied" de la description PostScript de l'image... */ \
CALS(fastPrin0("\n")); \
/* A priori... */ \
\
Test(IFOU(LE_SERVEUR_PostScript_EST_CELUI_DE("LACT21") \
,TOUJOURS_FAUX \
) \
) \
Bblock \
CALS(fastPrin0("{<\n")); \
/* "Ouverture" de la chaine hexa-decimale definissant le contenu de l'image... */ \
Eblock \
ATes \
Bblock \
Eblock \
ETes \
\
BLOC(editions_des_points); \
/* Envoi des points hexa-decimaux un a un... */ \
\
BLOC(edition_du_pied); \
/* Generation du "pied" de la description PostScript de l'image... */ \
\
Test(IFOU(LE_SERVEUR_PostScript_EST_CELUI_DE("LACT21") \
,TOUJOURS_FAUX \
) \
) \
Bblock \
CALS(fastPrin0(">} image")); \
/* "Fermeture" de la chaine hexa-decimale definissant le contenu de l'image... */ \
CALS(fastPrin0("\n /a4tray where {pop true a4tray} {} ifelse")); \
/* Selection du format "A4" (21x29.7). */ \
Repe(PRED(nombre_d_exemplaires)) \
Bblock \
CALS(fastPrin0("\n copypage")); \
Eblock \
ERep \
CALS(fastPrin0("\n showpage")); \
CALS(fastPrin0("\n } def")); \
CALS(fastPrin0("\n } win send")); \
CALS(fastPrin2("\n0 0 %d %d /reshape win send",dimX,dimY)); \
CALS(fastPrin0("\n/map win send")); \
Eblock \
ATes \
Bblock \
Eblock \
ETes \
\
Test(LE_SERVEUR_PostScript_EST_RECONNU) \
Bblock \
CALS(fastPrin0("/a4tray where {pop true a4tray} {} ifelse\n")); \
/* Selection du format "A4" (21x29.7). */ \
Repe(PRED(nombre_d_exemplaires)) \
Bblock \
CALS(fastPrin0("copypage\n")); \
Eblock \
ERep \
CALS(fastPrin0("showpage")); \
Eblock \
ATes \
Bblock \
Eblock \
ETes \
\
CALS(fastPrin0("\n%%%%Trailer\n")); \
/* Generation de la fin du programme... */ \
Eblock \
/* Squelette general d'edition d'une image en PostScript qu'elle soit Noir et Blanc ou bien */ \
/* en vraies couleurs... */
#define LE_SERVEUR_PostScript_EST_CELUI_DE(nom_presume_du_serveur) \
IFEQ_chaine(Gvar_sHOTE,nom_presume_du_serveur) \
/* Fonction testant le serveur physique 'PostScript' utilise. */
#define NOMBRE_DE_VALEURS_PAR_LIGNE \
SOIXANTE_QUATRE \
/* Nombre de points (exprimes en hexa-decimal) a editer par ligne. On notera que je suis */ \
/* passe de 'TRENTE_DEUX' a 'SEIZE' depuis l'introduction de la vraie couleur. Puis je suis */ \
/* passe a 'SOIXANTE_QUATRE' depuis que les trois couleurs sont separees... */
/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/* */
/* D U M P P o s t S c r i p t D ' U N E I M A G E E N N O I R E T B L A N C : */
/* */
/*************************************************************************************************************************************/
BFonctionI
DEFV(Common,DEFV(FonctionI,IPostScript_image_Noir_et_Blanc(imageA
,translation_horizontale,translation_verticale
,echelle_horizontale,echelle_verticale
,optimiser_la_conversion_PostScript
,nombre_d_exemplaires
)
)
)
DEFV(Argument,DEFV(image,imageA));
/* Image argument a dumper en format PostScript. */
DEFV(Argument,DEFV(Int,translation_horizontale));
DEFV(Argument,DEFV(Int,translation_verticale));
/* Translations horizontale et verticale de l'image en sortie. Chose incroyable, ces deux */
/* declarations ont ete ajoutees le 20021016120458, alors que les deux arguments */
/* correspondants etaient la depuis les origines... */
DEFV(Argument,DEFV(Int,echelle_horizontale));
DEFV(Argument,DEFV(Int,echelle_verticale));
/* Echelles horizontale et verticale de l'image en sortie. On notera que ces deux Arguments */
/* n'ont d'interet que sur certaines machines (par exemple 'LACT21'...). On notera que ces */
/* que ces deux arguments sont eventuellement ramenes a des valeurs inferieures suivant les */
/* fonctions : */
/* */
/* MIN2(echelle_horizontale,dimX_BASE) */
/* INTE(SCAL(echelle_verticale,echelle_horizontale,MIN2(echelle_horizontale,dimX_BASE))) */
/* */
/* car en effet, 'dimX_BASE' correspond grossierement a la largeur d'une feuille de papier */
/* au format A4... */
DEFV(Argument,DEFV(Logical,optimiser_la_conversion_PostScript));
/* Cet indicateur precise s'il faut sortir les points un a un ('FAUX'), ou par paquet */
/* equivalent a une ligne d'une composante... */
DEFV(Argument,DEFV(Positive,nombre_d_exemplaires));
/* Cet argument precise le nombre d'exemplaires a imprimer... */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
Bblock
INIT_ERROR;
/*..............................................................................................................................*/
PostScript_image(BLOC(CALS(fastPrin1("\n/chaine %d string def",dimX));
)
,BLOC(Test(LE_SERVEUR_PostScript_EST_RECONNU)
Bblock
CALS(fastPrin0("\n{currentfile chaine readhexstring pop}"));
/* On notera que l'on ne peut pas ecrire : */
/* */
/* CALS(fastPrin1("\n{currentfile %d string readhexstring pop}",dimX)); */
/* */
/* car en effet, alors, PostScript allouerait autant de chaines qu'il y a de lignes, sans */
/* jamais les rendre, d'ou un probleme de gestion de sa memoire se traduisant par le message */
/* d'erreur suivant : */
/* */
/* %%[Error: VMerror; OffendingCommand: string]%% */
/* */
/* sur l'imprimante couleur Canon CLC-300. */
Eblock
ATes
Bblock
Eblock
ETes
CALS(fastPrin0("\ntrue 1 colorimage"));
)
,BLOC(PostScript_composante(BLOC(PostScript_ligne(imageA);
);
);
)
,BLOC(CALS(fastPrin0("\n"));
)
);
/* Sortie PostScript de l'image (imageA) en Noir et Blanc. */
RETU_ERROR;
Eblock
EFonctionI
/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/* */
/* D U M P P o s t S c r i p t D ' U N E I M A G E E N C O U L E U R S : */
/* */
/*************************************************************************************************************************************/
BFonctionI
DEFV(Common,DEFV(FonctionI,IPostScript_image_en_vraies_couleurs(imageA_ROUGE
,imageA_VERTE
,imageA_BLEUE
,translation_horizontale,translation_verticale
,echelle_horizontale,echelle_verticale
,optimiser_la_conversion_PostScript
,nombre_d_exemplaires
)
)
)
DEFV(Argument,DEFV(image,imageA_ROUGE));
DEFV(Argument,DEFV(image,imageA_VERTE));
DEFV(Argument,DEFV(image,imageA_BLEUE));
/* Image argument a dumper en format PostScript fournie sous la forme de ses trois */
/* composantes chromatiques {R,V,B}. */
DEFV(Argument,DEFV(Int,translation_horizontale));
DEFV(Argument,DEFV(Int,translation_verticale));
/* Translations horizontale et verticale de l'image en sortie. Chose incroyable, ces deux */
/* declarations ont ete ajoutees le 20021016120458, alors que les deux arguments */
/* correspondants etaient la depuis les origines... */
DEFV(Argument,DEFV(Int,echelle_horizontale));
DEFV(Argument,DEFV(Int,echelle_verticale));
/* Echelles horizontale et verticale de l'image en sortie. On notera que ces deux Arguments */
/* n'ont d'interet que sur certaines machines (par exemple 'LACT21'...). On notera que ces */
/* que ces deux arguments sont eventuellement ramenes a des valeurs inferieures suivant les */
/* fonctions : */
/* */
/* MIN2(echelle_horizontale,dimX_BASE) */
/* INTE(SCAL(echelle_verticale,echelle_horizontale,MIN2(echelle_horizontale,dimX_BASE))) */
/* */
/* car en effet, 'dimX_BASE' correspond grossierement a la largeur d'une feuille de papier */
/* au format A4... */
DEFV(Argument,DEFV(Logical,optimiser_la_conversion_PostScript));
/* Cet indicateur precise s'il faut sortir les points un a un ('FAUX'), ou par paquet */
/* equivalent a une ligne d'une composante... */
DEFV(Argument,DEFV(Positive,nombre_d_exemplaires));
/* Cet argument precise le nombre d'exemplaires a imprimer... */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
Bblock
INIT_ERROR;
DEFV(Int,INIT(nombre_de_valeurs_par_ligne,NOMBRE_DE_VALEURS_PAR_LIGNE));
/* Nombre de points (exprimes en hexa-decimal) a editer par ligne. */
/*..............................................................................................................................*/
PostScript_image(BLOC(CALS(fastPrin1("\n/chaineR %d string def",dimX));
CALS(fastPrin1("\n/chaineV %d string def",dimX));
CALS(fastPrin1("\n/chaineB %d string def",dimX));
)
,BLOC(Test(LE_SERVEUR_PostScript_EST_RECONNU)
Bblock
CALS(fastPrin0("\n{currentfile chaineR readhexstring pop}"));
CALS(fastPrin0("\n{currentfile chaineV readhexstring pop}"));
CALS(fastPrin0("\n{currentfile chaineB readhexstring pop}"));
/* On notera que l'on ne peut pas ecrire : */
/* */
/* CALS(fastPrin1("\n{currentfile %d string readhexstring pop}",dimX)); */
/* CALS(fastPrin1("\n{currentfile %d string readhexstring pop}",dimX)); */
/* CALS(fastPrin1("\n{currentfile %d string readhexstring pop}",dimX)); */
/* */
/* car en effet, alors, PostScript allouerait autant de triplets de chaines qu'il y a de */
/* lignes, sans jamais les rendre, d'ou un probleme de gestion de sa memoire se traduisant */
/* par le message d'erreur suivant : */
/* */
/* %%[Error: Vm..., OffendingCommand: string]%% */
/* */
/* sur l'imprimante couleur Canon CLC-300. */
Eblock
ATes
Bblock
Eblock
ETes
CALS(fastPrin0("\ntrue 3 colorimage"));
)
,BLOC(PostScript_composante(BLOC(PostScript_ligne(imageA_ROUGE););
CALS(fastPrin0("\n"));
BLOC(PostScript_ligne(imageA_VERTE););
CALS(fastPrin0("\n"));
BLOC(PostScript_ligne(imageA_BLEUE););
CALS(fastPrin0("\n"));
CALS(fastPrin0("\n"));
);
)
,BLOC(VIDE;
)
);
/* Sortie PostScript de l'image (imageA_ROUGE,imageA_VERTE,imageA_BLEUE) en vraies couleurs. */
/* On notera qu'il y un saut de ligne entre chaque composante d'une ligne, puis deux sauts */
/* de ligne lorsque l'on passe a la ligne suivante... */
RETU_ERROR;
Eblock
EFonctionI
#undef NOMBRE_DE_VALEURS_PAR_LIGNE
#undef LE_SERVEUR_PostScript_EST_CELUI_DE
#undef PostScript_image
#undef PostScript_composante
#undef PostScript_ligne
#undef PostScript_valeur_hexa_decimale
#undef PostScript_rangement_d_un_caractere_hexa_decimal
#undef LONGUEUR_D_UNE_LIGNE_HEXA_DECIMALE_PostScript
#undef LE_SERVEUR_PostScript_EST_RECONNU
#undef FORMAT_HEXA_DECIMAL_SANS_ESPACE
#undef LONGUEUR_D_UN_POINT_CONVERTI_EN_HEXA_DECIMAL
_______________________________________________________________________________________________________________________________________
_______________________________________________________________________________________________________________________________________
/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/* */
/* L I S T A G E A L P H A - N U M E R I Q U E D ' U N E I M A G E */
/* S O U S F O R M E D E C O M M E N T A I R E S " C " : */
/* */
/* */
/* LISTE_IMAGE_ALPHA_NUMERIQUE_VERSION_01 : */
/* */
/* */
/* ....................................................... */
/* ....................................................... */
/* ....:::::::::::::::::::::::::::::::::::::::::::::::.... */
/* ....:::::::::::::::::::::::::::::::::::::::::::::::.... */
/* ....::::---------------------------------------::::.... */
/* ....::::---------------------------------------::::.... */
/* ....::::----+++++++++++++++++++++++++++++++----::::.... */
/* ....::::----+++++++++++++++++++++++++++++++----::::.... */
/* ....::::----++++ooooooooooooooooooooooo++++----::::.... */
/* ....::::----++++ooooooooooooooooooooooo++++----::::.... */
/* ....::::----++++oooo***************oooo++++----::::.... */
/* ....::::----++++oooo***************oooo++++----::::.... */
/* ....::::----++++oooo****#######****oooo++++----::::.... */
/* ....::::----++++oooo****#######****oooo++++----::::.... */
/* ....::::----++++oooo****#######****oooo++++----::::.... */
/* ....::::----++++oooo***************oooo++++----::::.... */
/* ....::::----++++oooo***************oooo++++----::::.... */
/* ....::::----++++ooooooooooooooooooooooo++++----::::.... */
/* ....::::----++++ooooooooooooooooooooooo++++----::::.... */
/* ....::::----+++++++++++++++++++++++++++++++----::::.... */
/* ....::::----+++++++++++++++++++++++++++++++----::::.... */
/* ....::::---------------------------------------::::.... */
/* ....::::---------------------------------------::::.... */
/* ....:::::::::::::::::::::::::::::::::::::::::::::::.... */
/* ....:::::::::::::::::::::::::::::::::::::::::::::::.... */
/* ....................................................... */
/* ....................................................... */
/* */
/* */
/* LISTE_IMAGE_ALPHA_NUMERIQUE_VERSION_02 : */
/* */
/* */
/* ################################################################ */
/* ####%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%### */
/* ####%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%### */
/* ####%%%%OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO%%%%### */
/* ####%%%%OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO%%%%### */
/* ####%%%%OOOOoooooooooooooooooooooooooooooooooooooooooOOOO%%%%### */
/* ####%%%%OOOOoooooooooooooooooooooooooooooooooooooooooOOOO%%%%### */
/* ####%%%%OOOOoooo:::::::::::::::::::::::::::::::::ooooOOOO%%%%### */
/* ####%%%%OOOOoooo:::::::::::::::::::::::::::::::::ooooOOOO%%%%### */
/* ####%%%%OOOOoooo::::-------------------------::::ooooOOOO%%%%### */
/* ####%%%%OOOOoooo::::-------------------------::::ooooOOOO%%%%### */
/* ####%%%%OOOOoooo::::----.................----::::ooooOOOO%%%%### */
/* ####%%%%OOOOoooo::::----.................----::::ooooOOOO%%%%### */
/* ####%%%%OOOOoooo::::----.................----::::ooooOOOO%%%%### */
/* ####%%%%OOOOoooo::::----.................----::::ooooOOOO%%%%### */
/* ####%%%%OOOOoooo::::----........ ........----::::ooooOOOO%%%%### */
/* ####%%%%OOOOoooo::::----.................----::::ooooOOOO%%%%### */
/* ####%%%%OOOOoooo::::----.................----::::ooooOOOO%%%%### */
/* ####%%%%OOOOoooo::::----.................----::::ooooOOOO%%%%### */
/* ####%%%%OOOOoooo::::----.................----::::ooooOOOO%%%%### */
/* ####%%%%OOOOoooo::::-------------------------::::ooooOOOO%%%%### */
/* ####%%%%OOOOoooo::::-------------------------::::ooooOOOO%%%%### */
/* ####%%%%OOOOoooo:::::::::::::::::::::::::::::::::ooooOOOO%%%%### */
/* ####%%%%OOOOoooo:::::::::::::::::::::::::::::::::ooooOOOO%%%%### */
/* ####%%%%OOOOoooooooooooooooooooooooooooooooooooooooooOOOO%%%%### */
/* ####%%%%OOOOoooooooooooooooooooooooooooooooooooooooooOOOO%%%%### */
/* ####%%%%OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO%%%%### */
/* ####%%%%OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO%%%%### */
/* ####%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%### */
/* ####%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%### */
/* ################################################################ */
/* ################################################################ */
/* */
/* */
/* (voir 'v $xiio/SPIRALE'). */
/* */
/* */
/*************************************************************************************************************************************/
BFonctionI
#define SEUIL_DE_DISCRIMINATION_GRIS_0 \
NOIR \
/* Seuil de discrimination entre le mode tout ou rien (=NOIR) et le mode "riche" (>NOIR). */
#define SEUIL_D_EDITION_GRIS_1 \
GRIS_1
#define SEUIL_D_EDITION_GRIS_2 \
GRIS_2
#define SEUIL_D_EDITION_GRIS_3 \
GRIS_3
#define SEUIL_D_EDITION_GRIS_4 \
GRIS_4
#define SEUIL_D_EDITION_GRIS_5 \
GRIS_5
#define SEUIL_D_EDITION_GRIS_6 \
GRIS_6
#define SEUIL_D_EDITION_GRIS_7 \
BLANC
/* Definition des seuils de choix des codes 'CARACTERE_GRIS_x' qui suivent. On notera qu'il */
/* avait autrefois : */
/* */
/* #define SEUIL_D_EDITION_GRIS_7 \ */
/* GRIS_7 */
/* */
/* mais qu'afin que tous les points non BLANCs soient visibles, 'GRIS_7' a ete remplace par */
/* 'BLANC'... */
#ifdef LISTE_IMAGE_ALPHA_NUMERIQUE_VERSION_01
# define CARACTERE_GRIS_1 \
K_DIESE
# define CARACTERE_GRIS_2 \
K_ETOILE
# define CARACTERE_GRIS_3 \
K_o
# define CARACTERE_GRIS_4 \
K_PLUS
# define CARACTERE_GRIS_5 \
K_MOINS
# define CARACTERE_GRIS_6 \
K_DEUX_POINTS
# define CARACTERE_GRIS_7 \
K_POINT
# define CARACTERE_GRIS_8 \
K_BLANC
/* Definition des caracteres equivalents aux differents niveaux de gris. On notera qu'il */
/* est preferable d'eviter le caractere 'K_A_ROND' vu l'usage intensif qui en est fait lors */
/* d'utilisation de '$VI'... */
#Aifdef LISTE_IMAGE_ALPHA_NUMERIQUE_VERSION_01
#Eifdef LISTE_IMAGE_ALPHA_NUMERIQUE_VERSION_01
#ifdef LISTE_IMAGE_ALPHA_NUMERIQUE_VERSION_02
# define CARACTERE_GRIS_1 \
K_DIESE
# define CARACTERE_GRIS_2 \
K_POUR_CENT
# define CARACTERE_GRIS_3 \
K_O
# define CARACTERE_GRIS_4 \
K_o
# define CARACTERE_GRIS_5 \
K_DEUX_POINTS
# define CARACTERE_GRIS_6 \
K_MOINS
# define CARACTERE_GRIS_7 \
K_POINT
# define CARACTERE_GRIS_8 \
K_BLANC
/* Definition des caracteres equivalents aux differents niveaux de gris. On notera qu'il */
/* est preferable d'eviter le caractere 'K_A_ROND' vu l'usage intensif qui en est fait lors */
/* d'utilisation de '$VI'... */
/* */
/* Cette version est tres adaptee aux ecrans haute-resolution. */
#Aifdef LISTE_IMAGE_ALPHA_NUMERIQUE_VERSION_02
#Eifdef LISTE_IMAGE_ALPHA_NUMERIQUE_VERSION_02
#ifdef LISTE_IMAGE_ALPHA_NUMERIQUE_VERSION_03
# define CARACTERE_GRIS_1 \
K_DIESE
# define CARACTERE_GRIS_2 \
K_O
# define CARACTERE_GRIS_3 \
K_o
# define CARACTERE_GRIS_4 \
K_POUR_CENT
# define CARACTERE_GRIS_5 \
K_MOINS
# define CARACTERE_GRIS_6 \
K_DEUX_POINTS
# define CARACTERE_GRIS_7 \
K_POINT
# define CARACTERE_GRIS_8 \
K_BLANC
/* Definition des caracteres equivalents aux differents niveaux de gris. On notera qu'il */
/* est preferable d'eviter le caractere 'K_A_ROND' vu l'usage intensif qui en est fait lors */
/* d'utilisation de '$VI'... */
/* */
/* Cette version est tres adaptee au Minitel... */
#Aifdef LISTE_IMAGE_ALPHA_NUMERIQUE_VERSION_03
#Eifdef LISTE_IMAGE_ALPHA_NUMERIQUE_VERSION_03
DEFV(Common,DEFV(CHAR,SINT(Iliste_image_____caractere_GRIS_1,CARACTERE_GRIS_1)));
DEFV(Common,DEFV(CHAR,SINT(Iliste_image_____caractere_GRIS_2,CARACTERE_GRIS_2)));
DEFV(Common,DEFV(CHAR,SINT(Iliste_image_____caractere_GRIS_3,CARACTERE_GRIS_3)));
DEFV(Common,DEFV(CHAR,SINT(Iliste_image_____caractere_GRIS_4,CARACTERE_GRIS_4)));
DEFV(Common,DEFV(CHAR,SINT(Iliste_image_____caractere_GRIS_5,CARACTERE_GRIS_5)));
DEFV(Common,DEFV(CHAR,SINT(Iliste_image_____caractere_GRIS_6,CARACTERE_GRIS_6)));
DEFV(Common,DEFV(CHAR,SINT(Iliste_image_____caractere_GRIS_7,CARACTERE_GRIS_7)));
DEFV(Common,DEFV(CHAR,SINT(Iliste_image_____caractere_GRIS_8,CARACTERE_GRIS_8)));
/* Definition des caracteres equivalents aux differents niveaux de gris. */
#define DEBUT_D_UNE_LIGNE_COMMENTAIRE \
"/* " \
/* Debut de chaque ligne commentaire. */
#define FIN_D_UNE_LIGNE_COMMENTAIRE \
"*/" \
/* Fin de chaque ligne commentaire. */
DEFV(Common,DEFV(FonctionI,Iliste_image(imageA,seuil_de_display,editer_des_commentaires)))
DEFV(Argument,DEFV(image,imageA));
/* Image argument a representer en alpha-numerique a l'aide de " ", ".", ":", "-", */
/* "+", "o", "*" et "#" du 'BLANC' au 'NOIR'. */
DEFV(Argument,DEFV(genere_p,seuil_de_display));
/* Ce seuil permet de choisir entre le mode "riche" utilisant la liste de */
/* caracteres ci-dessus (seuil_de_display=SEUIL_DE_DISCRIMINATION_GRIS_0), ou bien un jeu */
/* de caracteres fonctionnant en tout ou rien : */
/* */
/* niveau < seuil=de_display : "*", */
/* niveau >= seuil=de_display : " ". */
/* */
DEFV(Argument,DEFV(Logical,editer_des_commentaires));
/* Cet indicateur indique s'il faut presenter la sortie sous forme de commentaires */
/* compatibles avec "C" ('VRAI') ou pas, c'est-a-dire betement ('FAUX'). */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
Bblock
INIT_ERROR;
DEFV(genere_p,INIT(point_courant,NIVEAU_UNDEF));
/* Niveau du point courant. */
DEFV(CHAR,INIT(caractere_courant,K_UNDEF));
/* Caractere representant le point courant. */
DEFV(Logical,INIT(editer_des_commentaires_corrects,editer_des_commentaires));
/* Cet indicateur indique s'il faut presenter la sortie sous forme de commentaires */
/* compatibles avec "C" ('VRAI') ou pas, c'est-a-dire betement ('FAUX'), mais uniquement */
/* lorsque cela est compatible avec les pas (pasX,pasY)... */
DEFV(Positive,INIT(compteur_des_caracteres_sur_la_ligne_courante,UNDEF));
/* Compteur des caracteres deja edites pour la ligne courante. */
/*..............................................................................................................................*/
Test(IFET(IL_FAUT(editer_des_commentaires)
,IFOU(IFNE(pasX,PAS_HORIZONTAL_D_EDITION),IFNE(pasY,PAS_VERTICAL_D_EDITION))
)
)
Bblock
PRINT_ERREUR("les pas sont incompatibles avec l'edition sous le format 'commentaires'");
EGAL(editer_des_commentaires_corrects,FAUX);
/* On ne peut donc pas editer sous le format 'commentaires', puisque les pas ne s'y */
/* pretent pas... */
Eblock
ATes
Bblock
Eblock
ETes
/* ATTENTION, on pourrait placer ici un : */
/* */
/* CAL2(Prin1(FORMAT_CHAR,K_LF)); */
/* */
/* au cas ou, par exemple, un message d'erreur d'une commande utilisant 'Iliste_image(...)' */
/* (et par exemple 'v $xci/liste$K') sortirait juste avant. En fait, il ne faut pas le faire */
/* pour les deux raisons suivantes : */
/* */
/* 1-les messages d'erreur utilisent 'STREAM_ERREUR' alors que l'edition alpha-numerique */
/* de l'image utilise 'STREAM_OUT' ; il n'y a donc pas de risques de confusion lorsqu'un */
/* fichier est genere pour representer l'image en alpha-numerique. */
/* */
/* 2-lorsqu'il n'y a pas de message d'erreur, cela introduirait une ligne vide devant la */
/* representation alpha-numerique de l'image, ce qui pourrait etre perturbant... */
/* */
begin_colonne_back
Bblock
Test(IL_FAUT(editer_des_commentaires_corrects))
Bblock
CAL2(Prin0(DEBUT_D_UNE_LIGNE_COMMENTAIRE));
/* Debut d'une nouvelle ligne (sous la forme d'un commentaire)... */
EGAL(compteur_des_caracteres_sur_la_ligne_courante,chain_Xtaille(DEBUT_D_UNE_LIGNE_COMMENTAIRE));
/* Initialisation du compteur des caracteres deja edites pour la ligne courante. */
Eblock
ATes
Bblock
CLIR(compteur_des_caracteres_sur_la_ligne_courante);
/* Initialisation du compteur des caracteres deja edites pour la ligne courante. */
Eblock
ETes
begin_ligne
Bblock
EGAL(point_courant,load_point(imageA,X,Y));
/* Recuperation du point courant, */
Test(IFNE(seuil_de_display,SEUIL_DE_DISCRIMINATION_GRIS_0))
Bblock
/* Choix du mode tout ou rien... */
Test(IFLT(point_courant,seuil_de_display))
Bblock
EGAL(caractere_courant,Iliste_image_____caractere_GRIS_2);
Eblock
ATes
Bblock
EGAL(caractere_courant,Iliste_image_____caractere_GRIS_8);
Eblock
ETes
Eblock
ATes
Bblock
/* Choix du mode "riche"... */
Test(IFLT(point_courant,SEUIL_D_EDITION_GRIS_1))
Bblock
EGAL(caractere_courant,Iliste_image_____caractere_GRIS_1);
Eblock
ATes
Bblock
Test(IFLT(point_courant,SEUIL_D_EDITION_GRIS_2))
Bblock
EGAL(caractere_courant,Iliste_image_____caractere_GRIS_2);
Eblock
ATes
Bblock
Test(IFLT(point_courant,SEUIL_D_EDITION_GRIS_3))
Bblock
EGAL(caractere_courant,Iliste_image_____caractere_GRIS_3);
Eblock
ATes
Bblock
Test(IFLT(point_courant,SEUIL_D_EDITION_GRIS_4))
Bblock
EGAL(caractere_courant,Iliste_image_____caractere_GRIS_4);
Eblock
ATes
Bblock
Test(IFLT(point_courant,SEUIL_D_EDITION_GRIS_5))
Bblock
EGAL(caractere_courant,Iliste_image_____caractere_GRIS_5);
Eblock
ATes
Bblock
Test(IFLT(point_courant,SEUIL_D_EDITION_GRIS_6))
Bblock
EGAL(caractere_courant,Iliste_image_____caractere_GRIS_6);
Eblock
ATes
Bblock
Test(IFLT(point_courant,SEUIL_D_EDITION_GRIS_7))
Bblock
EGAL(caractere_courant,Iliste_image_____caractere_GRIS_7);
Eblock
ATes
Bblock
EGAL(caractere_courant,Iliste_image_____caractere_GRIS_8);
Eblock
ETes
Eblock
ETes
Eblock
ETes
Eblock
ETes
Eblock
ETes
Eblock
ETes
Eblock
ETes
Eblock
ETes
CAL2(Prin1(FORMAT_CHAR,caractere_courant));
/* Et impression de sa representation... */
INCR(compteur_des_caracteres_sur_la_ligne_courante,I);
/* Comptage des caracteres deja edites pour la ligne courante. */
Eblock
end_ligne
Test(IL_FAUT(editer_des_commentaires_corrects))
Bblock
Repe(SOUS(LONGUEUR_D_UNE_LIGNE_SOURCE_SLASH
,ADD2(compteur_des_caracteres_sur_la_ligne_courante,chain_Xtaille(FIN_D_UNE_LIGNE_COMMENTAIRE))
)
)
Bblock
CAL2(Prin1(FORMAT_CHAR,K_BLANC));
/* On complete par des espaces la ligne courante... */
Eblock
ERep
CAL2(Prin0(FIN_D_UNE_LIGNE_COMMENTAIRE));
CAL2(Prin1(FORMAT_CHAR,K_LF));
/* Fin de la ligne de commentaires courante... */
Eblock
ATes
Bblock
CAL2(Prin1(FORMAT_CHAR,K_LF));
/* Fin de la ligne courante... */
Eblock
ETes
Eblock
end_colonne_back
RETU_ERROR;
Eblock
#undef FIN_D_UNE_LIGNE_COMMENTAIRE
#undef DEBUT_D_UNE_LIGNE_COMMENTAIRE
#undef CARACTERE_GRIS_8
#undef CARACTERE_GRIS_7
#undef CARACTERE_GRIS_6
#undef CARACTERE_GRIS_5
#undef CARACTERE_GRIS_4
#undef CARACTERE_GRIS_3
#undef CARACTERE_GRIS_2
#undef CARACTERE_GRIS_1
#undef SEUIL_D_EDITION_GRIS_7
#undef SEUIL_D_EDITION_GRIS_6
#undef SEUIL_D_EDITION_GRIS_5
#undef SEUIL_D_EDITION_GRIS_4
#undef SEUIL_D_EDITION_GRIS_3
#undef SEUIL_D_EDITION_GRIS_2
#undef SEUIL_D_EDITION_GRIS_1
#undef SEUIL_DE_DISCRIMINATION_GRIS_0
EFonctionI
_______________________________________________________________________________________________________________________________________