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.
93 lines
3.0 KiB
Racket
93 lines
3.0 KiB
Racket
#lang racket/base
|
|
(require
|
|
(for-syntax racket/base)
|
|
racket/class
|
|
racket/file
|
|
sugar/unstable/dict
|
|
"afm-font.rkt"
|
|
"font.rkt"
|
|
fontland
|
|
racket/runtime-path)
|
|
(provide isStandardFont standard-fonts StandardFont)
|
|
|
|
(define StandardFont
|
|
(class PDFFont
|
|
(init document)
|
|
(init-field name id)
|
|
(field [font (make-object AFMFont
|
|
((hash-ref standard-fonts name
|
|
(λ () (raise-argument-error 'PDFFont "valid font name" name)))))])
|
|
(super-new [document document]
|
|
[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]
|
|
[@document document])
|
|
|
|
(define/override (embed)
|
|
(set-field! payload @dictionary
|
|
(mhash 'Type "Font"
|
|
'BaseFont name
|
|
'Subtype "Type1"
|
|
'Encoding "WinAnsiEncoding"))
|
|
(send @dictionary end))
|
|
|
|
(define/override (encode text [options #f])
|
|
(define encoded (send font encodeText text))
|
|
(define glyphs (send font glyphsForString text))
|
|
(define advances (send font advancesForGlyphs glyphs))
|
|
(define positions
|
|
(for/list ([glyph (in-list glyphs)]
|
|
[advance (in-list advances)])
|
|
(+glyph-position advance 0 0 0 (send font widthOfGlyph glyph))))
|
|
(list encoded positions))
|
|
|
|
(define/override (string-width str size [options #f])
|
|
(define glyphs (send font glyphsForString str))
|
|
(define advances (send font advancesForGlyphs glyphs))
|
|
(define width (apply + advances))
|
|
(define scale (/ size 1000.0))
|
|
(* width scale))))
|
|
|
|
(module+ test
|
|
(define stdfont (make-object StandardFont #f "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 (λ () (file->string 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")))
|