compare lengths of pitfall to pdfkit

7 years ago · 61e180b975
parent 673fb8997d
commit 61e180b975
16 changed files with 93 additions and 44 deletions
--- a/pitfall/pitfall/pdftest.rkt
+++ b/pitfall/pitfall/pdftest.rkt
@ -1,5 +1,6 @@
 #lang pitfall/racket
 (provide (all-from-out pitfall/racket))
+(provide check-copy-equal? check-pdfkit?)

 (test-mode #t)

@ -7,10 +8,23 @@

 (define (this->control this) (path-add-extension this #"" #" copy."))

-(provide check-copy-equal?)
+(define (this->pdfkit-control this)
+  (string->path (string-replace (path->string this) "rkt." ".")))
+
+(module+ test
+  (require rackunit)
+  (check-equal? (this->pdfkit-control (string->path "test1crkt.pdf")) (string->path "test1c.pdf")))
+
+
 (define-syntax-rule (check-copy-equal? this)
  (check-equal? (file->bytes this) (file->bytes (this->control this))))

+
+(define-syntax-rule (check-pdfkit? this)
+  (check-equal? (bytes-length (file->bytes this))
+                (bytes-length (file->bytes (this->pdfkit-control this)))))
+
+
 (module reader syntax/module-reader
  #:language 'pitfall/pdftest
  #:read read
--- a/pitfall/pitfall/standard-fonts.rkt
+++ b/pitfall/pitfall/standard-fonts.rkt
@ -1,24 +1,32 @@
 #lang pitfall/racket
-(require racket/runtime-path (for-syntax racket/base racket/path racket/syntax))
+(require racket/runtime-path (for-syntax racket/base racket/path racket/syntax sugar/debug))
 (provide isStandardFont standard-fonts)

+
 (define (isStandardFont name) (hash-ref standard-fonts name #f))

 (define-syntax (define-afm-table stx)
  (syntax-case stx ()
-    [(_ 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)) ...))))))]))
+    [(_ 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 "data")
+(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
--- a/pitfall/pitfall/test/test0.pdf
+++ b/pitfall/pitfall/test/test0.pdf
--- a/pitfall/pitfall/test/test0.rkt
+++ b/pitfall/pitfall/test/test0.rkt
@ -7,4 +7,5 @@
   (send doc pipe (open-output-file this #:exists 'replace))
   (send doc end)))

-(check-copy-equal? this)
+(check-copy-equal? this)
+(check-pdfkit? this)
--- a/pitfall/pitfall/test/test0c.rkt
+++ b/pitfall/pitfall/test/test0c.rkt
@ -7,4 +7,5 @@
   (send doc pipe (open-output-file this #:exists 'replace))
   (send doc end)))

-(check-copy-equal? this)
+(check-copy-equal? this)
+(check-pdfkit? this)
--- a/pitfall/pitfall/test/test1.pdf
+++ b/pitfall/pitfall/test/test1.pdf
@ -23,11 +23,38 @@ endobj
 >>
 >>
 endobj
+3 0 obj
+<<
+/Length 294
+>>
+stream
+1 0 0 -1 0 792 cm
+q
+100 150 m
+100 250 l
+200 250 l
+/DeviceRGB cs
+1 0.2 0 scn
+/Gs1 gs
+f
+230 200 m
+230 172.385763 252.385763 150 280 150 c
+307.614237 150 330 172.385763 330 200 c
+330 227.614237 307.614237 250 280 250 c
+252.385763 250 230 227.614237 230 200 c
+h
+/DeviceRGB cs
+0.4 0 1 scn
+/Gs1 gs
+f
+
+endstream
+endobj
 7 0 obj
 <<
 /Producer (PDFKit)
 /Creator (PDFKit)
-/CreationDate (D:20170518183426Z)
+/CreationDate (D:20170519175138Z)
 >>
 endobj
 2 0 obj
@ -43,28 +70,16 @@ endobj
 /Kids [5 0 R]
 >>
 endobj
-3 0 obj
-<<
-/Length 151
-/Filter /FlateDecode
->>
-stream
-xœ]<5D>]
-ƒ0„ß÷¹@ãî¬ûZ
-¾÷
-Áþ@-”@Ïï&• C2ó
#ŽíœÄ®p†‹3}I˜<49>tìæ¢`êM¨ª¹N¿WœnãÅÅDô°pŠjÆ$î‘èNPss&d%^‡.ôjˆ*s†S$åà{i¡¡<è>¦+Ï|Y¡z71¬<Þ¦¨|ìc¨¼çaûÖÖÈaÏ´E=
-endstream
-endobj
 xref
 0 8
 0000000000 65535 f 
-0000000399 00000 n 
-0000000350 00000 n 
-0000000456 00000 n 
+0000000744 00000 n 
+0000000695 00000 n 
+0000000258 00000 n 
 0000000163 00000 n 
 0000000059 00000 n 
 0000000015 00000 n 
-0000000258 00000 n 
+0000000603 00000 n 
 trailer
 <<
 /Size 8
@ -72,5 +87,5 @@ trailer
 /Info 7 0 R
 >>
 startxref
-679
+801
 %%EOF
--- a/pitfall/pitfall/test/test1.rkt
+++ b/pitfall/pitfall/test/test1.rkt
@ -19,4 +19,5 @@

   (send doc end)))

-(check-copy-equal? this)
+(check-copy-equal? this)
+(check-pdfkit? this)
--- a/pitfall/pitfall/test/test1c.rkt
+++ b/pitfall/pitfall/test/test1c.rkt
@ -19,4 +19,5 @@

   (send doc end)))

-(check-copy-equal? this)
+(check-copy-equal? this)
+(check-pdfkit? this)
--- a/pitfall/pitfall/test/test2.rkt
+++ b/pitfall/pitfall/test/test2.rkt
@ -74,4 +74,5 @@

   (send doc end)))

-(check-copy-equal? this)
+(check-copy-equal? this)
+(check-pdfkit? this)
--- a/pitfall/pitfall/test/test2c.rkt
+++ b/pitfall/pitfall/test/test2c.rkt
@ -74,4 +74,5 @@

   (send doc end)))

-(check-copy-equal? this)
+(check-copy-equal? this)
+(check-pdfkit? this)
--- a/pitfall/pitfall/test/test3.rkt
+++ b/pitfall/pitfall/test/test3.rkt
@ -7,4 +7,5 @@
   (send doc text "Hello world")
   (send doc end)))

-(check-copy-equal? this)
+(check-copy-equal? this)
+(check-pdfkit? this)
--- a/pitfall/pitfall/test/test3c.rkt
+++ b/pitfall/pitfall/test/test3c.rkt
@ -7,4 +7,5 @@
   (send doc text "Hello world")
   (send doc end)))

-(check-copy-equal? this)
+(check-copy-equal? this)
+(check-pdfkit? this)
--- a/pitfall/pitfall/test/test4.rkt
+++ b/pitfall/pitfall/test/test4.rkt
@ -65,4 +65,5 @@
   
   (send doc end)))

-(check-copy-equal? this)
+(check-copy-equal? this)
+(check-pdfkit? this)
--- a/pitfall/pitfall/test/test4c.rkt
+++ b/pitfall/pitfall/test/test4c.rkt
@ -65,4 +65,5 @@
   
   (send doc end)))

-(check-copy-equal? this)
+(check-copy-equal? this)
+(check-pdfkit? this)
--- a/pitfall/pitfall/test/test5.rkt
+++ b/pitfall/pitfall/test/test5.rkt
@ -17,4 +17,5 @@
   
   (send doc end)))

-;(check-copy-equal? this)
+;(check-copy-equal? this)
+;(check-pdfkit? this)
--- a/pitfall/pitfall/test/test5c.rkt
+++ b/pitfall/pitfall/test/test5c.rkt
@ -17,4 +17,5 @@
   
   (send doc end)))

-;(check-copy-equal? this)
+;(check-copy-equal? this)
+;(check-pdfkit? this)