ocaml/otherlibs/graph/make_img.c

110 lines
3.6 KiB
C

/***********************************************************************/
/* */
/* Objective Caml */
/* */
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
/* */
/* Copyright 1996 Institut National de Recherche en Informatique et */
/* en Automatique. All rights reserved. This file is distributed */
/* under the terms of the GNU Library General Public License. */
/* */
/***********************************************************************/
/* $Id$ */
#include "libgraph.h"
#include "image.h"
#include <memory.h>
value gr_make_image(value m)
{
int width, height;
value im;
Bool has_transp;
XImage * idata, * imask;
char * bdata, * bmask;
int i, j, rgb;
value line;
GC gc;
gr_check_open();
height = Wosize_val(m);
if (height == 0) return gr_new_image(0, 0);
width = Wosize_val(Field(m, 0));
for (i = 1; i < height; i++)
if (Wosize_val(Field(m, i)) != width)
gr_fail("make_image: lines of different lengths", NULL);
/* Build an XImage for the data part of the image */
idata =
XCreateImage(grdisplay, DefaultVisual(grdisplay, grscreen),
XDefaultDepth(grdisplay, grscreen),
ZPixmap, 0, NULL, width, height,
BitmapPad(grdisplay), 0);
/* To optimize RGB => color id calculation */
if( !direct_rgb ){
/* they are declared in color.c */
byte_order = idata->byte_order;
bitmap_unit = idata->bitmap_unit;
bits_per_pixel = idata->bits_per_pixel;
#ifdef DIRECT_RGB_DEBUG
fprintf(stderr, "Byte_order: %d = %s\n", byte_order,
byte_order ? "LSBFirst" : "MSBFirst");
fprintf(stderr, "Bitmp_unit: %d\n", bitmap_unit);
fprintf(stderr, "Bits per pixel: %d\n", idata->bits_per_pixel);
#endif
direct_rgb = True;
}
bdata = (char *) stat_alloc(height * idata->bytes_per_line);
idata->data = bdata;
has_transp = False;
for (i = 0; i < height; i++) {
line = Field(m, i);
for (j = 0; j < width; j++) {
rgb = Int_val(Field(line, j));
if (rgb == Transparent) { has_transp = True; rgb = 0; }
XPutPixel(idata, j, i, gr_pixel_rgb(rgb));
}
}
/* If the matrix contains transparent points,
build an XImage for the mask part of the image */
if (has_transp) {
imask =
XCreateImage(grdisplay, DefaultVisual(grdisplay, grscreen),
1, ZPixmap, 0, NULL, width, height,
BitmapPad(grdisplay), 0);
bmask = (char *) stat_alloc(height * imask->bytes_per_line);
imask->data = bmask;
for (i = 0; i < height; i++) {
line = Field(m, i);
for (j = 0; j < width; j++) {
rgb = Int_val(Field(line, j));
XPutPixel(imask, j, i, rgb != Transparent);
}
}
} else {
imask = NULL;
}
/* Allocate the image and store the XImages into the Pixmaps */
im = gr_new_image(width, height);
gc = XCreateGC(grdisplay, Data_im(im), 0, NULL);
XPutImage(grdisplay, Data_im(im), gc, idata, 0, 0, 0, 0, width, height);
XDestroyImage(idata);
XFreeGC(grdisplay, gc);
if (has_transp) {
Mask_im(im) = XCreatePixmap(grdisplay, grwindow.win, width, height, 1);
gc = XCreateGC(grdisplay, Mask_im(im), 0, NULL);
XPutImage(grdisplay, Mask_im(im), gc, imask, 0, 0, 0, 0, width, height);
XDestroyImage(imask);
XFreeGC(grdisplay, gc);
}
XFlush(grdisplay);
return im;
}