refac reference class
parent
1778fd1a35
commit
a8a0e3b6d3
@ -1,74 +1,55 @@
|
|||||||
#lang debug racket/base
|
#lang debug racket/base
|
||||||
(require
|
(require racket/class
|
||||||
"helper.rkt"
|
racket/match
|
||||||
"param.rkt"
|
racket/port
|
||||||
racket/class
|
"param.rkt"
|
||||||
racket/contract
|
"object.rkt"
|
||||||
racket/list
|
"zlib.rkt")
|
||||||
sugar/unstable/class
|
|
||||||
sugar/unstable/js
|
|
||||||
sugar/unstable/dict
|
|
||||||
sugar/unstable/port
|
|
||||||
"object.rkt"
|
|
||||||
"zlib.rkt")
|
|
||||||
(provide PDFReference)
|
(provide PDFReference)
|
||||||
|
|
||||||
(define-subclass object% (PDFReference document id [payload (mhash)])
|
(define PDFReference
|
||||||
(field [ref-byte-strings empty]
|
(class object%
|
||||||
[offset #f])
|
(super-new)
|
||||||
|
(init-field [(@doc document)]
|
||||||
(as-methods
|
[(@id id)]
|
||||||
write
|
[(@payload payload) (make-hasheq)])
|
||||||
end
|
(field [(@offset offset) #f]
|
||||||
toString))
|
[@portal (open-output-bytes)])
|
||||||
|
|
||||||
|
(define/public (write x)
|
||||||
(define/contract (write this x)
|
(define bstr (match x
|
||||||
((or/c string? bytes? input-port?) . ->m . void?)
|
[(? bytes?) x]
|
||||||
(push-field! ref-byte-strings this
|
[(? input-port?) (port->bytes x)]
|
||||||
(let loop ([x x])
|
[_ (string->bytes/latin-1 (format "~a\n" x))]))
|
||||||
(cond
|
(write-bytes bstr @portal)
|
||||||
[(bytes? x) x]
|
(void))
|
||||||
[(input-port? x) (loop (port->bytes x))]
|
|
||||||
[else (bytes-append (newBuffer x) #"\n")]))))
|
(define/public (end [chunk #f])
|
||||||
|
(when chunk
|
||||||
(define got-ref-byte-strings? pair?)
|
(write chunk))
|
||||||
|
|
||||||
(define/contract (end this [chunk #f])
|
(set! @offset (current-doc-offset))
|
||||||
(() ((or/c string? bytes? input-port?)) . ->*m . void?)
|
|
||||||
(when chunk (send this write chunk))
|
|
||||||
|
|
||||||
#;(report* 'end! (· this id))
|
|
||||||
(define bstrs-to-write
|
|
||||||
(let ([current-bstrs (reverse (· this ref-byte-strings))])
|
|
||||||
(if (and (compress-streams?)
|
|
||||||
(not (hash-ref (· this payload) 'Filter #f))
|
|
||||||
(got-ref-byte-strings? current-bstrs))
|
|
||||||
(let ([deflated-chunk (deflate (apply bytes-append current-bstrs))])
|
|
||||||
(hash-set! (· this payload) 'Filter "FlateDecode")
|
|
||||||
(list deflated-chunk))
|
|
||||||
current-bstrs)))
|
|
||||||
|
|
||||||
(when (got-ref-byte-strings? bstrs-to-write)
|
(send @doc write (format "~a 0 obj" @id))
|
||||||
(hash-set! (· this payload) 'Length (apply + (map buffer-length bstrs-to-write))))
|
|
||||||
|
(define bstr
|
||||||
(define this-doc (· this document))
|
(let ([bstr (get-output-bytes @portal)])
|
||||||
(set-field! offset this (current-doc-offset))
|
(cond
|
||||||
|
[(zero? (bytes-length bstr)) #false]
|
||||||
(with-method ([doc_write (this-doc write)])
|
[(and (compress-streams?) (not (hash-ref @payload 'Filter #f)))
|
||||||
(doc_write (format "~a 0 obj" (· this id)))
|
(hash-set! @payload 'Filter "FlateDecode")
|
||||||
(doc_write (convert (· this payload)))
|
(deflate bstr)]
|
||||||
(when (got-ref-byte-strings? bstrs-to-write)
|
[else bstr])))
|
||||||
(doc_write "stream")
|
|
||||||
(for ([bstr (in-list bstrs-to-write)])
|
(when bstr
|
||||||
(doc_write bstr))
|
(hash-set! @payload 'Length (bytes-length bstr)))
|
||||||
(doc_write "\nendstream"))
|
(send @doc write (convert @payload))
|
||||||
(doc_write "endobj"))
|
|
||||||
|
(when bstr
|
||||||
#;(report (· this id))
|
(send @doc write (bytes-append #"stream\n" bstr #"\n\nendstream")))
|
||||||
(send this-doc _refEnd this))
|
|
||||||
|
(send @doc write "endobj")
|
||||||
|
(send @doc _refEnd this))
|
||||||
(define/contract (toString this)
|
|
||||||
(->m string?)
|
(define/public (to-string)
|
||||||
(format "~a 0 R" (· this id)))
|
(format "~a 0 R" @id))))
|
||||||
|
Loading…
Reference in New Issue