refac

pitfall/pitfall/font.rkt

@@ -13,11 +13,13 @@
      finalize)
     ))
 
-(define (PDFFont-open document src family id)
+(define/contract (PDFFont-open document src family id)
+  (object? any/c any/c any/c . -> . (is-a?/c PDFFont))
   (cond
-    [(string? src)
-     (when (isStandardFont src)
-       (make-object StandardFont document src id))]))
+    [(and (string? src) (isStandardFont src)
+          (make-object StandardFont document src id))]
+    ;; todo: other font-loading cases
+    [else (raise-argument-error 'PDFFont-open "loadable font name" src)]))
 
 
 (define/contract (ref this)
@@ -37,7 +39,8 @@
   (class PDFFont
     (super-new)
     (init-field document name id)
-    (field [font (make-object AFMFont ((hash-ref standard-fonts name)))]
+    (field [font (make-object AFMFont ((hash-ref standard-fonts name
+                                                 (λ () (raise-argument-error 'PDFFont "valid font name" name)))))]
            [ascender (· font ascender)]
            [descender (· font descender)]
            [bbox (· font bbox)]
@@ -47,6 +50,7 @@
      encode
      widthOfString)))
 
+
 (define/contract (embed this)
   (->m void?)
   (set-field! data (· this dictionary)
@@ -76,12 +80,12 @@
 
 (define/contract (widthOfString this str size [options #f])
   ((string? number?) ((or/c hash? #f)) . ->*m . number?)
-  (let* ([this-font (· this font)]
-         [glyphs (send this-font glyphsForString str)]
-         [advances (send this-font advancesForGlyphs glyphs)]
-         [width (apply + advances)]
-         [scale (/ size 1000)])
-    (* width scale)))
+  (define this-font (· this font))
+  (define glyphs (send this-font glyphsForString str))
+  (define advances (send this-font advancesForGlyphs glyphs))
+  (define width (apply + advances))
+  (define scale (/ size 1000))
+  (* width scale))
 
 
 (module+ test

pitfall/pitfall/font/standard-fonts.rkt

@@ -1,16 +1,38 @@
 #lang pitfall/racket
-(require racket/runtime-path)
+(require racket/runtime-path (for-syntax racket/base racket/format))
 (provide isStandardFont standard-fonts)
 
-(define (isStandardFont name)
-  (hash-ref standard-fonts name #f))
+(define (isStandardFont name) (hash-ref standard-fonts name #f))
 
-(define-runtime-path Helvetica "data/Helvetica.afm")
+(define-syntax (drps 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))) ...))))))]))
+
+(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 standard-fonts
-  (hash "Helvetica" (λ () (file->string Helvetica))))
 
 (module+ test
   (require rackunit)
   (check-true (and (isStandardFont "Helvetica") #t))
-  (check-false (isStandardFont "Not A Font Name")))
+  (check-true (and (isStandardFont "Courier") #t))
+  (check-true (and (isStandardFont "ZapfDingbats") #t))
+  (check-false (isStandardFont "Not A Font Name")))