Commit20dd4a4bRecorded2 Mar 2026Repositorysigil-freetype
Add FreeType and HarfBuzz FFI bindings (sigil-freetype, sigil-harfbuzz)
Message
Pure-Scheme bindings using (sigil ffi) for font loading and text shaping.
sigil-freetype: Library/face lifecycle, size configuration, glyph loading, face property accessors (family name, ascender/descender, units-per-EM), and glyph metrics via c-struct-layout modeling of FTFaceRec and FTGlyphSlotRec.
sigil-harfbuzz: Buffer lifecycle, text input, direction/script/language control, shaping, and glyph info/position extraction as lists of dicts. Includes hb-tag/hb-tag-string helpers and common script constants. HarfBuzz font creation from FreeType faces via hbftfontcreatereferenced.
Replaces the placeholder sigil-pango workspace entry with sigil-freetype and sigil-harfbuzz.
Changed
package.sgl | 11 +++++
src/freetype.sgl | 385 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
test/test-freetype.sgl | 109 ++++++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 505 insertions(+)Diff
package.sgladded
@@ -0,0 +1,11 @@
+1
(package+2
name: "sigil-freetype"+3
version: "0.7.0"+4
description: "FreeType font loading bindings for Sigil"+5
url: "https://codeberg.org/sigil/sigil"+6
license: "BSD-3-Clause"+7
authors: (list "David Wilson <[email protected]>")+8
+9
dependencies: (list+10
(from-workspace name: "sigil-stdlib")+11
(from-workspace name: "sigil-ffi")))src/freetype.sgladded
@@ -0,0 +1,385 @@
+1
;;; (freetype) — FreeType font loading bindings for Sigil+2
;;;+3
;;; Pure-Scheme bindings using the dynamic FFI. No native C code required.+4
;;; Requires libfreetype.so / libfreetype.dylib to be installed on the system.+5
+6
(define-library (freetype)+7
(import (sigil core)+8
(sigil ffi)+9
(sigil math))+10
+11
(export+12
;; Library handle+13
ft-lib+14
+15
;; Constants — Load flags+16
FT_LOAD_DEFAULT+17
FT_LOAD_NO_SCALE+18
FT_LOAD_NO_HINTING+19
FT_LOAD_RENDER+20
FT_LOAD_NO_BITMAP+21
FT_LOAD_VERTICAL_LAYOUT+22
FT_LOAD_FORCE_AUTOHINT+23
FT_LOAD_NO_AUTOHINT+24
FT_LOAD_COLOR+25
+26
;; Constants — Face flags+27
FT_FACE_FLAG_SCALABLE+28
FT_FACE_FLAG_FIXED_SIZES+29
FT_FACE_FLAG_FIXED_WIDTH+30
FT_FACE_FLAG_HORIZONTAL+31
FT_FACE_FLAG_VERTICAL+32
FT_FACE_FLAG_KERNING+33
+34
;; Struct layouts+35
ft-face-layout+36
ft-glyph-slot-layout+37
+38
;; Library lifecycle+39
ft-init+40
ft-done-freetype+41
+42
;; Face lifecycle+43
ft-new-face+44
ft-done-face+45
+46
;; Face configuration+47
ft-set-char-size+48
ft-set-pixel-sizes+49
+50
;; Glyph loading+51
ft-get-char-index+52
ft-load-glyph+53
ft-load-char+54
+55
;; Face property accessors+56
ft-face-family-name+57
ft-face-style-name+58
ft-face-num-glyphs+59
ft-face-flags+60
ft-face-has-flag?+61
ft-face-units-per-em+62
ft-face-ascender+63
ft-face-descender+64
ft-face-height+65
ft-face-glyph+66
+67
;; Glyph metrics+68
ft-glyph-metrics)+69
+70
(begin+71
+72
;; ============================================================+73
;; Library Loading+74
;; ============================================================+75
+76
(define ft-lib (c-library "libfreetype"))+77
+78
;; ============================================================+79
;; Constants — Load Flags+80
;; ============================================================+81
+82
(define FT_LOAD_DEFAULT 0)+83
(define FT_LOAD_NO_SCALE 1)+84
(define FT_LOAD_NO_HINTING 2)+85
(define FT_LOAD_RENDER 4)+86
(define FT_LOAD_NO_BITMAP 8)+87
(define FT_LOAD_VERTICAL_LAYOUT 16)+88
(define FT_LOAD_FORCE_AUTOHINT 32)+89
(define FT_LOAD_NO_AUTOHINT #x8000)+90
(define FT_LOAD_COLOR #x100000)+91
+92
;; ============================================================+93
;; Constants — Face Flags+94
;; ============================================================+95
+96
(define FT_FACE_FLAG_SCALABLE 1)+97
(define FT_FACE_FLAG_FIXED_SIZES 2)+98
(define FT_FACE_FLAG_FIXED_WIDTH 4)+99
(define FT_FACE_FLAG_HORIZONTAL 16)+100
(define FT_FACE_FLAG_VERTICAL 32)+101
(define FT_FACE_FLAG_KERNING 64)+102
+103
;; ============================================================+104
;; Struct Layouts+105
;; ============================================================+106
+107
;; FT_FaceRec_ — modeled with flattened nested structs.+108
;; FT_Generic = 2 pointers, FT_BBox = 4 FT_Pos (long).+109
;; c-struct-layout handles alignment automatically, matching C layout.+110
(define ft-face-layout+111
(c-struct-layout+112
num-faces: ffi/long+113
face-index: ffi/long+114
face-flags: ffi/long+115
style-flags: ffi/long+116
num-glyphs: ffi/long+117
family-name: ffi/pointer+118
style-name: ffi/pointer+119
num-fixed-sizes: ffi/int+120
available-sizes: ffi/pointer+121
num-charmaps: ffi/int+122
charmaps: ffi/pointer+123
generic-data: ffi/pointer+124
generic-finalizer: ffi/pointer+125
bbox-x-min: ffi/long+126
bbox-y-min: ffi/long+127
bbox-x-max: ffi/long+128
bbox-y-max: ffi/long+129
units-per-em: ffi/uint16+130
ascender: ffi/int16+131
descender: ffi/int16+132
height: ffi/int16+133
max-advance-width: ffi/int16+134
max-advance-height: ffi/int16+135
underline-position: ffi/int16+136
underline-thickness: ffi/int16+137
glyph: ffi/pointer+138
size: ffi/pointer+139
charmap: ffi/pointer))+140
+141
;; FT_GlyphSlotRec_ — partial layout up through metrics.+142
;; FT_Glyph_Metrics has 8 FT_Pos (long) fields.+143
(define ft-glyph-slot-layout+144
(c-struct-layout+145
library: ffi/pointer+146
face: ffi/pointer+147
next: ffi/pointer+148
glyph-index: ffi/uint+149
generic-data: ffi/pointer+150
generic-finalizer: ffi/pointer+151
metrics-width: ffi/long+152
metrics-height: ffi/long+153
metrics-hori-bearing-x: ffi/long+154
metrics-hori-bearing-y: ffi/long+155
metrics-hori-advance: ffi/long+156
metrics-vert-bearing-x: ffi/long+157
metrics-vert-bearing-y: ffi/long+158
metrics-vert-advance: ffi/long))+159
+160
;; ============================================================+161
;; Finalizer Pointers (looked up once)+162
;; ============================================================+163
+164
(define %ft-done-face-ptr (c-symbol ft-lib "FT_Done_Face"))+165
(define %ft-done-freetype-ptr (c-symbol ft-lib "FT_Done_FreeType"))+166
+167
;; ============================================================+168
;; Raw Function Bindings+169
;; ============================================================+170
+171
(define %ft-init-freetype+172
(c-function ft-lib "FT_Init_FreeType"+173
(list ffi/pointer) ffi/int))+174
+175
(define %ft-new-face+176
(c-function ft-lib "FT_New_Face"+177
(list ffi/pointer ffi/string ffi/long ffi/pointer) ffi/int))+178
+179
(define %ft-set-char-size+180
(c-function ft-lib "FT_Set_Char_Size"+181
(list ffi/pointer ffi/long ffi/long ffi/uint ffi/uint) ffi/int))+182
+183
(define %ft-set-pixel-sizes+184
(c-function ft-lib "FT_Set_Pixel_Sizes"+185
(list ffi/pointer ffi/uint ffi/uint) ffi/int))+186
+187
(define %ft-get-char-index+188
(c-function ft-lib "FT_Get_Char_Index"+189
(list ffi/pointer ffi/ulong) ffi/uint))+190
+191
(define %ft-load-glyph+192
(c-function ft-lib "FT_Load_Glyph"+193
(list ffi/pointer ffi/uint ffi/int) ffi/int))+194
+195
(define %ft-load-char+196
(c-function ft-lib "FT_Load_Char"+197
(list ffi/pointer ffi/ulong ffi/int) ffi/int))+198
+199
(define %ft-done-face+200
(c-function ft-lib "FT_Done_Face"+201
(list ffi/pointer) ffi/int))+202
+203
(define %ft-done-freetype+204
(c-function ft-lib "FT_Done_FreeType"+205
(list ffi/pointer) ffi/int))+206
+207
;; ============================================================+208
;; Public API — Library Lifecycle+209
;; ============================================================+210
+211
;;; Initialize the FreeType library, returning a library handle.+212
(define (ft-init)+213
(: -> pointer?)+214
(let ((out (c-alloc (c-sizeof ffi/pointer))))+215
(let ((err (%ft-init-freetype out)))+216
(if (= err 0)+217
(let ((lib (pointer-ref out ffi/pointer 0)))+218
(c-free out)+219
(set-pointer-finalizer! lib %ft-done-freetype-ptr)+220
lib)+221
(begin+222
(c-free out)+223
(error "FT_Init_FreeType failed" err))))))+224
+225
;;; Destroy the FreeType library handle.+226
(define (ft-done-freetype lib)+227
(: pointer? -> void?)+228
(set-pointer-finalizer! lib #f)+229
(%ft-done-freetype lib))+230
+231
;; ============================================================+232
;; Public API — Face Lifecycle+233
;; ============================================================+234
+235
;;; Load a font face from a file path.+236
;;;+237
;;; INDEX defaults to 0 (first face in the file).+238
(define (ft-new-face lib path . rest)+239
(: pointer? string? -> pointer?)+240
(let ((face-index (if (pair? rest) (car rest) 0))+241
(out (c-alloc (c-sizeof ffi/pointer))))+242
(let ((err (%ft-new-face lib path face-index out)))+243
(if (= err 0)+244
(let ((face (pointer-ref out ffi/pointer 0)))+245
(c-free out)+246
(set-pointer-finalizer! face %ft-done-face-ptr)+247
face)+248
(begin+249
(c-free out)+250
(error "FT_New_Face failed" err))))))+251
+252
;;; Destroy a face, freeing its resources.+253
(define (ft-done-face face)+254
(: pointer? -> void?)+255
(set-pointer-finalizer! face #f)+256
(%ft-done-face face))+257
+258
;; ============================================================+259
;; Public API — Face Configuration+260
;; ============================================================+261
+262
;;; Set the character size in 26.6 fractional points.+263
;;;+264
;;; Width and height are in 1/64th of a point (multiply point size by 64).+265
;;; Pass 0 for width to use height for both dimensions.+266
(define (ft-set-char-size face char-width char-height horz-res vert-res)+267
(: pointer? integer? integer? integer? integer? -> void?)+268
(let ((err (%ft-set-char-size face char-width char-height horz-res vert-res)))+269
(unless (= err 0)+270
(error "FT_Set_Char_Size failed" err))))+271
+272
;;; Set the pixel size for a face.+273
;;;+274
;;; Pass 0 for width to use height for both dimensions.+275
(define (ft-set-pixel-sizes face width height)+276
(: pointer? integer? integer? -> void?)+277
(let ((err (%ft-set-pixel-sizes face width height)))+278
(unless (= err 0)+279
(error "FT_Set_Pixel_Sizes failed" err))))+280
+281
;; ============================================================+282
;; Public API — Glyph Loading+283
;; ============================================================+284
+285
;;; Get the glyph index for a Unicode character code.+286
;;;+287
;;; Returns 0 if the character is not found in the font.+288
(define (ft-get-char-index face charcode)+289
(: pointer? integer? -> integer?)+290
(%ft-get-char-index face charcode))+291
+292
;;; Load a glyph by index into the face's glyph slot.+293
(define (ft-load-glyph face glyph-index load-flags)+294
(: pointer? integer? integer? -> void?)+295
(let ((err (%ft-load-glyph face glyph-index load-flags)))+296
(unless (= err 0)+297
(error "FT_Load_Glyph failed" err))))+298
+299
;;; Load a glyph by character code into the face's glyph slot.+300
;;;+301
;;; Convenience function equivalent to ft-get-char-index + ft-load-glyph.+302
(define (ft-load-char face charcode load-flags)+303
(: pointer? integer? integer? -> void?)+304
(let ((err (%ft-load-char face charcode load-flags)))+305
(unless (= err 0)+306
(error "FT_Load_Char failed" err))))+307
+308
;; ============================================================+309
;; Public API — Face Property Accessors+310
;; ============================================================+311
+312
;;; Get the family name of a face as a string.+313
(define (ft-face-family-name face)+314
(: pointer? -> string?)+315
(pointer->string (c-struct-ref face ft-face-layout family-name:)))+316
+317
;;; Get the style name of a face as a string.+318
(define (ft-face-style-name face)+319
(: pointer? -> string?)+320
(pointer->string (c-struct-ref face ft-face-layout style-name:)))+321
+322
;;; Get the number of glyphs in a face.+323
(define (ft-face-num-glyphs face)+324
(: pointer? -> integer?)+325
(c-struct-ref face ft-face-layout num-glyphs:))+326
+327
;;; Get the face flags bitmask.+328
(define (ft-face-flags face)+329
(: pointer? -> integer?)+330
(c-struct-ref face ft-face-layout face-flags:))+331
+332
;;; Check if a face has a specific flag set.+333
(define (ft-face-has-flag? face flag)+334
(: pointer? integer? -> boolean?)+335
(not (= 0 (bitwise-and (ft-face-flags face) flag))))+336
+337
;;; Get units-per-EM for the face.+338
(define (ft-face-units-per-em face)+339
(: pointer? -> integer?)+340
(c-struct-ref face ft-face-layout units-per-em:))+341
+342
;;; Get the typographic ascender in font units.+343
(define (ft-face-ascender face)+344
(: pointer? -> integer?)+345
(c-struct-ref face ft-face-layout ascender:))+346
+347
;;; Get the typographic descender in font units (typically negative).+348
(define (ft-face-descender face)+349
(: pointer? -> integer?)+350
(c-struct-ref face ft-face-layout descender:))+351
+352
;;; Get the recommended line height in font units.+353
(define (ft-face-height face)+354
(: pointer? -> integer?)+355
(c-struct-ref face ft-face-layout height:))+356
+357
;;; Get the glyph slot pointer from a face.+358
;;;+359
;;; The glyph slot is populated after calling ft-load-char or ft-load-glyph.+360
(define (ft-face-glyph face)+361
(: pointer? -> pointer?)+362
(c-struct-ref face ft-face-layout glyph:))+363
+364
;; ============================================================+365
;; Public API — Glyph Metrics+366
;; ============================================================+367
+368
;;; Get metrics from the face's current glyph slot as a dict.+369
;;;+370
;;; Returns a dict with keys: width:, height:, hori-bearing-x:,+371
;;; hori-bearing-y:, hori-advance:, vert-bearing-x:, vert-bearing-y:,+372
;;; vert-advance:. All values are in 26.6 fractional pixel format+373
;;; (divide by 64 for pixels).+374
(define (ft-glyph-metrics face)+375
(: pointer? -> any?)+376
(let ((slot (ft-face-glyph face)))+377
(dict+378
width: (c-struct-ref slot ft-glyph-slot-layout metrics-width:)+379
height: (c-struct-ref slot ft-glyph-slot-layout metrics-height:)+380
hori-bearing-x: (c-struct-ref slot ft-glyph-slot-layout metrics-hori-bearing-x:)+381
hori-bearing-y: (c-struct-ref slot ft-glyph-slot-layout metrics-hori-bearing-y:)+382
hori-advance: (c-struct-ref slot ft-glyph-slot-layout metrics-hori-advance:)+383
vert-bearing-x: (c-struct-ref slot ft-glyph-slot-layout metrics-vert-bearing-x:)+384
vert-bearing-y: (c-struct-ref slot ft-glyph-slot-layout metrics-vert-bearing-y:)+385
vert-advance: (c-struct-ref slot ft-glyph-slot-layout metrics-vert-advance:))))))test/test-freetype.sgladded
@@ -0,0 +1,109 @@
+1
;;; FreeType test suite+2
;;; Requires libfreetype and a TrueType font to be installed.+3
+4
(import (sigil core)+5
(sigil test)+6
(sigil ffi)+7
(sigil io)+8
(sigil process)+9
(freetype))+10
+11
;; Find a test font using fc-match or common paths+12
(define (find-test-font)+13
(let ((env-font (getenv "SIGIL_TEST_FONT")))+14
(if env-font+15
env-font+16
;; Try fc-match first (works on all systems with fontconfig)+17
(let ((fc-path (guard (exn (#t #f))+18
(call-with-process "fc-match" '("--format=%{file}" "sans")+19
(lambda (p)+20
(let ((line (read-line (process-stdout p))))+21
(if (eof-object? line) #f line)))))))+22
(if (and fc-path (file-exists? fc-path))+23
fc-path+24
(error "No test font found — set SIGIL_TEST_FONT or install fontconfig"))))))+25
+26
(define test-font-path (find-test-font))+27
+28
(test-group "freetype"+29
+30
(test-group "Library lifecycle"+31
(test "init and destroy library"+32
(let ((lib (ft-init)))+33
(assert-true (pointer? lib))+34
(ft-done-freetype lib))))+35
+36
(test-group "Face loading"+37
(test "load face from file"+38
(let* ((lib (ft-init))+39
(face (ft-new-face lib test-font-path)))+40
(assert-true (pointer? face))+41
(ft-done-face face)+42
(ft-done-freetype lib)))+43
+44
(test "face properties"+45
(let* ((lib (ft-init))+46
(face (ft-new-face lib test-font-path)))+47
(assert-true (string? (ft-face-family-name face)))+48
(assert-true (string? (ft-face-style-name face)))+49
(assert-true (> (ft-face-num-glyphs face) 0))+50
(assert-true (> (ft-face-units-per-em face) 0))+51
(assert-true (not (= 0 (ft-face-ascender face))))+52
(assert-true (not (= 0 (ft-face-descender face))))+53
(assert-true (> (ft-face-height face) 0))+54
(assert-true (ft-face-has-flag? face FT_FACE_FLAG_SCALABLE))+55
(ft-done-face face)+56
(ft-done-freetype lib)))+57
+58
(test "bad font path raises error"+59
(let ((lib (ft-init)))+60
(assert-error (ft-new-face lib "/nonexistent/font.ttf"))+61
(ft-done-freetype lib))))+62
+63
(test-group "Size configuration"+64
(test "set char size"+65
(let* ((lib (ft-init))+66
(face (ft-new-face lib test-font-path)))+67
(ft-set-char-size face (* 16 64) 0 72 72)+68
(ft-done-face face)+69
(ft-done-freetype lib)))+70
+71
(test "set pixel sizes"+72
(let* ((lib (ft-init))+73
(face (ft-new-face lib test-font-path)))+74
(ft-set-pixel-sizes face 0 24)+75
(ft-done-face face)+76
(ft-done-freetype lib))))+77
+78
(test-group "Glyph loading"+79
(test "get char index"+80
(let* ((lib (ft-init))+81
(face (ft-new-face lib test-font-path)))+82
(ft-set-pixel-sizes face 0 24)+83
(let ((idx (ft-get-char-index face 65))) ;; 'A'+84
(assert-true (> idx 0)))+85
(ft-done-face face)+86
(ft-done-freetype lib)))+87
+88
(test "load char and get metrics"+89
(let* ((lib (ft-init))+90
(face (ft-new-face lib test-font-path)))+91
(ft-set-pixel-sizes face 0 24)+92
(ft-load-char face 65 FT_LOAD_DEFAULT)+93
(let ((metrics (ft-glyph-metrics face)))+94
(assert-true (dict? metrics))+95
(assert-true (> (dict-ref metrics hori-advance:) 0)))+96
(ft-done-face face)+97
(ft-done-freetype lib)))+98
+99
(test "load glyph by index"+100
(let* ((lib (ft-init))+101
(face (ft-new-face lib test-font-path)))+102
(ft-set-pixel-sizes face 0 24)+103
(let ((idx (ft-get-char-index face 72))) ;; 'H'+104
(ft-load-glyph face idx FT_LOAD_DEFAULT)+105
(let ((metrics (ft-glyph-metrics face)))+106
(assert-true (> (dict-ref metrics width:) 0))+107
(assert-true (> (dict-ref metrics height:) 0))))+108
(ft-done-face face)+109
(ft-done-freetype lib)))))