diff options
author | Jim Blandy <jimb@red-bean.com> | 1998-10-15 21:48:51 +0000 |
---|---|---|
committer | Jim Blandy <jimb@red-bean.com> | 1998-10-15 21:48:51 +0000 |
commit | 90b714763e2f6ec59267ed5bf16356f8b7df58f7 (patch) | |
tree | 85bc34390592bccfa11b7623dd7ff68f15cf5ad7 | |
parent | 305f02b1303af61c156f2922f1019ac1dfba76c2 (diff) | |
download | guile-90b714763e2f6ec59267ed5bf16356f8b7df58f7.tar.gz |
Created this directory for the Guile 1.3 release. Thanks to Jay
Glascoe for suggesting that we provide a complete, buildable
example!
* ChangeLog, Makefile, README, image-type.c, image-type.h,
myguile: New files.
-rw-r--r-- | doc/example-smob/Makefile | 12 | ||||
-rw-r--r-- | doc/example-smob/README | 6 | ||||
-rw-r--r-- | doc/example-smob/image-type.c | 116 | ||||
-rw-r--r-- | doc/example-smob/image-type.h | 3 | ||||
-rw-r--r-- | doc/example-smob/myguile.c | 17 |
5 files changed, 154 insertions, 0 deletions
diff --git a/doc/example-smob/Makefile b/doc/example-smob/Makefile new file mode 100644 index 000000000..b312c4594 --- /dev/null +++ b/doc/example-smob/Makefile @@ -0,0 +1,12 @@ +CFLAGS=`guile-config compile` +LDFLAGS=`guile-config link` + +O_FILES=image-type.o myguile.o + +all: myguile + +myguile: $(O_FILES) + $(CC) $(LDFLAGS) $(O_FILES) -o myguile + +clean: + -rm -rf myguile $(O_FILES) diff --git a/doc/example-smob/README b/doc/example-smob/README new file mode 100644 index 000000000..1380db123 --- /dev/null +++ b/doc/example-smob/README @@ -0,0 +1,6 @@ +This is the example code for the ``Defining New Types (Smobs)'' +chapter of the Guile manual. + +When you try to execute the code, if the system complains that it +can't find libguile.so, you need to add the directory containing the +installed Guile libraries to your LD_LIBRARY_PATH environment variable. diff --git a/doc/example-smob/image-type.c b/doc/example-smob/image-type.c new file mode 100644 index 000000000..083d5df94 --- /dev/null +++ b/doc/example-smob/image-type.c @@ -0,0 +1,116 @@ +/* file "image-type.c" */ + +#include <stdlib.h> +#include <libguile.h> + +static long 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; + SCM image_smob; + int width, height; + + SCM_ASSERT (SCM_NIMP (name) && 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_NEWCELL (image_smob); + SCM_SETCDR (image_smob, image); + SCM_SETCAR (image_smob, image_tag); + + return image_smob; +} + +static SCM +clear_image (SCM image_smob) +{ + int area; + struct image *image; + + SCM_ASSERT ((SCM_NIMP (image_smob) + && SCM_CAR (image_smob) == image_tag), + image_smob, SCM_ARG1, "clear-image"); + + image = (struct image *) SCM_CDR (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) +{ + struct image *image = (struct image *) SCM_CDR (image_smob); + + scm_gc_mark (image->name); + return image->update_func; +} + +static scm_sizet +free_image (SCM image_smob) +{ + struct image *image = (struct image *) SCM_CDR (image_smob); + scm_sizet 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_CDR (image_smob); + + scm_puts ("#<image ", port); + scm_display (image->name, port); + scm_puts (">", port); + + /* non-zero means success */ + return 1; +} + +static scm_smobfuns image_funs = { + mark_image, free_image, print_image, 0 +}; + +void +init_image_type () +{ + image_tag = scm_newsmob (&image_funs); + + scm_make_gsubr ("clear-image", 1, 0, 0, clear_image); + scm_make_gsubr ("make-image", 3, 0, 0, make_image); +} diff --git a/doc/example-smob/image-type.h b/doc/example-smob/image-type.h new file mode 100644 index 000000000..e57b1c650 --- /dev/null +++ b/doc/example-smob/image-type.h @@ -0,0 +1,3 @@ +/* file "image-type.h" */ + +void init_image_type(void); diff --git a/doc/example-smob/myguile.c b/doc/example-smob/myguile.c new file mode 100644 index 000000000..7234b9846 --- /dev/null +++ b/doc/example-smob/myguile.c @@ -0,0 +1,17 @@ +#include <libguile.h> +#include "image-type.h" + +static void +inner_main (void *closure, int argc, char **argv) +{ + /* module initializations would go here */ + init_image_type(); + scm_shell (argc, argv); +} + +int +main (int argc, char **argv) +{ + scm_boot_guile (argc, argv, inner_main, 0); + return 0; /* never reached */ +} |