diff options
| -rw-r--r-- | doc/api.texi | 56 | ||||
| -rw-r--r-- | sdl2/bindings/ttf.scm | 28 | ||||
| -rw-r--r-- | sdl2/ttf.scm | 79 |
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." |