ttf: Add more bindings.

Bindings added:

* TTF_FontAscent
* TTF_FontDescent
* TTF_FontLineSkip
* TTF_SizeUTF8
* TTF_GlyphIsProvided
* TTF_GetFontStyle
* TTF_SetFontStyle

3 files changed, 163 insertions, 0 deletions

diff --git a/doc/api.texi b/doc/api.texi
index 20c7e20..9620f87 100644
--- a/doc/api.texi
+++ b/doc/api.texi
@@ -1477,12 +1477,68 @@ Delete the memory allocated for @var{font}.
 Return the maximum height of @var{font}.
 @end deffn
 
+@deffn {Procedure} font-ascent font
+Return the maximum pixel ascent of all glyphs in @var{font}.  This can
+also be interpreted as the distance from the top of the font to the
+baseline.
+@end deffn
+
+@deffn {Procedure} font-descent font
+Return the maximum pixel descent of all glyphs in @var{font}.  This
+can also be interpreted as the distance from the baseline to the
+bottom of the font.
+@end deffn
+
+@deffn {Procedure} font-line-skip font
+Return the recommended pixel height of a line of text using
+@var{font}.
+@end deffn
+
+@deffn {Procedure} font-size-text font text
+Return a 2-element list containing the resulting surface size of the
+string @var{text} using @var{font} in the following format:
+@code{(width height)}.
+@end deffn
+
+@deffn {Procedure} font-glyph-index font char
+Return the index of the glyph for @var{char} in @var{font}, or
+@code{#f} if @var{char} is not present.
+@end deffn
+
 @deffn {Procedure} font-glyph-metrics font char
 Return a 5-element list containing the metrics of @var{char} in
 @var{font} in the following format: @code{(minx maxx miny maxy
 advance)}
 @end deffn
 
+@deffn font-style font
+Return the rendering style of @var{font} as a list that may contain
+any of the following symbols:
+
+@itemize
+@item @code{bold}
+@item @code{italic}
+@item @code{underline}
+@item @code{strikethrough}
+@end itemize
+
+The empty list is returned if none of the above styles are applied.
+@end deffn
+
+@deffn font-set-style! font style
+Set the rendering style of @var{font} to @var{style}, a list that may
+contain any of the following symbols:
+
+@itemize
+@item @code{bold}
+@item @code{italic}
+@item @code{underline}
+@item @code{strikethrough}
+@end itemize
+
+The empty list means that none of the above stylings will be used.
+@end deffn
+
 @deffn {Procedure} render-font-solid font text color
 Render @var{text}, a UTF-8 encoded string, using @var{font} and @var{color}, the
 foreground color, and return a surface containing the results.
diff --git a/sdl2/bindings/ttf.scm b/sdl2/bindings/ttf.scm
index fb3b717..1accf6c 100644
--- a/sdl2/bindings/ttf.scm
+++ b/sdl2/bindings/ttf.scm
@@ -42,6 +42,13 @@ RETURN-TYPE and accept arguments of ARG-TYPES."
   (define-public name
     (sdl-ttf-func return-type func-name arg-types)))
 
+;; Font style bitmask.
+;; If no bit is set in the mask, that means the style is "normal"
+(define-public SDL_TTF_STYLE_BOLD          #x01)
+(define-public SDL_TTF_STYLE_ITALIC        #x02)
+(define-public SDL_TTF_STYLE_UNDERLINE     #x04)
+(define-public SDL_TTF_STYLE_STRIKETHROUGH #x08)
+
 (define-foreign ttf-init
   int "TTF_Init" '())
 
@@ -57,9 +64,30 @@ RETURN-TYPE and accept arguments of ARG-TYPES."
 (define-foreign ttf-font-height
   int "TTF_FontHeight" '(*))
 
+(define-foreign ttf-font-ascent
+  int "TTF_FontAscent" '(*))
+
+(define-foreign ttf-font-descent
+  int "TTF_FontDescent" '(*))
+
+(define-foreign ttf-font-line-skip
+  int "TTF_FontLineSkip" '(*))
+
+(define-foreign ttf-size-utf8
+  int "TTF_SizeUTF8" '(* * * *))
+
+(define-foreign ttf-glyph-is-provided
+  int "TTF_GlyphIsProvided" (list '* uint16))
+
 (define-foreign ttf-glyph-metrics
   int "TTF_GlyphMetrics" (list '* uint16 '* '* '* '* '*))
 
+(define-foreign ttf-get-font-style
+  int "TTF_GetFontStyle" '(*))
+
+(define-foreign ttf-set-font-style
+  void "TTF_SetFontStyle" (list '* int))
+
 (define-foreign ttf-render-text-solid
   '* "TTF_RenderText_Solid" (list '* '* sdl-color))
 
diff --git a/sdl2/ttf.scm b/sdl2/ttf.scm
index a20ae69..f3161b2 100644
--- a/sdl2/ttf.scm
+++ b/sdl2/ttf.scm
@@ -25,6 +25,8 @@
 
 (define-module (sdl2 ttf)
   #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
   #:use-module (system foreign)
   #:use-module (sdl2)
   #:use-module ((sdl2 bindings ttf) #:prefix ffi:)
@@ -35,7 +37,14 @@
             load-font
             delete-font!
             font-height
+            font-ascent
+            font-descent
+            font-line-skip
+            font-size
+            font-glyph-index
             font-glyph-metrics
+            font-style
+            set-font-style!
 
             render-font-solid
             render-font-blended))
@@ -72,6 +81,35 @@ size is POINT-SIZE."
   "Return the maximum height of FONT."
   (ffi:ttf-font-height (unwrap-font font)))
 
+(define (font-ascent font)
+  "Return the maximum pixel ascent of all glyphs in FONT."
+  (ffi:ttf-font-ascent (unwrap-font font)))
+
+(define (font-descent font)
+  "Return the maximum pixel descent of all glyphs in FONT."
+  (ffi:ttf-font-descent (unwrap-font font)))
+
+(define (font-line-skip font)
+  "Return the recommended pixel height of a line in FONT."
+  (ffi:ttf-font-line-skip (unwrap-font font)))
+
+(define (font-size font text)
+  "Return a 2-element list containing the resulting surface size of
+the string TEXT using FONT in the following format: (width height)."
+  (let ((bv (make-s32vector 2)))
+    (if (zero? (ffi:ttf-size-utf8 (unwrap-font font)
+                                  (string->pointer text)
+                                  (bytevector->pointer bv)
+                                  (bytevector->pointer bv 4)))
+        (s32vector->list bv)
+        (sdl-error "size-utf8" "failed to get size utf8"))))
+
+(define (font-glyph-index font char)
+  "Return the index of the glyph for CHAR in FONT, or #f if CHAR is
+not present."
+  (let ((result (ffi:ttf-glyph-is-provided (unwrap-font font) (char->integer char))))
+    (if (eq? result 0) #f result)))
+
 (define (font-glyph-metrics font char)
   "Return a 5-element list containing the metrics of CHAR in FONT in
 the following format: (minx maxx miny maxy advance)"
@@ -86,6 +124,47 @@ the following format: (minx maxx miny maxy advance)"
         (s32vector->list bv)
         (sdl-error "font-glyph-metrics" "failed to get glyph metrics"))))
 
+(define (font-style font)
+  "Return the rendering style of FONT.  Return a list that may contain
+any of the following symbols:
+
+- bold
+- italic
+- underline
+- strikethrough
+
+The empty list returned if no there is no style applied."
+  (let ((bitmask (ffi:ttf-get-font-style (unwrap-font font))))
+    (filter-map (match-lambda
+                  ((sym . bit)
+                   (and (not (zero? (logand bitmask bit))) sym)))
+                `((bold          . ,ffi:SDL_TTF_STYLE_BOLD)
+                  (italic        . ,ffi:SDL_TTF_STYLE_ITALIC)
+                  (underline     . ,ffi:SDL_TTF_STYLE_UNDERLINE)
+                  (strikethrough . ,ffi:SDL_TTF_STYLE_STRIKETHROUGH)))))
+
+(define (set-font-style! font style)
+  "Set the rendering style of FONT to STYLE, a list that may contain
+any of the following symbols:
+
+- bold
+- italic
+- underline
+- strikethrough
+
+Use an empty list to set the normal style."
+  (let ((bitmask
+         (fold (lambda (flag prev)
+                 (logior prev
+                         (match flag
+                           ('bold          ffi:SDL_TTF_STYLE_BOLD)
+                           ('italic        ffi:SDL_TTF_STYLE_ITALIC)
+                           ('underline     ffi:SDL_TTF_STYLE_UNDERLINE)
+                           ('strikethrough ffi:SDL_TTF_STYLE_STRIKETHROUGH))))
+               0
+               style)))
+    (ffi:ttf-set-font-style (unwrap-font font) bitmask)))
+
 (define (render-font-solid font text color)
   "Render TEXT, a UTF-8 encoded string, using FONT and COLOR, the
 foreground color, and return a surface containing the results."