summaryrefslogtreecommitdiff
path: root/sdl2/ttf.scm
diff options
context:
space:
mode:
authorGerry Agbobada <gagbobada@gmail.com>2020-05-24 14:03:34 +0200
committerDavid Thompson <dthompson2@worcester.edu>2020-10-09 09:19:01 -0400
commitdf05f9d1494d3a62a5b301f6f2db3410f21be458 (patch)
tree845643fa8202c2bae567a19eb5c74c8ddef5c655 /sdl2/ttf.scm
parent1054cbd906ced5cb38476b00700aa8c279f6e1c8 (diff)
ttf: Add more bindings.
Bindings added: * TTF_FontAscent * TTF_FontDescent * TTF_FontLineSkip * TTF_SizeUTF8 * TTF_GlyphIsProvided * TTF_GetFontStyle * TTF_SetFontStyle
Diffstat (limited to 'sdl2/ttf.scm')
-rw-r--r--sdl2/ttf.scm79
1 files changed, 79 insertions, 0 deletions
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."