text-to-pdf: simple text to pdf utility

diff --git a/extra/text-to-pdf/authors.txt b/extra/text-to-pdf/authors.txt
new file mode 100644 (file)
index 0000000..e091bb8
--- /dev/null
+++ b/extra/text-to-pdf/authors.txt
@@ -0,0 +1 @@
+John Benediktsson

diff --git a/extra/text-to-pdf/summary.txt b/extra/text-to-pdf/summary.txt
new file mode 100644 (file)
index 0000000..998a297
--- /dev/null
+++ b/extra/text-to-pdf/summary.txt
@@ -0,0 +1 @@
+Text-to-PDF converter.

diff --git a/extra/text-to-pdf/text-to-pdf.factor b/extra/text-to-pdf/text-to-pdf.factor
new file mode 100644 (file)
index 0000000..13a2538
--- /dev/null
+++ b/extra/text-to-pdf/text-to-pdf.factor
@@ -0,0 +1,141 @@
+! Copyright (C) 2010 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: assocs calendar combinators environment formatting
+grouping io io.files kernel make math math.ranges sequences
+splitting xml.entities ;
+
+IN: text-to-pdf
+
+<PRIVATE
+
+: pdf-string ( str -- str' )
+    H{
+        { 0x08    "\\b"  }
+        { 0x0c    "\\f"  }
+        { CHAR: \n   "\\n"  }
+        { CHAR: \r   "\\r"  }
+        { CHAR: \t   "\\t"  }
+        { CHAR: \\   "\\\\" }
+        { CHAR: (    "\\("  }
+        { CHAR: )    "\\)"  }
+    } escape-string-by "(" ")" surround ;
+
+: pdf-object ( str n -- str' )
+    "%d 0 obj\n" sprintf "\nendobj" surround ;
+
+: pdf-stream ( str -- str' )
+    [ length 1 + "<<\n/Length %d\n>>" sprintf ]
+    [ "\nstream\n" "\nendstream" surround ] bi append ;
+
+: pdf-info ( -- str )
+    [
+        "<<" ,
+        "/CreationDate D:" now "%Y%m%d%H%M%S" strftime append ,
+        "/Producer (Factor)" ,
+        "/Author " "USER" os-env "unknown" or pdf-string append ,
+        "/Creator (created with Factor)" ,
+        ">>" ,
+    ] { } make "\n" join ;
+
+: pdf-catalog ( -- str )
+    {
+        "<<"
+        "/Type /Catalog"
+        "/Pages 4 0 R"
+        ">>"
+    } "\n" join ;
+
+: pdf-font ( -- str )
+    {
+        "<<"
+        "/Type /Font"
+        "/Subtype /Type1"
+        "/BaseFont /Courier"
+        ">>"
+    } "\n" join ;
+
+: pdf-pages ( n -- str )
+    [
+        "<<" ,
+        "/Type /Pages" ,
+        "/MediaBox [ 0 0 612 792 ]" ,
+        [ "/Count %d" sprintf , ]
+        [
+            5 swap 2 range boa
+            [ "%d 0 R " sprintf ] map concat
+            "/Kids [ " "]" surround ,
+        ] bi
+        ">>" ,
+    ] { } make "\n" join ;
+
+: pdf-text ( lines -- str )
+    [
+        "BT" ,
+        "54 738 Td" ,
+        "/F1 10 Tf" ,
+        "12 TL" ,
+        [ pdf-string "'" append , ] each
+        "ET" ,
+    ] { } make "\n" join pdf-stream ;
+
+: pdf-page ( n -- page )
+    [
+        "<<" ,
+        "/Type /Page" ,
+        "/Parent 4 0 R" ,
+        1 + "/Contents %d 0 R" sprintf ,
+        "/Resources << /Font << /F1 3 0 R >> >>" ,
+        ">>" ,
+    ] { } make "\n" join ;
+
+: pdf-trailer ( objects -- str )
+    [
+        "xref" ,
+        dup length 1 + "0 %d" sprintf ,
+        "0000000000 65535 f" ,
+        9 over [
+            over "%010X 00000 n" sprintf , length 1 + +
+        ] each drop
+        "trailer" ,
+        "<<" ,
+        dup length 1 + "/Size %d" sprintf ,
+        "/Info 1 0 R" ,
+        "/Root 2 0 R" ,
+        ">>" ,
+        "startxref" ,
+        [ length 1 + ] map-sum 9 + "%d" sprintf ,
+        "%%EOF" ,
+    ] { } make "\n" join ;
+
+: string>lines ( str -- lines )
+    "\t" split "    " join string-lines
+    [ [ " " ] when-empty ] map ;
+
+: lines>pages ( lines -- pages )
+    [ 84 <groups> ] map concat 57 <groups> ;
+
+: pages>objects ( pages -- objects )
+    [
+        pdf-info ,
+        pdf-catalog ,
+        pdf-font ,
+        dup length pdf-pages ,
+        dup length 5 swap 2 range boa zip
+        [ pdf-page , pdf-text , ] assoc-each
+    ] { } make
+    dup length [1,b] zip [ first2 pdf-object ] map ;
+
+: objects>pdf ( objects -- str )
+    [ "\n" join "\n" append "%PDF-1.4\n" ]
+    [ pdf-trailer ] bi surround ;
+
+PRIVATE>
+
+: text-to-pdf ( str -- str' )
+    string>lines lines>pages pages>objects objects>pdf ;
+
+: file-to-pdf ( path encoding -- )
+    [ file-contents text-to-pdf ]
+    [ [ ".pdf" append ] dip set-file-contents ] 2bi ;
+

diff --git a/extra/text-to-pdf/text-to-pdf.pdf b/extra/text-to-pdf/text-to-pdf.pdf
new file mode 100644 (file)
index 0000000..d5b74e8
--- /dev/null
+++ b/extra/text-to-pdf/text-to-pdf.pdf
@@ -0,0 +1,254 @@
+%PDF-1.4
+1 0 obj
+<<
+/CreationDate D:20101016095802
+/Producer (Factor)
+/Author (jbenedik)
+/Creator (created with Factor)
+>>
+endobj
+2 0 obj
+<<
+/Type /Catalog
+/Pages 4 0 R
+>>
+endobj
+3 0 obj
+<<
+/Type /Font
+/Subtype /Type1
+/BaseFont /Courier
+>>
+endobj
+4 0 obj
+<<
+/Type /Pages
+/MediaBox [ 0 0 612 792 ]
+/Count 3
+/Kids [ 5 0 R 7 0 R 9 0 R ]
+>>
+endobj
+5 0 obj
+<<
+/Type /Page
+/Parent 4 0 R
+/Contents 6 0 R
+/Resources << /Font << /F1 3 0 R >> >>
+>>
+endobj
+6 0 obj
+<<
+/Length 1633
+>>
+stream
+BT
+54 738 Td
+/F1 10 Tf
+12 TL
+(! Copyright \(C\) 2010 John Benediktsson)'
+(! See http://factorcode.org/license.txt for BSD license)'
+( )'
+(USING: assocs calendar combinators environment formatting)'
+(grouping io io.files kernel make math math.ranges sequences)'
+(splitting xml.entities ;)'
+( )'
+(IN: text-to-pdf)'
+( )'
+(<PRIVATE)'
+( )'
+(: pdf-string \( str -- str' \))'
+(    H{)'
+(        { HEX: 08    "\\\\b"  })'
+(        { HEX: 0c    "\\\\f"  })'
+(        { CHAR: \\n   "\\\\n"  })'
+(        { CHAR: \\r   "\\\\r"  })'
+(        { CHAR: \\t   "\\\\t"  })'
+(        { CHAR: \\\\   "\\\\\\\\" })'
+(        { CHAR: \(    "\\\\\("  })'
+(        { CHAR: \)    "\\\\\)"  })'
+(    } escape-string-by "\(" "\)" surround ;)'
+( )'
+(: pdf-object \( str n -- str' \))'
+(    "%d 0 obj\\n" sprintf "\\nendobj" surround ;)'
+( )'
+(: pdf-stream \( str -- str' \))'
+(    [ length 1 + "<<\\n/Length %d\\n>>" sprintf ])'
+(    [ "\\nstream\\n" "\\nendstream" surround ] bi append ;)'
+( )'
+(: pdf-info \( -- str \))'
+(    [)'
+(        "<<" ,)'
+(        "/CreationDate D:" now "%Y%m%d%H%M%S" strftime append ,)'
+(        "/Producer \(Factor\)" ,)'
+(        "/Author " "USER" os-env "unknown" or pdf-string append ,)'
+(        "/Creator \(created with Factor\)" ,)'
+(        ">>" ,)'
+(    ] { } make "\\n" join ;)'
+( )'
+(: pdf-catalog \( -- str \))'
+(    {)'
+(        "<<")'
+(        "/Type /Catalog")'
+(        "/Pages 4 0 R")'
+(        ">>")'
+(    } "\\n" join ;)'
+( )'
+(: pdf-font \( -- str \))'
+(    {)'
+(        "<<")'
+(        "/Type /Font")'
+(        "/Subtype /Type1")'
+(        "/BaseFont /Courier")'
+(        ">>")'
+(    } "\\n" join ;)'
+( )'
+ET
+endstream
+endobj
+7 0 obj
+<<
+/Type /Page
+/Parent 4 0 R
+/Contents 8 0 R
+/Resources << /Font << /F1 3 0 R >> >>
+>>
+endobj
+8 0 obj
+<<
+/Length 1569
+>>
+stream
+BT
+54 738 Td
+/F1 10 Tf
+12 TL
+(: pdf-pages \( n -- str \))'
+(    [)'
+(        "<<" ,)'
+(        "/Type /Pages" ,)'
+(        "/MediaBox [ 0 0 612 792 ]" ,)'
+(        [ "/Count %d" sprintf , ])'
+(        [)'
+(            5 swap 2 range boa)'
+(            [ "%d 0 R " sprintf ] map concat)'
+(            "/Kids [ " "]" surround ,)'
+(        ] bi)'
+(        ">>" ,)'
+(    ] { } make "\\n" join ;)'
+( )'
+(: pdf-text \( lines -- str \))'
+(    [)'
+(        "BT" ,)'
+(        "54 738 Td" ,)'
+(        "/F1 10 Tf" ,)'
+(        "12 TL" ,)'
+(        [ pdf-string "'" append , ] each)'
+(        "ET" ,)'
+(    ] { } make "\\n" join pdf-stream ;)'
+( )'
+(: pdf-page \( n -- page \))'
+(    [)'
+(        "<<" ,)'
+(        "/Type /Page" ,)'
+(        "/Parent 4 0 R" ,)'
+(        1 + "/Contents %d 0 R" sprintf ,)'
+(        "/Resources << /Font << /F1 3 0 R >> >>" ,)'
+(        ">>" ,)'
+(    ] { } make "\\n" join ;)'
+( )'
+(: pdf-trailer \( objects -- str \))'
+(    [)'
+(        "xref" ,)'
+(        dup length 1 + "0 %d" sprintf ,)'
+(        "0000000000 65535 f" ,)'
+(        9 over [)'
+(            over "%010X 00000 n" sprintf , length 1 + +)'
+(        ] each drop)'
+(        "trailer" ,)'
+(        "<<" ,)'
+(        dup length 1 + "/Size %d" sprintf ,)'
+(        "/Info 1 0 R" ,)'
+(        "/Root 2 0 R" ,)'
+(        ">>" ,)'
+(        "startxref" ,)'
+(        [ length 1 + ] map-sum 9 + "%d" sprintf ,)'
+(        "%%EOF" ,)'
+(    ] { } make "\\n" join ;)'
+( )'
+(: string>lines \( str -- lines \))'
+(    "\\t" split "    " join string-lines)'
+(    [ [ " " ] when-empty ] map ;)'
+( )'
+ET
+endstream
+endobj
+9 0 obj
+<<
+/Type /Page
+/Parent 4 0 R
+/Contents 10 0 R
+/Resources << /Font << /F1 3 0 R >> >>
+>>
+endobj
+10 0 obj
+<<
+/Length 839
+>>
+stream
+BT
+54 738 Td
+/F1 10 Tf
+12 TL
+(: lines>pages \( lines -- pages \))'
+(    [ 84 <groups> ] map concat 57 <groups> ;)'
+( )'
+(: pages>objects \( pages -- objects \))'
+(    [)'
+(        pdf-info ,)'
+(        pdf-catalog ,)'
+(        pdf-font ,)'
+(        dup length pdf-pages ,)'
+(        dup length 5 swap 2 range boa zip)'
+(        [ pdf-page , pdf-text , ] assoc-each)'
+(    ] { } make)'
+(    dup length [1,b] zip [ first2 pdf-object ] map ;)'
+( )'
+(: objects>pdf \( objects -- str \))'
+(    [ "\\n" join "\\n" append "%PDF-1.4\\n" ])'
+(    [ pdf-trailer ] bi surround ;)'
+( )'
+(PRIVATE>)'
+( )'
+(: text-to-pdf \( str -- str' \))'
+(    string>lines lines>pages pages>objects objects>pdf ;)'
+( )'
+(: file-to-pdf \( path encoding -- \))'
+(    [ file-contents text-to-pdf ])'
+(    [ [ ".pdf" append ] dip set-file-contents ] 2bi ;)'
+( )'
+( )'
+ET
+endstream
+endobj
+xref
+0 11
+0000000000 65535 f
+0000000009 00000 n
+0000000082 00000 n
+00000000B3 00000 n
+00000000F7 00000 n
+0000000158 00000 n
+00000001BE 00000 n
+0000000852 00000 n
+00000008B8 00000 n
+0000000F0C 00000 n
+0000000F73 00000 n
+trailer
+<<
+/Size 11
+/Info 1 0 R
+/Root 2 0 R
+>>
+startxref
+4845
+%%EOF
\ No newline at end of file