mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 03:30:27 +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