summaryrefslogtreecommitdiff
path: root/sdl2
diff options
context:
space:
mode:
Diffstat (limited to 'sdl2')
-rw-r--r--sdl2/bindings/ttf.scm28
-rw-r--r--sdl2/ttf.scm79
2 files changed, 107 insertions, 0 deletions
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."