mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 05:50:26 +02:00
Code Activity

Updated from manual.

Browse source
This commit is contained in:
Marius Vollmer 2004-09-24 02:11:03 +00:00
parent 48d8f65992
commit 43631debba
1 changed files with 29 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

47
doc/example-smob/image-type.c
View file

@ -1,6 +1,6 @@
/* image-type.c /* image-type.c
* *
* Copyright (C) 1998, 2000 Free Software Foundation, Inc. * Copyright (C) 1998, 2000, 2004 Free Software Foundation, Inc.
* *
* This program is free software; you can redistribute it and/or modify * This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by * it under the terms of the GNU General Public License as published by
@ -39,42 +39,53 @@ struct image {
static SCM static SCM
make_image (SCM name, SCM s_width, SCM s_height) make_image (SCM name, SCM s_width, SCM s_height)
{ {
SCM smob;
struct image *image; struct image *image;
int width, height; int width = scm_to_int (s_width);
int height = scm_to_int (s_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);
/* Step 1: Allocate the memory block.
*/
image = (struct image *) scm_gc_malloc (sizeof (struct image), "image"); image = (struct image *) scm_gc_malloc (sizeof (struct image), "image");
/* Step 2: Initialize it with straight code.
*/
image->width = width; image->width = width;
image->height = height; image->height = height;
image->pixels = scm_gc_malloc (width * height, "image pixels"); image->pixels = NULL;
image->name = name; image->name = SCM_BOOL_F;
image->update_func = SCM_BOOL_F; image->update_func = SCM_BOOL_F;
SCM_RETURN_NEWSMOB (image_tag, image); /* 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;
} }
static SCM SCM
clear_image (SCM image_smob) clear_image (SCM image_smob)
{ {
int area; int area;
struct image *image; struct image *image;
SCM_ASSERT (SCM_SMOB_PREDICATE (image_tag, image_smob), scm_assert_smob_type (image_tag, image_smob);
image_smob, SCM_ARG1, "clear-image");
image = (struct image *) SCM_SMOB_DATA (image_smob); image = (struct image *) SCM_SMOB_DATA (image_smob);
area = image->width * image->height; area = image->width * image->height;
memset (image->pixels, 0, area); memset (image->pixels, 0, area);
/* Invoke the image's update function. */ /* Invoke the image's update function.
if (image->update_func != SCM_BOOL_F) */
scm_apply (image->update_func, SCM_EOL, SCM_EOL); if (scm_is_true (image->update_func))
scm_call_0 (image->update_func);
scm_remember_upto_here_1 (image_smob);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }