src/freetype.sgl — sigil-freetype

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.

6(define-library (freetype)

7 (import (sigil core)

8 (sigil ffi)

9 (sigil math))

11 (export

12 ;; Library handle

13 ft-lib

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

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

34 ;; Struct layouts

35 ft-face-layout

36 ft-glyph-slot-layout

38 ;; Library lifecycle

39 ft-init

40 ft-done-freetype

42 ;; Face lifecycle

43 ft-new-face

44 ft-done-face

46 ;; Face configuration

47 ft-set-char-size

48 ft-set-pixel-sizes

50 ;; Glyph loading

51 ft-get-char-index

52 ft-load-glyph

53 ft-load-char

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

67 ;; Glyph metrics

68 ft-glyph-metrics)

70 (begin

72 ;; ============================================================

73 ;; Library Loading

74 ;; ============================================================

76 (define ft-lib (c-library "libfreetype"))

78 ;; ============================================================

79 ;; Constants — Load Flags

80 ;; ============================================================

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)

92 ;; ============================================================

93 ;; Constants — Face Flags

94 ;; ============================================================

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:))))))