4.4.8 The 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)
     {
       SCM smob;
       struct image *image;
       int width = scm_to_int (s_width);
       int height = scm_to_int (s_height);
     
       /* Step 1: Allocate the memory block.
        */
       image = (struct image *) scm_gc_malloc (sizeof (struct image), "image");
     
       /* Step 2: Initialize it with straight code.
        */
       image->width = width;
       image->height = height;
       image->pixels = NULL;
       image->name = SCM_BOOL_F;
       image->update_func = SCM_BOOL_F;
     
       /* Step 3: Create the smob.
        */
       SCM_NEWSMOB (smob, image_tag, image);
     
       /* Step 4: Finish the initialization.
        */
       image->name = name;
       image->pixels = scm_gc_malloc (width * height, "image pixels");
     
       return smob;
     }
     
     SCM
     clear_image (SCM image_smob)
     {
       int area;
       struct image *image;
     
       scm_assert_smob_type (image_tag, image_smob);
     
       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 (scm_is_true (image->update_func))
         scm_call_0 (image->update_func);
     
       scm_remember_upto_here_1 (image_smob);
     
       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);
     
       scm_gc_free (image->pixels, image->width * image->height, "image pixels");
       scm_gc_free (image, sizeof (struct image), "image");
     
       return 0;
     }
     
     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 (expecting image): 4
     ABORT: (wrong-type-arg)
     
     Type "(backtrace)" to get more information.
     guile>