X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=src%2Fgacela_FTGL.c;h=643707e466fae7d0c9749b9e782cbfa2034aeee1;hb=500b68bdf16918b05f859830cc83d5a429d5b447;hp=15232fac5eab4703c8e9fa1e26615280a802088f;hpb=60e28d143c3beb811e52c03784172a84e42e5e0e;p=gacela.git

diff --git a/src/gacela_FTGL.c b/src/gacela_FTGL.c
index 15232fa..643707e 100644
--- a/src/gacela_FTGL.c
+++ b/src/gacela_FTGL.c
@@ -27,67 +27,110 @@ struct font
 
 static scm_t_bits font_tag;
 
-
 SCM
-gacela_ftglCreateTextureFont (SCM file)
+make_font (SCM file, FTGLfont *font_address)
 {
   SCM smob;
   struct font *font;
-  FTGLfont *font_address = NULL;
 
-  font_address = ftglCreateTextureFont (scm_to_locale_string (file));
+  font = (struct font *) scm_gc_malloc (sizeof (struct font), "font");
 
-  if (font_address) {
-    font = (struct font *) scm_gc_malloc (sizeof (struct font), "font");
+  font->filename = SCM_BOOL_F;
+  font->font_address = NULL;
+
+  SCM_NEWSMOB (smob, font_tag, font);
+
+  font->filename = file;
+  font->font_address = font_address;
+
+  return smob;
+}
+
+FTGLfont *
+get_font_address (SCM font_smob)
+{
+  struct font *font;
+
+  scm_assert_smob_type (font_tag, font_smob);
+  font = (struct font *) SCM_SMOB_DATA (font_smob);
+  return font->font_address;
+}
+
+SCM
+mark_font (SCM font_smob)
+{
+  struct font *font = (struct font *) SCM_SMOB_DATA (font_smob);
+
+  scm_gc_mark (font->filename);
+     
+  return SCM_BOOL_F;
+}
 
-    font->filename = SCM_BOOL_F;
-    font->font_address = NULL;
+size_t
+free_font (SCM font_smob)
+{
+  struct font *font = (struct font *) SCM_SMOB_DATA (font_smob);
+
+  ftglDestroyFont (font->font_address);
+  scm_gc_free (font, sizeof (struct font), "font");
 
-    SCM_NEWSMOB (smob, font_tag, font);
+  return 0;
+}
+
+static int
+print_font (SCM font_smob, SCM port, scm_print_state *pstate)
+{
+  struct font *font = (struct font *) SCM_SMOB_DATA (font_smob);
 
-    font->filename = file;
-    font->font_address = font_address;
+  scm_puts ("#<font \"", port);
+  scm_display (font->filename, port);
+  scm_puts ("\">", port);
 
-    return smob;
+  /* non-zero means success */
+  return 1;
+}
+
+
+SCM
+gacela_ftglCreateTextureFont (SCM file)
+{
+  FTGLfont *font_address = ftglCreateTextureFont (scm_to_locale_string (file));
+
+  if (font_address) {
+    return make_font (file, font_address);
   }
   else {
-    return SCM_UNSPECIFIED;
+    return SCM_BOOL_F;
   }
 }
 
 SCM
 gacela_ftglSetFontFaceSize (SCM font, SCM size, SCM res)
 {
-  return scm_from_int (ftglSetFontFaceSize ((FTGLfont *)scm_to_int (font), scm_to_int (size), scm_to_int (res)));
+  return scm_from_int (ftglSetFontFaceSize (get_font_address (font), scm_to_int (size), scm_to_int (res)));
 }
 
 SCM
 gacela_ftglSetFontCharMap (SCM font, SCM encoding)
 {
-  return scm_from_int (ftglSetFontCharMap ((FTGLfont *)scm_to_int (font), scm_to_int (encoding)));
+  return scm_from_int (ftglSetFontCharMap (get_font_address (font), scm_to_int (encoding)));
 }
 
 SCM
 gacela_ftglRenderFont (SCM font, SCM string, SCM mode)
 {
-  ftglRenderFont ((FTGLfont *)scm_to_int (font), scm_to_locale_string(string), scm_to_int (mode));
+  ftglRenderFont (get_font_address (font), scm_to_locale_string(string), scm_to_int (mode));
   return SCM_UNSPECIFIED;
 }
 
-SCM
-gacela_ftglDestroyFont (SCM font)
-{
-  ftglDestroyFont ((FTGLfont *)scm_to_int (font));
-  return SCM_UNSPECIFIED;
-}
 
 void*
 FTGL_register_functions (void* data)
 {
   font_tag = scm_make_smob_type ("font", sizeof (struct font));
-  //  scm_set_smob_mark (surface_tag, mark_surface);
-  //  scm_set_smob_free (surface_tag, free_surface);
-  //  scm_set_smob_print (surface_tag, print_surface);
+  scm_set_smob_mark (font_tag, mark_font);
+  scm_set_smob_free (font_tag, free_font);
+  scm_set_smob_print (font_tag, print_font);
   //  scm_set_smob_equalp (surface_tag, equalp_surface);
 
   scm_c_define ("ft_encoding_unicode", scm_from_int (ft_encoding_unicode));
@@ -97,7 +140,6 @@ FTGL_register_functions (void* data)
   scm_c_define_gsubr ("ftglSetFontFaceSize", 3, 0, 0, gacela_ftglSetFontFaceSize);
   scm_c_define_gsubr ("ftglSetFontCharMap", 2, 0, 0, gacela_ftglSetFontCharMap);
   scm_c_define_gsubr ("ftglRenderFont", 3, 0, 0, gacela_ftglRenderFont);
-  scm_c_define_gsubr ("ftglDestroyFont", 1, 0, 0, gacela_ftglDestroyFont);
 
   return NULL;
 }