Hello, world! PDF版 in Scheme DouKaku?

Hello, world! PDF版

Hello, world!シリーズの続編です。「Hello, world!」となるべく大きく書かれた1ページのPDFを出力してください。

Posted feedbacks - Scheme

Gaucheだとkenhysさん作のlibharuがあるので、それを使えばPDF出力ができるのですが、
外部ライブラリを使用すると他言語の解答と似たものとなってつまらないので、自力でPDFを作成してみました。

(use srfi-1)
(use gauche.sequence)
(use util.list)

(define-method pdf-format ((port <port>) dict obj)
  (format port "~a " obj))

(define-method pdf-format ((port <port>) dict (kw <keyword>))
  (format port "/~a " kw))

(define-method pdf-format ((port <port>) dict (sym <symbol>))
  (cond
   ((assq sym dict) => (compose (cut format port "~d 0 R " <>) cdr))
   (else
    (format port "~a " sym))))

(define-method pdf-format ((port <port>) dict (str <string>))
  (format port "(~a) " str))

(define-method pdf-format ((port <port>) dict (vec <vector>))
  (format port "[ ")
  (for-each (cut pdf-format port dict <>) vec)
  (format port "] "))

(define-method pdf-format ((port <port>) dict (lst <list>))
  (cond
   ((null? lst) #f)
   ((is-a? (car lst) <pair>)
    (format port "<< ")
    (for-each (lambda (pair)
                (pdf-format port dict (car pair))
                (pdf-format port dict (cdr pair)))
              lst)
    (format port ">> "))
   (else
    (for-each (cut pdf-format port dict <>) lst))))

(define-method pdf-format ((port <port>) dict (proc <procedure>))
  (proc port dict))

(define (pdf-stream cmd-list)
  (lambda (port dict)
    (let ((stream (call-with-output-string
                    (lambda (out)
                      (format out "~%BT~%")
                      (for-each (lambda (cmd)
                                  (pdf-format out dict cmd)
                                  (newline out))
                                cmd-list)
                      (format out "ET~%")))))
      (pdf-format port dict `((:Length ,(string-length stream))))
      (format port "~%stream~aendstream~%" stream))))

(define (pdf-object name content)
  (lambda (port dict ctxt)
    (let ((pos (port-tell port)))
      (format port "~d 0 obj~%" (assq-ref dict name))
      (pdf-format port dict content)
      (format port "~%endobj~%")
      (acons name pos ctxt))))

(define (pdf-trailer root)
  (lambda (port dict ctxt)
    (let ((xref-pos (port-tell port)))
      (format port "xref~%0 ~d~%0000000000 65535 f~%" (+ (length dict) 1))
      (for-each (cut format port "~10,'0d 00000 n~%" <>) (map cdr (reverse ctxt)))
      (format port "trailer~%")
      (pdf-format port dict `((:Root . ,root) (:Size ,(+ (length dict) 1))))
      (format port "~%startxref~%~d~%%%EOF~%" xref-pos))))

(define (pdf-write filename root dict pdf-obj-list)
  (call-with-output-file filename
    (lambda (port)
      (format port "%PDF-1.2~%")
      (fold (cut <> port dict <>) '()
            (append pdf-obj-list (list (pdf-trailer root)))))))

(define-syntax pdf-document
  (syntax-rules ()
    ((_ filename root (name content) ...)
     (pdf-write filename 'root
                (map cons (list 'name ...) (iota (length (list 'name ...)) 1))
                (list (pdf-object 'name content) ...)))))

(pdf-document "hello.pdf" root
              (page      '((:Type . :Page)
                           (:Parent . pages)
                           (:Resources . res)
                           (:Contents . contents)))
              (pages     '((:Type . :Pages)
                           (:Kids . #(page))
                           (:Count . 1)
                           (:MediaBox . #(0 0 842 595))))
              (res       '((:ProcSet . #(:PDF :Text))
                           (:Font . ((:F1 . font)))))
              (contents   (pdf-stream '((:F1 120 Tf)
                                        (1 0 0 1 72 260 Tm)
                                        ("Hello, world!" Tj))))
              (font      '((:Type . :Font)
                           (:Subtype . :TrueType)
                           (:BaseFont . :Helvetica)))
              (root      '((:Type . :Catalog)
                           (:Pages . pages))))

DouKaku?

Hello, world! PDF版

Posted feedbacks - Scheme

Index

Feed

Other

Link

Pathtraq