mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
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.
This commit is contained in:
parent
305f02b130
commit
90b714763e
5 changed files with 154 additions and 0 deletions
12
doc/example-smob/Makefile
Normal file
12
doc/example-smob/Makefile
Normal file
|
@ -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)
|
6
doc/example-smob/README
Normal file
6
doc/example-smob/README
Normal file
|
@ -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.
|
116
doc/example-smob/image-type.c
Normal file
116
doc/example-smob/image-type.c
Normal file
|
@ -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);
|
||||||
|
}
|
3
doc/example-smob/image-type.h
Normal file
3
doc/example-smob/image-type.h
Normal file
|
@ -0,0 +1,3 @@
|
||||||
|
/* file "image-type.h" */
|
||||||
|
|
||||||
|
void init_image_type(void);
|
17
doc/example-smob/myguile.c
Normal file
17
doc/example-smob/myguile.c
Normal file
|
@ -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 */
|
||||||
|
}
|
Loading…
Add table
Add a link
Reference in a new issue