test/test-freetype.sgl — sigil-freetype

1;;; FreeType test suite

2;;; Requires libfreetype and a TrueType font to be installed.

4(import (sigil core)

5 (sigil test)

6 (sigil fs)

7 (sigil ffi)

8 (sigil io)

9 (sigil process)

10 (freetype))

12;; Find a test font using fc-match or common paths

13(define (find-test-font)

14 (let ((env-font (getenv "SIGIL_TEST_FONT")))

15 (if env-font

16 env-font

17 ;; Try fc-match first (works on all systems with fontconfig)

18 (let ((fc-path (guard (exn (#t #f))

19 (call-with-process "fc-match" '("--format=%{file}" "sans")

20 (lambda (p)

21 (let ((line (read-line (process-stdout p))))

22 (if (eof-object? line) #f line)))))))

23 (if (and fc-path (file-exists? fc-path))

24 fc-path

25 (error "No test font found — set SIGIL_TEST_FONT or install fontconfig"))))))

27(define test-font-path (find-test-font))

29(test-group "freetype"

31 (test-group "Library lifecycle"

32 (test "init and destroy library"

33 (let ((lib (ft-init)))

34 (assert-true (pointer? lib))

35 (ft-done-freetype lib))))

37 (test-group "Face loading"

38 (test "load face from file"

39 (let* ((lib (ft-init))

40 (face (ft-new-face lib test-font-path)))

41 (assert-true (pointer? face))

42 (ft-done-face face)

43 (ft-done-freetype lib)))

45 (test "face properties"

46 (let* ((lib (ft-init))

47 (face (ft-new-face lib test-font-path)))

48 (assert-true (string? (ft-face-family-name face)))

49 (assert-true (string? (ft-face-style-name face)))

50 (assert-true (> (ft-face-num-glyphs face) 0))

51 (assert-true (> (ft-face-units-per-em face) 0))

52 (assert-true (not (= 0 (ft-face-ascender face))))

53 (assert-true (not (= 0 (ft-face-descender face))))

54 (assert-true (> (ft-face-height face) 0))

55 (assert-true (ft-face-has-flag? face FT_FACE_FLAG_SCALABLE))

56 (ft-done-face face)

57 (ft-done-freetype lib)))

59 (test "bad font path raises error"

60 (let ((lib (ft-init)))

61 (assert-error (ft-new-face lib "/nonexistent/font.ttf"))

62 (ft-done-freetype lib))))

64 (test-group "Size configuration"

65 (test "set char size"

66 (let* ((lib (ft-init))

67 (face (ft-new-face lib test-font-path)))

68 (ft-set-char-size face (* 16 64) 0 72 72)

69 (ft-done-face face)

70 (ft-done-freetype lib)))

72 (test "set pixel sizes"

73 (let* ((lib (ft-init))

74 (face (ft-new-face lib test-font-path)))

75 (ft-set-pixel-sizes face 0 24)

76 (ft-done-face face)

77 (ft-done-freetype lib))))

79 (test-group "Glyph loading"

80 (test "get char index"

81 (let* ((lib (ft-init))

82 (face (ft-new-face lib test-font-path)))

83 (ft-set-pixel-sizes face 0 24)

84 (let ((idx (ft-get-char-index face 65))) ;; 'A'

85 (assert-true (> idx 0)))

86 (ft-done-face face)

87 (ft-done-freetype lib)))

89 (test "load char and get metrics"

90 (let* ((lib (ft-init))

91 (face (ft-new-face lib test-font-path)))

92 (ft-set-pixel-sizes face 0 24)

93 (ft-load-char face 65 FT_LOAD_DEFAULT)

94 (let ((metrics (ft-glyph-metrics face)))

95 (assert-true (dict? metrics))

96 (assert-true (> (dict-ref metrics hori-advance:) 0)))

97 (ft-done-face face)

98 (ft-done-freetype lib)))

100 (test "load glyph by index"

101 (let* ((lib (ft-init))

102 (face (ft-new-face lib test-font-path)))

103 (ft-set-pixel-sizes face 0 24)

104 (let ((idx (ft-get-char-index face 72))) ;; 'H'

105 (ft-load-glyph face idx FT_LOAD_DEFAULT)

106 (let ((metrics (ft-glyph-metrics face)))

107 (assert-true (> (dict-ref metrics width:) 0))

108 (assert-true (> (dict-ref metrics height:) 0))))

109 (ft-done-face face)

110 (ft-done-freetype lib)))))