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))