src/harfbuzz.sgl — sigil-harfbuzz

1;;; (harfbuzz) — HarfBuzz text shaping bindings for Sigil

2;;;

3;;; Pure-Scheme bindings using the dynamic FFI. No native C code required.

4;;; Requires libharfbuzz.so / libharfbuzz.dylib to be installed on the system.

6(define-library (harfbuzz)

7 (import (sigil core)

8 (sigil ffi)

9 (sigil math))

11 (export

12 ;; Library handle

13 hb-lib

15 ;; Constants — Direction

16 HB_DIRECTION_INVALID

17 HB_DIRECTION_LTR

18 HB_DIRECTION_RTL

19 HB_DIRECTION_TTB

20 HB_DIRECTION_BTT

22 ;; Constants — Scripts

23 HB_SCRIPT_COMMON

24 HB_SCRIPT_LATIN

25 HB_SCRIPT_ARABIC

26 HB_SCRIPT_HAN

27 HB_SCRIPT_CYRILLIC

28 HB_SCRIPT_DEVANAGARI

29 HB_SCRIPT_GREEK

30 HB_SCRIPT_HANGUL

31 HB_SCRIPT_HIRAGANA

32 HB_SCRIPT_KATAKANA

33 HB_SCRIPT_THAI

34 HB_SCRIPT_HEBREW

36 ;; Tag helpers

37 hb-tag

38 hb-tag-string

40 ;; Struct layouts

41 hb-glyph-info-layout

42 hb-glyph-position-layout

44 ;; Buffer lifecycle

45 hb-buffer-create

46 hb-buffer-destroy

48 ;; Buffer configuration

49 hb-buffer-add-utf8

50 hb-buffer-set-direction

51 hb-buffer-set-script

52 hb-buffer-set-language

53 hb-buffer-guess-segment-properties

55 ;; Shaping

56 hb-shape

58 ;; Glyph access

59 hb-buffer-get-length

60 hb-buffer-get-glyph-infos

61 hb-buffer-get-glyph-positions

63 ;; Font lifecycle

64 hb-ft-font-create

65 hb-font-destroy)

67 (begin

69 ;; ============================================================

70 ;; Library Loading

71 ;; ============================================================

73 (define hb-lib (c-library "libharfbuzz"))

75 ;; ============================================================

76 ;; Constants — Direction

77 ;; ============================================================

79 (define HB_DIRECTION_INVALID 0)

80 (define HB_DIRECTION_LTR 4)

81 (define HB_DIRECTION_RTL 5)

82 (define HB_DIRECTION_TTB 6)

83 (define HB_DIRECTION_BTT 7)

85 ;; ============================================================

86 ;; Tag Helpers

87 ;; ============================================================

89 ;;; Create a HarfBuzz 4-byte tag from four integer byte values.

90 (define (hb-tag c1 c2 c3 c4)

91 (: integer? integer? integer? integer? -> integer?)

92 (bitwise-ior

93 (arithmetic-shift (bitwise-and c1 #xFF) 24)

94 (arithmetic-shift (bitwise-and c2 #xFF) 16)

95 (arithmetic-shift (bitwise-and c3 #xFF) 8)

96 (bitwise-and c4 #xFF)))

98 ;;; Create a HarfBuzz tag from a 4-character string.

99 ;;;

100 ;;; Examples:

101 ;;; ```scheme

102 ;;; (hb-tag-string "Latn") ; => Latin script tag

103 ;;; ```

104 (define (hb-tag-string s)

105 (: string? -> integer?)

106 (hb-tag (char->integer (string-ref s 0))

107 (char->integer (string-ref s 1))

108 (char->integer (string-ref s 2))

109 (char->integer (string-ref s 3))))

110

111 ;; ============================================================

112 ;; Constants — Scripts (ISO 15924 4-char tags)

113 ;; ============================================================

114

115 (define HB_SCRIPT_COMMON (hb-tag-string "Zyyy"))

116 (define HB_SCRIPT_LATIN (hb-tag-string "Latn"))

117 (define HB_SCRIPT_ARABIC (hb-tag-string "Arab"))

118 (define HB_SCRIPT_HAN (hb-tag-string "Hani"))

119 (define HB_SCRIPT_CYRILLIC (hb-tag-string "Cyrl"))

120 (define HB_SCRIPT_DEVANAGARI (hb-tag-string "Deva"))

121 (define HB_SCRIPT_GREEK (hb-tag-string "Grek"))

122 (define HB_SCRIPT_HANGUL (hb-tag-string "Hang"))

123 (define HB_SCRIPT_HIRAGANA (hb-tag-string "Hira"))

124 (define HB_SCRIPT_KATAKANA (hb-tag-string "Kana"))

125 (define HB_SCRIPT_THAI (hb-tag-string "Thai"))

126 (define HB_SCRIPT_HEBREW (hb-tag-string "Hebr"))

127

128 ;; ============================================================

129 ;; Struct Layouts

130 ;; ============================================================

131

132 ;; hb_glyph_info_t — 5 x uint32 = 20 bytes

133 (define hb-glyph-info-layout

134 (c-struct-layout

135 codepoint: ffi/uint32

136 mask: ffi/uint32

137 cluster: ffi/uint32

138 var1: ffi/uint32

139 var2: ffi/uint32))

140

141 ;; hb_glyph_position_t — 4 x int32 + 1 x uint32 = 20 bytes

142 (define hb-glyph-position-layout

143 (c-struct-layout

144 x-advance: ffi/int32

145 y-advance: ffi/int32

146 x-offset: ffi/int32

147 y-offset: ffi/int32

148 var: ffi/uint32))

149

150 ;; ============================================================

151 ;; Finalizer Pointers (looked up once)

152 ;; ============================================================

153

154 (define %hb-buffer-destroy-ptr (c-symbol hb-lib "hb_buffer_destroy"))

155 (define %hb-font-destroy-ptr (c-symbol hb-lib "hb_font_destroy"))

156

157 ;; ============================================================

158 ;; Raw Function Bindings

159 ;; ============================================================

160

161 (define %hb-buffer-create

162 (c-function hb-lib "hb_buffer_create" '() ffi/pointer))

163

164 (define %hb-buffer-destroy

165 (c-function hb-lib "hb_buffer_destroy"

166 (list ffi/pointer) ffi/void))

167

168 (define %hb-buffer-add-utf8

169 (c-function hb-lib "hb_buffer_add_utf8"

170 (list ffi/pointer ffi/string ffi/int ffi/uint ffi/int) ffi/void))

171

172 (define %hb-buffer-set-direction

173 (c-function hb-lib "hb_buffer_set_direction"

174 (list ffi/pointer ffi/int) ffi/void))

175

176 (define %hb-buffer-set-script

177 (c-function hb-lib "hb_buffer_set_script"

178 (list ffi/pointer ffi/uint32) ffi/void))

179

180 (define %hb-buffer-set-language

181 (c-function hb-lib "hb_buffer_set_language"

182 (list ffi/pointer ffi/pointer) ffi/void))

183

184 (define %hb-buffer-guess-segment-properties

185 (c-function hb-lib "hb_buffer_guess_segment_properties"

186 (list ffi/pointer) ffi/void))

187

188 (define %hb-shape

189 (c-function hb-lib "hb_shape"

190 (list ffi/pointer ffi/pointer ffi/pointer ffi/uint) ffi/void))

191

192 (define %hb-buffer-get-glyph-infos

193 (c-function hb-lib "hb_buffer_get_glyph_infos"

194 (list ffi/pointer ffi/pointer) ffi/pointer))

195

196 (define %hb-buffer-get-glyph-positions

197 (c-function hb-lib "hb_buffer_get_glyph_positions"

198 (list ffi/pointer ffi/pointer) ffi/pointer))

199

200 (define %hb-buffer-get-length

201 (c-function hb-lib "hb_buffer_get_length"

202 (list ffi/pointer) ffi/uint))

203

204 (define %hb-ft-font-create-referenced

205 (c-function hb-lib "hb_ft_font_create_referenced"

206 (list ffi/pointer) ffi/pointer))

207

208 (define %hb-font-destroy

209 (c-function hb-lib "hb_font_destroy"

210 (list ffi/pointer) ffi/void))

211

212 (define %hb-language-from-string

213 (c-function hb-lib "hb_language_from_string"

214 (list ffi/string ffi/int) ffi/pointer))

215

216 ;; ============================================================

217 ;; Public API — Buffer Lifecycle

218 ;; ============================================================

219

220 ;;; Create a new HarfBuzz shaping buffer.

221 (define (hb-buffer-create)

222 (: -> pointer?)

223 (let ((buf (%hb-buffer-create)))

224 (set-pointer-finalizer! buf %hb-buffer-destroy-ptr)

225 buf))

226

227 ;;; Destroy a shaping buffer, freeing its resources.

228 (define (hb-buffer-destroy buf)

229 (: pointer? -> void?)

230 (set-pointer-finalizer! buf #f)

231 (%hb-buffer-destroy buf))

232

233 ;; ============================================================

234 ;; Public API — Buffer Configuration

235 ;; ============================================================

236

237 ;;; Add UTF-8 text to a shaping buffer.

238 (define (hb-buffer-add-utf8 buf text)

239 (: pointer? string? -> void?)

240 (%hb-buffer-add-utf8 buf text -1 0 -1))

241

242 ;;; Set the text direction for a buffer.

243 ;;;

244 ;;; Use HB_DIRECTION_LTR, HB_DIRECTION_RTL, etc.

245 (define (hb-buffer-set-direction buf direction)

246 (: pointer? integer? -> void?)

247 (%hb-buffer-set-direction buf direction))

248

249 ;;; Set the script for a buffer.

250 ;;;

251 ;;; Use script constants like HB_SCRIPT_LATIN, or create custom

252 ;;; tags with hb-tag-string.

253 (define (hb-buffer-set-script buf script)

254 (: pointer? integer? -> void?)

255 (%hb-buffer-set-script buf script))

256

257 ;;; Set the language for a buffer from a BCP 47 string.

258 ;;;

259 ;;; Examples:

260 ;;; ```scheme

261 ;;; (hb-buffer-set-language buf "en")

262 ;;; (hb-buffer-set-language buf "ar")

263 ;;; ```

264 (define (hb-buffer-set-language buf lang-str)

265 (: pointer? string? -> void?)

266 (%hb-buffer-set-language buf (%hb-language-from-string lang-str -1)))

267

268 ;;; Auto-detect direction, script, and language from buffer content.

269 ;;;

270 ;;; Convenience function — call after adding text but before shaping.

271 (define (hb-buffer-guess-segment-properties buf)

272 (: pointer? -> void?)

273 (%hb-buffer-guess-segment-properties buf))

274

275 ;; ============================================================

276 ;; Public API — Shaping

277 ;; ============================================================

278

279 ;;; Shape text in a buffer using a font.

280 ;;;

281 ;;; Converts Unicode content in the buffer to positioned glyphs.

282 ;;; Call hb-buffer-get-glyph-infos and hb-buffer-get-glyph-positions

283 ;;; to retrieve the results.

284 (define (hb-shape font buf)

285 (: pointer? pointer? -> void?)

286 (%hb-shape font buf #f 0))

287

288 ;; ============================================================

289 ;; Public API — Glyph Access

290 ;; ============================================================

291

292 ;;; Get the number of glyphs in a shaped buffer.

293 (define (hb-buffer-get-length buf)

294 (: pointer? -> integer?)

295 (%hb-buffer-get-length buf))

296

297 ;;; Get glyph info from a shaped buffer as a list of dicts.

298 ;;;

299 ;;; Each dict has keys: codepoint: (glyph index after shaping),

300 ;;; cluster: (index in original text).

301 (define (hb-buffer-get-glyph-infos buf)

302 (: pointer? -> list?)

303 (let* ((len-buf (c-alloc (c-sizeof ffi/uint)))

304 (infos-ptr (%hb-buffer-get-glyph-infos buf len-buf))

305 (len (pointer-ref len-buf ffi/uint 0))

306 (info-size (c-struct-size hb-glyph-info-layout)))

307 (c-free len-buf)

308 (let loop ((i 0) (result '()))

309 (if (>= i len)

310 (reverse result)

311 (let ((entry (pointer+ infos-ptr (* i info-size))))

312 (loop (+ i 1)

313 (cons (dict

314 codepoint: (c-struct-ref entry hb-glyph-info-layout codepoint:)

315 cluster: (c-struct-ref entry hb-glyph-info-layout cluster:))

316 result)))))))

317

318 ;;; Get glyph positions from a shaped buffer as a list of dicts.

319 ;;;

320 ;;; Each dict has keys: x-advance:, y-advance:, x-offset:, y-offset:.

321 ;;; Values are in font units (typically 26.6 fixed-point).

322 (define (hb-buffer-get-glyph-positions buf)

323 (: pointer? -> list?)

324 (let* ((len-buf (c-alloc (c-sizeof ffi/uint)))

325 (pos-ptr (%hb-buffer-get-glyph-positions buf len-buf))

326 (len (pointer-ref len-buf ffi/uint 0))

327 (pos-size (c-struct-size hb-glyph-position-layout)))

328 (c-free len-buf)

329 (let loop ((i 0) (result '()))

330 (if (>= i len)

331 (reverse result)

332 (let ((entry (pointer+ pos-ptr (* i pos-size))))

333 (loop (+ i 1)

334 (cons (dict

335 x-advance: (c-struct-ref entry hb-glyph-position-layout x-advance:)

336 y-advance: (c-struct-ref entry hb-glyph-position-layout y-advance:)

337 x-offset: (c-struct-ref entry hb-glyph-position-layout x-offset:)

338 y-offset: (c-struct-ref entry hb-glyph-position-layout y-offset:))

339 result)))))))

340

341 ;; ============================================================

342 ;; Public API — Font Lifecycle

343 ;; ============================================================

344

345 ;;; Create a HarfBuzz font from a FreeType face.

346 ;;;

347 ;;; The FreeType face must have its size set before calling this.

348 ;;; Uses hb_ft_font_create_referenced which manages FT_Face lifetime.

349 (define (hb-ft-font-create ft-face)

350 (: pointer? -> pointer?)

351 (let ((font (%hb-ft-font-create-referenced ft-face)))

352 (set-pointer-finalizer! font %hb-font-destroy-ptr)

353 font))

354

355 ;;; Destroy a HarfBuzz font, freeing its resources.

356 (define (hb-font-destroy font)

357 (: pointer? -> void?)

358 (set-pointer-finalizer! font #f)

359 (%hb-font-destroy font))))