mbutterick
/
typesetting
2
1
Fork 0
Code Issues 13 Pull Requests Projects Releases Wiki Activity

so-called improvements

Browse Source
main
Matthew Butterick 7 years ago
parent 56e63b5663
commit 7e3501ad3f
4 changed files with 94 additions and 100 deletions
Show Stats Download Patch File Download Diff File

153
pitfall/pitfall/afm.rkt
Unescape Escape View File

@ -46,12 +46,13 @@
[("FontMetrics")
;; line looks like this:
;; FontName Helvetica
;; key space value. Possibly multiple lines with same key.
;; `key space value`. Possibly multiple lines with same key.
(match-define (list _ key value) (regexp-match #px"^(\\w+)\\s+(.*)" line))
(hash-update! (· this attributes) (string->symbol key)
(λ (v) (if (equal? v value)
(λ (v) (if (eq? v 'init-val)
value
(append (if (pair? v) v (list v)) (list value)))) value)]
(append (if (pair? v) v (list v)) (list value))))
'init-val)]
[("CharMetrics")
;; line looks like this:
;; C 33 ; WX 278 ; N exclam ; B 90 0 187 718 ;
@ -138,78 +139,80 @@
(+ (send this widthOfGlyph left) (send this getKernPair left right))))
(define characters (list->vector (string-split @string-append{
.notdef .notdef .notdef .notdef
.notdef .notdef .notdef .notdef
.notdef .notdef .notdef .notdef
.notdef .notdef .notdef .notdef
.notdef .notdef .notdef .notdef
.notdef .notdef .notdef .notdef
.notdef .notdef .notdef .notdef
.notdef .notdef .notdef .notdef
space exclam quotedbl numbersign
dollar percent ampersand quotesingle
parenleft parenright asterisk plus
comma hyphen period slash
zero one two three
four five six seven
eight nine colon semicolon
less equal greater question
at A B C
D E F G
H I J K
L M N O
P Q R S
T U V W
X Y Z bracketleft
backslash bracketright asciicircum underscore
grave a b c
d e f g
h i j k
l m n o
p q r s
t u v w
x y z braceleft
bar braceright asciitilde .notdef
Euro .notdef quotesinglbase florin
quotedblbase ellipsis dagger daggerdbl
circumflex perthousand Scaron guilsinglleft
OE .notdef Zcaron .notdef
.notdef quoteleft quoteright quotedblleft
quotedblright bullet endash emdash
tilde trademark scaron guilsinglright
oe .notdef zcaron ydieresis
space exclamdown cent sterling
currency yen brokenbar section
dieresis copyright ordfeminine guillemotleft
logicalnot hyphen registered macron
degree plusminus twosuperior threesuperior
acute mu paragraph periodcentered
cedilla onesuperior ordmasculine guillemotright
onequarter onehalf threequarters questiondown
Agrave Aacute Acircumflex Atilde
Adieresis Aring AE Ccedilla
Egrave Eacute Ecircumflex Edieresis
Igrave Iacute Icircumflex Idieresis
Eth Ntilde Ograve Oacute
Ocircumflex Otilde Odieresis multiply
Oslash Ugrave Uacute Ucircumflex
Udieresis Yacute Thorn germandbls
agrave aacute acircumflex atilde
adieresis aring ae ccedilla
egrave eacute ecircumflex edieresis
igrave iacute icircumflex idieresis
eth ntilde ograve oacute
ocircumflex otilde odieresis divide
oslash ugrave uacute ucircumflex
udieresis yacute thorn ydieresis})))
(define characters
(list->vector
(string-split
@string-append{ .notdef .notdef .notdef .notdef
.notdef .notdef .notdef .notdef
.notdef .notdef .notdef .notdef
.notdef .notdef .notdef .notdef
.notdef .notdef .notdef .notdef
.notdef .notdef .notdef .notdef
.notdef .notdef .notdef .notdef
.notdef .notdef .notdef .notdef
space exclam quotedbl numbersign
dollar percent ampersand quotesingle
parenleft parenright asterisk plus
comma hyphen period slash
zero one two three
four five six seven
eight nine colon semicolon
less equal greater question
at A B C
D E F G
H I J K
L M N O
P Q R S
T U V W
X Y Z bracketleft
backslash bracketright asciicircum underscore
grave a b c
d e f g
h i j k
l m n o
p q r s
t u v w
x y z braceleft
bar braceright asciitilde .notdef
Euro .notdef quotesinglbase florin
quotedblbase ellipsis dagger daggerdbl
circumflex perthousand Scaron guilsinglleft
OE .notdef Zcaron .notdef
.notdef quoteleft quoteright quotedblleft
quotedblright bullet endash emdash
tilde trademark scaron guilsinglright
oe .notdef zcaron ydieresis
space exclamdown cent sterling
currency yen brokenbar section
dieresis copyright ordfeminine guillemotleft
logicalnot hyphen registered macron
degree plusminus twosuperior threesuperior
acute mu paragraph periodcentered
cedilla onesuperior ordmasculine guillemotright
onequarter onehalf threequarters questiondown
Agrave Aacute Acircumflex Atilde
Adieresis Aring AE Ccedilla
Egrave Eacute Ecircumflex Edieresis
Igrave Iacute Icircumflex Idieresis
Eth Ntilde Ograve Oacute
Ocircumflex Otilde Odieresis multiply
Oslash Ugrave Uacute Ucircumflex
Udieresis Yacute Thorn germandbls
agrave aacute acircumflex atilde
adieresis aring ae ccedilla
egrave eacute ecircumflex edieresis
igrave iacute icircumflex idieresis
eth ntilde ograve oacute
ocircumflex otilde odieresis divide
oslash ugrave uacute ucircumflex
udieresis yacute thorn ydieresis})))
(module+ test
(define afmfont (AFMFont-open "data/helvetica.afm"))

2
pitfall/pitfall/document.rkt
Unescape Escape View File

@ -42,7 +42,7 @@
(· this initVector)
(· this initFonts)
(· this initText)
(· this initImages)
;(· this initImages)
(as-methods
addPage

2
pitfall/pitfall/font.rkt
Unescape Escape View File

@ -68,7 +68,7 @@
(define glyphs (send this-font glyphsForString text))
(define advances (send this-font advancesForGlyphs glyphs))
(define positions
(for/list ([(glyph i) (in-indexed glyphs)]
(for/list ([glyph (in-list glyphs)]
[advance (in-list advances)])
(hasheq 'xAdvance advance
'yAdvance 0

37
pitfall/pitfall/standard-fonts.rkt
Unescape Escape View File

@ -1,33 +1,24 @@
#lang pitfall/racket
(require racket/runtime-path (for-syntax racket/base racket/format))
(require racket/runtime-path (for-syntax racket/base racket/path racket/syntax))
(provide isStandardFont standard-fonts)
(define (isStandardFont name) (hash-ref standard-fonts name #f))
(define-syntax (drps stx)
(define-syntax (define-afm-table stx)
(syntax-case stx ()
[(_ hashid id ...)
(let ([id-strings (map ~a (map syntax->datum (syntax->list #'(id ...))))])
(with-syntax ([(path ...) (map (λ (d) (format "data/~a.afm" d)) id-strings)]
[(id-str ...) id-strings])
#'(begin (define-runtime-path id path) ...
(define hashid (make-hash (list (cons id-str (λ () (file->string id))) ...))))))]))
[(_ hashid dir)
(let* ([path-strings (for/list ([p (in-directory (syntax->datum #'dir) #t)]
#:when (and (file-exists? p) (path-has-extension? p #"afm") p))
(path->string p))]
[id-strings (for/list ([pstr (in-list path-strings)])
(path->string (cadr (explode-path (path-replace-extension pstr #"")))))])
(with-syntax ([(PATH-STR ...) path-strings]
[(ID-STR ...) id-strings]
[(ID ...) (map (λ (id-str) (format-id #'hashid "~a" id-str)) id-strings)])
#'(begin (define-runtime-path ID PATH-STR) ...
(define hashid (make-hash (list (cons ID-STR (procedure-rename (λ () (file->string ID)) 'ID)) ...))))))]))
(drps 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)
(define-afm-table standard-fonts "data")
(module+ test

Write Preview
Loading…
Cancel
Save