no title added by megane on Thu May 31 13:23:34 2012

diff -r 3222d1462e8d sdl.scm
--- a/sdl.scm	Thu May 31 10:55:05 2012 +0300
+++ b/sdl.scm	Thu May 31 14:22:53 2012 +0300
@@ -146,6 +146,9 @@
   ttf-font-face-is-fixed-width?
   ttf-font-face-family-name
   ttf-font-face-style-name
+  make-ttf-glyph
+  ttf-glyph-metrics
+  ttf-glyph-minx
   ttf-size-text!
   ttf-size-utf8!
   ttf-render-text-solid
@@ -602,6 +605,7 @@
 (use srfi-13)
 (use srfi-18)
 (use lolevel)
+(use extras)
 
 (foreign-declare #<<EOF
 
@@ -1432,6 +1436,49 @@
 					"if (status == 0) { rect->w = ww; rect->h = hh; }"
 					"return((status == 0));"))
 
+(define-record ttf-glyph buffer)
+
+(foreign-declare "typedef struct { int minx, maxx, miny, maxy, adv; } GlyphMetrics; ")
+(define-foreign-variable sizeof-glyph-metrics int "sizeof(GlyphMetrics)")
+
+(let ((maker make-ttf-glyph))
+  (set! make-ttf-glyph
+	(lambda () (maker (make-blob sizeof-glyph-metrics)))))
+
+(define (-sdl-unbox-ttf-glyph e)
+  (let ((p (##sys#make-pointer)))
+    (if e (##core#inline "C_pointer_to_block" p (ttf-glyph-buffer e)))
+    p))
+
+(define-foreign-type GlyphMetrics (c-pointer "GlyphMetrics")
+  -sdl-unbox-ttf-glyph)
+
+(define-record-printer (ttf-glyph o out)
+  (fprintf out "#<ttf-glyph minx: ~S maxx: ~S miny: ~S maxy: ~S adv: ~S>"
+	   (ttf-glyph-minx o)
+	   (ttf-glyph-maxx o)
+	   (ttf-glyph-miny o)
+	   (ttf-glyph-maxy o)
+	   (ttf-glyph-advance o)))
+
+(define ttf-glyph-minx (foreign-lambda* int ((GlyphMetrics o)) "return(o->minx);"))
+(define ttf-glyph-maxx (foreign-lambda* int ((GlyphMetrics o)) "return(o->maxx);"))
+(define ttf-glyph-miny (foreign-lambda* int ((GlyphMetrics o)) "return(o->miny);"))
+(define ttf-glyph-maxy (foreign-lambda* int ((GlyphMetrics o)) "return(o->maxx);"))
+(define ttf-glyph-advance (foreign-lambda* int ((GlyphMetrics o)) "return(o->adv);"))
+
+
+(define ttf-glyph-metrics
+  (foreign-lambda*
+   bool ((TTF_Font font)
+	 (unsigned-int character)
+	 (GlyphMetrics gm))
+   "int minx, maxx, miny, maxy, adv;"
+   "int status = TTF_GlyphMetrics(font, character, &minx, &maxx, &miny, &maxy, &adv);"
+   "if (status == 0) { gm->minx = minx; gm->maxx = maxx; gm->miny = miny; gm->maxy = maxy; gm->adv = adv; }"
+   "return((status == 0));")
+  )
+
 (define ttf-render-text-solid (foreign-lambda* SDL_Surface ((TTF_Font font)
 							    (c-string text)
 							    (SDL_Color fg))