DOC HOME SITE MAP MAN PAGES GNU INFO SEARCH
 

(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