www.delorie.com/gnu/docs/guile/guile_141.html   search  
 
Buy GNU books!


Guile Reference Manual

[ < ] [ > ]   [ << ] [ Up ] [ >> ]         [Top] [Contents] [Index] [ ? ]

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 ("#

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> 


[ < ] [ > ]   [ << ] [ Up ] [ >> ]         [Top] [Contents] [Index] [ ? ]

  webmaster     delorie software   privacy  
  Copyright 2003   by The Free Software Foundation     Updated Jun 2003