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.
92 lines
2.9 KiB
Racket
92 lines
2.9 KiB
Racket
#lang racket/base
|
|
(require
|
|
(for-syntax racket/base)
|
|
racket/class
|
|
racket/file
|
|
sugar/unstable/dict
|
|
"afm-font.rkt"
|
|
"font.rkt"
|
|
"core.rkt"
|
|
"reference.rkt"
|
|
fontland
|
|
racket/runtime-path)
|
|
(provide isStandardFont standard-fonts StandardFont)
|
|
|
|
(define StandardFont
|
|
(class PDFFont
|
|
(init-field name id)
|
|
(field [font (make-object AFMFont
|
|
((hash-ref standard-fonts name
|
|
(λ () (raise-argument-error 'PDFFont "valid font name" name)))))])
|
|
(super-new [ascender (get-field ascender font)]
|
|
[descender (get-field descender font)]
|
|
[bbox (get-field bbox font)]
|
|
[line-gap (get-field line-gap font)])
|
|
|
|
(inherit-field [@ascender ascender]
|
|
[@descender descender]
|
|
[@line-gap line-gap]
|
|
[@bbox bbox]
|
|
[@dictionary dictionary])
|
|
|
|
(define/override (embed)
|
|
(set-$ref-payload! @dictionary
|
|
(mhash 'Type 'Font
|
|
'BaseFont (string->symbol name)
|
|
'Subtype 'Type1
|
|
'Encoding 'WinAnsiEncoding))
|
|
(ref-end @dictionary))
|
|
|
|
(define/override (encode text [options #f])
|
|
(define encoded (send font encode-text text))
|
|
(define glyphs (send font glyphs-for-string text))
|
|
(define advances (send font advances-for-glyphs glyphs))
|
|
(define positions
|
|
(for/list ([glyph (in-list glyphs)]
|
|
[advance (in-list advances)])
|
|
(+glyph-position advance 0 0 0 (send font glyph-width glyph))))
|
|
(list encoded positions))
|
|
|
|
(define/override (string-width str size [options #f])
|
|
(define glyphs (send font glyphs-for-string str))
|
|
(define advances (send font advances-for-glyphs glyphs))
|
|
(define width (apply + advances))
|
|
(define scale (/ size 1000.0))
|
|
(* width scale))))
|
|
|
|
(module+ test
|
|
(define stdfont (make-object StandardFont "Helvetica" #f)))
|
|
|
|
(define (isStandardFont name) (hash-ref standard-fonts name #f))
|
|
|
|
(define-syntax (define-afm-table stx)
|
|
(syntax-case stx ()
|
|
[(_ HASH-ID FONT-ID ...)
|
|
(with-syntax ([(PATH-STR ...) (map (λ (stx) (format "data/~a.afm" (syntax->datum stx))) (syntax->list #'(FONT-ID ...)))])
|
|
#'(begin (define-runtime-path FONT-ID PATH-STR) ...
|
|
(define HASH-ID (make-hash (list (cons (symbol->string 'FONT-ID) (procedure-rename (λ () (open-input-file FONT-ID)) 'FONT-ID)) ...)))))]))
|
|
|
|
(define-afm-table standard-fonts
|
|
Courier-Bold
|
|
Courier-BoldOblique
|
|
Courier-Oblique
|
|
Courier
|
|
Helvetica-Bold
|
|
Helvetica-BoldOblique
|
|
Helvetica-Oblique
|
|
Helvetica
|
|
Symbol
|
|
Times-Bold
|
|
Times-BoldItalic
|
|
Times-Italic
|
|
Times-Roman
|
|
ZapfDingbats)
|
|
|
|
|
|
(module+ test
|
|
(require rackunit)
|
|
(check-true (and (isStandardFont "Helvetica") #t))
|
|
(check-true (and (isStandardFont "Courier") #t))
|
|
(check-true (and (isStandardFont "ZapfDingbats") #t))
|
|
(check-false (isStandardFont "Not A Font Name")))
|