1 ! Copyright (C) 2010 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
4 USING: assocs calendar combinators environment formatting
5 grouping io io.files kernel make math ranges sequences
6 splitting xml.entities ;
12 : pdf-string ( str -- str' )
22 } escape-string-by "(" ")" surround ;
24 : pdf-object ( str n -- str' )
25 "%d 0 obj\n" sprintf "\nendobj" surround ;
27 : pdf-stream ( str -- str' )
28 [ length 1 + "<<\n/Length %d\n>>" sprintf ]
29 [ "\nstream\n" "\nendstream" surround ] bi append ;
34 "/CreationDate D:" now "%Y%m%d%H%M%S" strftime append ,
35 "/Producer (Factor)" ,
36 "/Author " "USER" os-env "unknown" or pdf-string append ,
37 "/Creator (created with Factor)" ,
39 ] { } make join-lines ;
41 : pdf-catalog ( -- str )
58 : pdf-pages ( n -- str )
62 "/MediaBox [ 0 0 612 792 ]" ,
63 [ "/Count %d" sprintf , ]
66 [ "%d 0 R " sprintf ] map concat
67 "/Kids [ " "]" surround ,
70 ] { } make join-lines ;
72 : pdf-text ( lines -- str )
78 [ pdf-string "'" append , ] each
80 ] { } make join-lines pdf-stream ;
82 : pdf-page ( n -- page )
87 1 + "/Contents %d 0 R" sprintf ,
88 "/Resources << /Font << /F1 3 0 R >> >>" ,
90 ] { } make join-lines ;
92 : pdf-trailer ( objects -- str )
95 dup length 1 + "0 %d" sprintf ,
96 "0000000000 65535 f" ,
98 over "%010X 00000 n" sprintf , length 1 + +
102 dup length 1 + "/Size %d" sprintf ,
107 [ length 1 + ] map-sum 9 + "%d" sprintf ,
109 ] { } make join-lines ;
111 : string>lines ( str -- lines )
112 "\t" split " " join split-lines
113 [ [ " " ] when-empty ] map ;
115 : lines>pages ( lines -- pages )
116 [ 84 <groups> ] map concat 57 <groups> ;
118 : pages>objects ( pages -- objects )
123 dup length pdf-pages ,
124 dup length 5 swap 2 range boa zip
125 [ pdf-page , pdf-text , ] assoc-each
127 dup length [1..b] zip [ first2 pdf-object ] map ;
129 : objects>pdf ( objects -- str )
130 [ join-lines "\n" append "%PDF-1.4\n" ]
131 [ pdf-trailer ] bi surround ;
135 : text-to-pdf ( str -- str' )
136 string>lines lines>pages pages>objects objects>pdf ;
138 : file-to-pdf ( path encoding -- )
139 [ file-contents text-to-pdf ]
140 [ [ ".pdf" append ] dip set-file-contents ] 2bi ;