Critcl et GD: Faire propre

 

XG - 7 Septembre 2005


Le code vu précédemment dans Critcl et GD fonctionne mais il reste un problème critique. On passe par un fichier pour charger le png obtenu dans une image.

Dans le but de supprimer les temps d'accès au disque, on va dans cet exemple retourner directement un objet à l'interpréteur Tcl.

Dans la foulée, je vous montre comment renvoyer des messages à l'utilisateur. En effet TCL_OK et TCL_ERROR sont des valeurs de retour qui ne s'utilisent quand dans les "vraies" commandes Tcl.

Expliquons donc le code de la nouvelle procédure drawTextToObj.


 ::critcl::cproc drawTextToObj {Tcl_Interp* interp int fontsize char* font char* s} void {
	...

On trouve en premier paramètre un pointeur vers l'interpréteur Tcl courant. Ce dernier nous est nécessaire pour afficher les messages d'erreur et renvoyer l'objet contenant les données de l'image à qui de droit. Il n'est cependant pas nécessaire lors de l'appel de la commande d'en tenir compte, ce pointeur nous sera automatiquement transmis par Tcl. Le premier argument de la commande sera donc toujours fontsize pour l'utilisateur.

	gdImagePtr im;
	int size;
	char* pngPtr;
	int bgColor;
	int fgColor;
	int brect[8];
	int w, h;
	char *err;
	unsigned long bgR, bgG, bgB, fgR, fgG, fgB;
	Tcl_Obj* objResult;
	...

On trouve ci-dessus la déclaration d'un Tcl_Obj, qui est un type abstrait permettant d'échanger des données de divers types (entiers, flottants, chaînes de caractères, tableaux d'octets) avec l'interpréteur.

	bgR = 0xff;
	bgG = 0xff;
	bgB = 0xff;
	fgR = 0;
	fgG = 0;
	fgB = 0;

	gdFTUseFontConfig(1);

	while (s[strlen(s)-1]=='\n' || s[strlen(s)-1]=='\r') s[strlen(s)-1]='\0';
	err = gdImageStringFT(NULL,&brect[0],0,font,fontsize,0.,0,0,s);
	if (err) {
		Tcl_SetResult (interp, err, TCL_VOLATILE);
		return;
	}
	...

Ici, en cas d'erreur, on récupère le message généré par gd dans la variable err. On envoit le message d'erreur à l'interpréteur pour qu'il soit affiché à l'utilisateur.

On utilise à cette fin la fonction Tcl_SetResult qui prend en paramètres:

	w = brect[2]-brect[6];
	h = brect[3]-brect[7];

	im = gdImageCreate(w,h);
	bgColor = gdImageColorResolve(im, bgR, bgG, bgB);
	fgColor = gdImageColorResolve(im, fgR, fgG, fgB);

	err = gdImageStringFT(im,&brect[0],fgColor,font,fontsize,0.,-brect[6],-brect[7],s);
	if (err) {
		Tcl_SetResult (interp, err, TCL_VOLATILE);
		return;
	}
	...

On retrouve ci-dessus un message d'erreur de type TCL_VOLATILE.

	pngPtr = gdImagePngPtr(im, &size);
	gdImageDestroy(im);
	...

Arrivé au terme du 'traitement d'image', au lieu de l'envoyer dans un fichier (avec gdImagePng comme fait précédemment), on la stocke dans une zone mémoire à l'aide de la fonction gdImagePngPtr qui retourne un pointeur pngPtr sur le premier octet de la zone mémoire contenant les données de l'image Png et affecte la taille de cette zone à la variable size.

	objResult = Tcl_NewByteArrayObj(pngPtr, size);
	...

Fort des renseignements acquis, on peut maintenant créer un objet de type tableau d'octets suffisamment grand pour contenir les données de l'image. On passe l'adresse des données à y copier en premier paramètre de la fonction Tcl_NewByteArrayObj et la taille des données en second.

	if (!objResult) {
		Tcl_SetResult (interp, "Erreur lors de la création de l'objet image.", TCL_STATIC);
		return;
	}
	...

On vérifie que la création de l'objet s'est bien passée. Dans le cas contraire, on fait parvenir un message à l'interpréteur. Le message étant ici statique, on utilise la fonction Tcl_SetResult avec le type TCL_STATIC évoqué quelques lignes plus haut.

	Tcl_SetObjResult(interp, objResult);
	...

On déclare que l'objet objResult sera le résultat de la procédure en appelant Tcl_SetObjResult.

	gdFree(pngPtr);
 }

Enfin, on libère le buffer utilisé pour stocker l'image ...


le code tcl pour utiliser la nouvelle procédure

 % package require Tk
 8.4
 % package require Img
 1.3
 % package require drawText
 1.0
 % set data [drawTextToObj 24 Futura:italic "Test Obj"]
 ‰PNG
 ...
 % image create photo -format png -data $data
 image1
 % pack [label .l -image image1]

On voit en retour de la procédure drawTextToObj le contenu de l'image, au format png, affecté à la variable data. On s'en sert ensuite pour créer une image, et voilà !


Voir aussi:


Catégorie Cours