4 /CreationDate D:20101016095802
7 /Creator (created with Factor)
26 /MediaBox [ 0 0 612 792 ]
28 /Kids [ 5 0 R 7 0 R 9 0 R ]
36 /Resources << /Font << /F1 3 0 R >> >>
48 (! Copyright \(C\) 2010 John Benediktsson)'
49 (! See https://factorcode.org/license.txt for BSD license)'
51 (USING: assocs calendar combinators environment formatting)'
52 (grouping io io.files kernel make math ranges sequences)'
53 (splitting xml.entities ;)'
59 (: pdf-string \( str -- str' \))'
61 ( { HEX: 08 "\\\\b" })'
62 ( { HEX: 0c "\\\\f" })'
63 ( { CHAR: \\n "\\\\n" })'
64 ( { CHAR: \\r "\\\\r" })'
65 ( { CHAR: \\t "\\\\t" })'
66 ( { CHAR: \\\\ "\\\\\\\\" })'
67 ( { CHAR: \( "\\\\\(" })'
68 ( { CHAR: \) "\\\\\)" })'
69 ( } escape-string-by "\(" "\)" surround ;)'
71 (: pdf-object \( str n -- str' \))'
72 ( "%d 0 obj\\n" sprintf "\\nendobj" surround ;)'
74 (: pdf-stream \( str -- str' \))'
75 ( [ length 1 + "<<\\n/Length %d\\n>>" sprintf ])'
76 ( [ "\\nstream\\n" "\\nendstream" surround ] bi append ;)'
78 (: pdf-info \( -- str \))'
81 ( "/CreationDate D:" now "%Y%m%d%H%M%S" strftime append ,)'
82 ( "/Producer \(Factor\)" ,)'
83 ( "/Author " "USER" os-env "unknown" or pdf-string append ,)'
84 ( "/Creator \(created with Factor\)" ,)'
86 ( ] { } make "\\n" join ;)'
88 (: pdf-catalog \( -- str \))'
96 (: pdf-font \( -- str \))'
100 ( "/Subtype /Type1")'
101 ( "/BaseFont /Courier")'
113 /Resources << /Font << /F1 3 0 R >> >>
125 (: pdf-pages \( n -- str \))'
129 ( "/MediaBox [ 0 0 612 792 ]" ,)'
130 ( [ "/Count %d" sprintf , ])'
132 ( 5 swap 2 range boa)'
133 ( [ "%d 0 R " sprintf ] map concat)'
134 ( "/Kids [ " "]" surround ,)'
137 ( ] { } make "\\n" join ;)'
139 (: pdf-text \( lines -- str \))'
145 ( [ pdf-string "'" append , ] each)'
147 ( ] { } make "\\n" join pdf-stream ;)'
149 (: pdf-page \( n -- page \))'
153 ( "/Parent 4 0 R" ,)'
154 ( 1 + "/Contents %d 0 R" sprintf ,)'
155 ( "/Resources << /Font << /F1 3 0 R >> >>" ,)'
157 ( ] { } make "\\n" join ;)'
159 (: pdf-trailer \( objects -- str \))'
162 ( dup length 1 + "0 %d" sprintf ,)'
163 ( "0000000000 65535 f" ,)'
165 ( over "%010X 00000 n" sprintf , length 1 + +)'
169 ( dup length 1 + "/Size %d" sprintf ,)'
174 ( [ length 1 + ] map-sum 9 + "%d" sprintf ,)'
176 ( ] { } make "\\n" join ;)'
178 (: string>lines \( str -- lines \))'
179 ( "\\t" split " " join lines)'
180 ( [ [ " " ] when-empty ] map ;)'
190 /Resources << /Font << /F1 3 0 R >> >>
202 (: lines>pages \( lines -- pages \))'
203 ( [ 84 <groups> ] map concat 57 <groups> ;)'
205 (: pages>objects \( pages -- objects \))'
210 ( dup length pdf-pages ,)'
211 ( dup length 5 swap 2 range boa zip)'
212 ( [ pdf-page , pdf-text , ] assoc-each)'
214 ( dup length [1..b] zip [ first2 pdf-object ] map ;)'
216 (: objects>pdf \( objects -- str \))'
217 ( [ "\\n" join "\\n" append "%PDF-1.4\\n" ])'
218 ( [ pdf-trailer ] bi surround ;)'
222 (: text-to-pdf \( str -- str' \))'
223 ( string>lines lines>pages pages>objects objects>pdf ;)'
225 (: file-to-pdf \( path encoding -- \))'
226 ( [ file-contents text-to-pdf ])'
227 ( [ [ ".pdf" append ] dip set-file-contents ] 2bi ;)'