(guile.info.gz) A Complete Example
Info Catalog
(guile.info.gz) Garbage Collecting Simple Smobs
(guile.info.gz) Defining New Types (Smobs)
18.3.7 A Complete Example
-------------------------
Here is the complete text of the implementation of the image datatype,
as presented in the sections above. We also provide a definition for
the smob's `print' function, and make some objects and functions
static, to clarify exactly what the surrounding code is using.
As mentioned above, you can find this code in the Guile
distribution, in `doc/example-smob'. That directory includes a
makefile and a suitable `main' function, so you can build a complete
interactive Guile shell, extended with the datatypes described here.)
/* file "image-type.c" */
#include <stdlib.h>
#include <libguile.h>
static scm_t_bits image_tag;
struct image {
int width, height;
char *pixels;
/* The name of this image */
SCM name;
/* A function to call when this image is
modified, e.g., to update the screen,
or SCM_BOOL_F if no action necessary */
SCM update_func;
};
static SCM
make_image (SCM name, SCM s_width, SCM s_height)
{
struct image *image;
int width, height;
SCM_ASSERT (SCM_STRINGP (name), name, SCM_ARG1, "make-image");
SCM_ASSERT (SCM_INUMP (s_width), s_width, SCM_ARG2, "make-image");
SCM_ASSERT (SCM_INUMP (s_height), s_height, SCM_ARG3, "make-image");
width = SCM_INUM (s_width);
height = SCM_INUM (s_height);
image = (struct image *) scm_must_malloc (sizeof (struct image), "image");
image->width = width;
image->height = height;
image->pixels = scm_must_malloc (width * height, "image pixels");
image->name = name;
image->update_func = SCM_BOOL_F;
SCM_RETURN_NEWSMOB (image_tag, image);
}
static SCM
clear_image (SCM image_smob)
{
int area;
struct image *image;
SCM_ASSERT (SCM_SMOB_PREDICATE (image_tag, image_smob),
image_smob, SCM_ARG1, "clear-image");
image = (struct image *) SCM_SMOB_DATA (image_smob);
area = image->width * image->height;
memset (image->pixels, 0, area);
/* Invoke the image's update function. */
if (image->update_func != SCM_BOOL_F)
scm_apply (image->update_func, SCM_EOL, SCM_EOL);
return SCM_UNSPECIFIED;
}
static SCM
mark_image (SCM image_smob)
{
/* Mark the image's name and update function. */
struct image *image = (struct image *) SCM_SMOB_DATA (image_smob);
scm_gc_mark (image->name);
return image->update_func;
}
static size_t
free_image (SCM image_smob)
{
struct image *image = (struct image *) SCM_SMOB_DATA (image_smob);
size_t size = image->width * image->height + sizeof (struct image);
free (image->pixels);
free (image);
return size;
}
static int
print_image (SCM image_smob, SCM port, scm_print_state *pstate)
{
struct image *image = (struct image *) SCM_SMOB_DATA (image_smob);
scm_puts ("#<image ", port);
scm_display (image->name, port);
scm_puts (">", port);
/* non-zero means success */
return 1;
}
void
init_image_type (void)
{
image_tag = scm_make_smob_type ("image", sizeof (struct image));
scm_set_smob_mark (image_tag, mark_image);
scm_set_smob_free (image_tag, free_image);
scm_set_smob_print (image_tag, print_image);
scm_c_define_gsubr ("clear-image", 1, 0, 0, clear_image);
scm_c_define_gsubr ("make-image", 3, 0, 0, make_image);
}
Here is a sample build and interaction with the code from the
`example-smob' directory, on the author's machine:
zwingli:example-smob$ make CC=gcc
gcc `guile-config compile` -c image-type.c -o image-type.o
gcc `guile-config compile` -c myguile.c -o myguile.o
gcc image-type.o myguile.o `guile-config link` -o myguile
zwingli:example-smob$ ./myguile
guile> make-image
#<primitive-procedure make-image>
guile> (define i (make-image "Whistler's Mother" 100 100))
guile> i
#<image Whistler's Mother>
guile> (clear-image i)
guile> (clear-image 4)
ERROR: In procedure clear-image in expression (clear-image 4):
ERROR: Wrong type argument in position 1: 4
ABORT: (wrong-type-arg)
Type "(backtrace)" to get more information.
guile>
Info Catalog
(guile.info.gz) Garbage Collecting Simple Smobs
(guile.info.gz) Defining New Types (Smobs)
automatically generated byinfo2html