You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
typesetting/pitfall/fontkit/subset.rkt

108 lines
3.0 KiB
Racket

#lang fontkit/racket
(require "clone.rkt" "ttfglyphencoder.rkt" "loca.rkt" "directory.rkt" restructure)
(provide Subset CFFSubset TTFSubset)
#|
approximates
https://github.com/devongovett/fontkit/blob/master/src/subset/Subset.js
|#
(define-subclass object% (Subset font)
(field [glyphs empty] ; list of glyph ids in the subset
[mapping (mhash)] ; mapping of glyph ids to indexes in `glyphs`
)
(send this includeGlyph 0) ; always include the missing glyph in subset
(as-methods
includeGlyph))
(define/contract (includeGlyph this glyph)
((or/c object? index?) . ->m . index?)
(let ([glyph (if (object? glyph) (· glyph id) glyph)])
(hash-ref! (· this mapping) glyph
(λ ()
;; put the new glyph at the end of `glyphs`,
;; and put its index in the mapping
(push-end-field! glyphs this glyph)
(sub1 (length (· this glyphs)))))))
(define-subclass Subset (CFFSubset)
(error 'cff-subset-unimplemented))
#|
approximates
https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js
|#
(define-subclass Subset (TTFSubset)
(field [glyphEncoder (make-object TTFGlyphEncoder)])
(field [glyf #f]
[offset #f]
[loca #f]
[hmtx #f])
(as-methods
_addGlyph
encode)
)
(define-stub-go _addGlyph)
;; tables required by PDF spec:
;; head, hhea, loca, maxp, cvt, prep, glyf, hmtx, fpgm
;; additional tables required for standalone fonts:
;; name, cmap, OS/2, post
(define/contract (encode this stream)
8 years ago
(EncodeStream? . ->m . void?)
(set-field! glyf this empty)
(set-field! offset this 0)
(set-field! loca this (mhash 'offsets empty))
(set-field! hmtx this (mhash 'metrics empty 'bearings empty))
;; include all the glyphs used in the document
(for ([gid (in-list (· this glyphs))])
(send this _addGlyph gid))
(define maxp (cloneDeep (send (· this font) _getTable 'maxp)))
8 years ago
(hash-set! maxp 'numGlyphs (length (· this glyf)))
8 years ago
;; populate the new loca table
(hash-update! (· this loca) 'offsets (λ (vals) (append vals (list (· this offset)))))
(loca-preEncode (· this loca))
8 years ago
(define head (cloneDeep (send (· this font) _getTable 'head)))
(hash-set! head 'indexToLocFormat (· this loca version))
(define hhea (cloneDeep (send (· this font) _getTable 'hhea)))
(hash-set! hhea 'numberOfMetrics (length (· this hmtx metrics)))
8 years ago
;; todo: final encoding of directory, with all tables.
(send Directory encode stream
(mhash 'tables
(mhash
'head head
#|
'hhea hhea
'loca (· this loca)
'maxp maxp
8 years ago
'cvt (send (· this font) _getTable 'cvt)
'prep (send (· this font) _getTable 'prep)
'glyf (· this glyf)
8 years ago
'hmtx (· this hmtx)
'fpgm (send (· this font) _getTable 'fpgm)
|#
)))
(report* (bytes-length (send stream dump)) (send stream dump))
8 years ago
(unfinished)
)