From: John Benediktsson <mrjbq7@gmail.com>
Date: Sat, 22 Sep 2012 19:24:47 +0000 (-0700)
Subject: pdf: adding a pdf render vocab.
X-Git-Tag: 0.97~2335
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=ccf46b6846956dbd319112f4de781d6034df914e

pdf: adding a pdf render vocab.
---

diff --git a/extra/pdf/authors.txt b/extra/pdf/authors.txt
new file mode 100644
index 0000000000..e091bb8164
--- /dev/null
+++ b/extra/pdf/authors.txt
@@ -0,0 +1 @@
+John Benediktsson
diff --git a/extra/pdf/canvas/canvas.factor b/extra/pdf/canvas/canvas.factor
new file mode 100644
index 0000000000..588c37db6d
--- /dev/null
+++ b/extra/pdf/canvas/canvas.factor
@@ -0,0 +1,159 @@
+! Copyright (C) 2011-2012 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: accessors assocs colors.constants combinators fonts fry
+io io.styles kernel math math.order pdf.text pdf.wrap sequences
+ui.text ;
+
+IN: pdf.canvas
+
+TUPLE: margin left right top bottom ;
+
+C: <margin> margin
+
+TUPLE: canvas x y width height margin col-width font stream
+foreground background page-color inset line-height metrics ;
+
+: <canvas> ( -- canvas )
+    canvas new
+        0 >>x
+        0 >>y
+        612 >>width
+        792 >>height
+        54 54 54 54 <margin> >>margin
+        612 >>col-width
+        sans-serif-font 12 >>size >>font
+        SBUF" " >>stream
+        0 >>line-height
+        { 0 0 } >>inset
+    dup font>> font-metrics >>metrics ;
+
+: set-style ( canvas style -- canvas )
+    {
+        [
+            font-name swap at "sans-serif" or {
+                { "sans-serif" [ "Helvetica" ] }
+                { "serif"      [ "Times"     ] }
+                { "monospace"  [ "Courier"   ] }
+                [ " is unsupported" append throw ]
+            } case [ dup font>> ] dip >>name drop
+        ]
+        [
+            font-size swap at 12 or
+            [ dup font>> ] dip >>size drop
+        ]
+        [
+            font-style swap at [ dup font>> ] dip {
+                { bold        [ t f ] }
+                { italic      [ f t ] }
+                { bold-italic [ t t ] }
+                [ drop f f ]
+            } case [ >>bold? ] [ >>italic? ] bi* drop
+        ]
+        [ foreground swap at COLOR: black or >>foreground ]
+        [ background swap at f or >>background ]
+        [ page-color swap at f or >>page-color ]
+        [ inset swap at { 0 0 } or >>inset ]
+    } cleave
+    dup font>> font-metrics
+    [ >>metrics ] [ height>> '[ _ max ] change-line-height ] bi ;
+
+! introduce positioning of elements versus canvas?
+
+: margin-x ( canvas -- n )
+    margin>> [ left>> ] [ right>> ] bi + ;
+
+: margin-y ( canvas -- n )
+    margin>> [ top>> ] [ bottom>> ] bi + ;
+
+: (width) ( canvas -- n )
+    [ width>> ] [ margin>> [ left>> ] [ right>> ] bi + ] bi - ;
+
+: width ( canvas -- n )
+    [ (width) ] [ col-width>> ] bi min ;
+
+: height ( canvas -- n )
+    [ height>> ] [ margin>> [ top>> ] [ bottom>> ] bi + ] bi - ;
+
+: x ( canvas -- n )
+    [ margin>> left>> ] [ x>> ] bi + ;
+
+: y ( canvas -- n )
+    [ height>> ] [ margin>> top>> ] [ y>> ] tri + - ;
+
+: inc-x ( canvas n -- )
+    '[ _ + ] change-x drop ;
+
+: inc-y ( canvas n -- )
+    '[ _ + ] change-y drop ;
+
+: line-height ( canvas -- n )
+    [ line-height>> ] [ inset>> first 2 * ] bi + ;
+
+: line-break ( canvas -- )
+    [ line-height>> ] keep [ + ] change-y 0 >>x
+    dup metrics>> height>> >>line-height drop ;
+
+: ?line-break ( canvas -- )
+    dup x>> 0 > [ line-break ] [ drop ] if ;
+
+: ?break ( canvas -- )
+    dup x>> 0 > [ ?line-break ] [
+        [ 7 + ] change-y 0 >>x drop
+    ] if ;
+
+: inc-lines ( canvas n -- )
+    [ 0 >>x ] dip [ dup line-break ] times drop ;
+
+: avail-width ( canvas -- n )
+    [ width ] [ x>> ] bi - 0 max ;
+
+: avail-height ( canvas -- n )
+    [ height ] [ y>> ] bi - 0 max ;
+
+: avail-lines ( canvas -- n )
+    [ avail-height ] [ line-height>> ] bi /i ; ! FIXME: 1 +
+
+: text-fits? ( canvas string -- ? )
+    [ dup font>> ] [ word-split1 drop ] bi*
+    text-width swap avail-width <= ;
+
+: draw-page-color ( canvas -- ) ! FIXME:
+    dup page-color>> [
+        "0.0 G" print
+        foreground-color
+        [ 0 0 ] dip [ width>> ] [ height>> ] bi
+        rectangle fill
+    ] [ drop ] if* ;
+
+: draw-background ( canvas line -- )
+    over background>> [
+        "0.0 G" print
+        foreground-color
+        [ drop [ x ] [ y ] bi ]
+        [ [ font>> ] [ text-dim first2 neg ] bi* ] 2bi
+        rectangle fill
+    ] [ 2drop ] if* ;
+
+: draw-text1 ( canvas line -- canvas )
+    [ draw-background ] [
+        text-start
+        over font>> text-size
+        over foreground>> [ foreground-color ] when*
+        over [ x ] [ y ] [ metrics>> ascent>> - ] tri text-location
+        over dup font>> pick text-width inc-x
+        text-write
+        text-end
+    ] 2bi ;
+
+: draw-text ( canvas lines -- )
+    [ drop ] [
+        unclip-last
+        [ [ draw-text1 dup line-break ] each ]
+        [ [ draw-text1 ] when* ] bi* drop
+    ] if-empty ;
+
+: draw-line ( canvas width -- )
+    swap [ x ] [ y ] [ line-height>> 2 / - ] tri
+    [ line-move ] [ [ + ] [ line-line ] bi* ] 2bi
+    stroke ;
diff --git a/extra/pdf/layout/layout.factor b/extra/pdf/layout/layout.factor
new file mode 100644
index 0000000000..d9ff982c53
--- /dev/null
+++ b/extra/pdf/layout/layout.factor
@@ -0,0 +1,426 @@
+! Copyright (C) 2011-2012 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: accessors assocs calendar combinators environment fonts
+formatting fry io io.streams.string kernel literals locals make
+math math.order math.ranges pdf.canvas pdf.values pdf.wrap
+sequences sorting splitting ui.text xml.entities ;
+FROM: assocs => change-at ;
+FROM: sequences => change-nth ;
+FROM: pdf.canvas => draw-text ;
+
+IN: pdf.layout
+
+! TODO: inset, image
+! Insets:
+! before:
+!   y += inset-height
+!   margin-left, margin-right += inset-width
+! after:
+!   y += inset-height
+!   margin-left, margin-right -= inset-width
+
+! TUPLE: pre < p
+! C: <pre> pre
+
+! TUPLE: spacer width height ;
+! C: <spacer> spacer
+
+! TUPLE: image < span ;
+! C: <image> image
+
+! Outlines (add to catalog):
+!   /Outlines 3 0 R
+!   /PageMode /UseOutlines
+! Table of Contents
+! Thumbnails
+! Annotations
+! Images
+
+! FIXME: spacing oddities if run multiple times
+! FIXME: make sure highlights text "in order"
+! FIXME: don't modify layout objects in pdf-render
+! FIXME: make sure unicode "works"
+! FIXME: only set style differences to reduce size?
+! FIXME: gadget. to take a "screenshot" into a pdf?
+! FIXME: compress each pdf object to reduce file size?
+
+
+GENERIC: pdf-render ( canvas obj -- remain/f )
+
+M: f pdf-render 2drop f ;
+
+GENERIC: pdf-width ( canvas obj -- n )
+
+<PRIVATE
+
+: (pdf-layout) ( page obj -- page )
+    [ dup ] [
+        dupd [ pdf-render ] with-string-writer
+        '[ _ append ] [ change-stream ] curry dip
+        [ [ , <canvas> ] when ] keep
+    ] while drop ;
+
+PRIVATE>
+
+: pdf-layout ( seq -- pages )
+    [ <canvas> ] dip [
+        [ (pdf-layout) ] each
+        dup stream>> empty? [ drop ] [ , ] if
+    ] { } make ;
+
+
+TUPLE: div items style ;
+
+C: <div> div
+
+M: div pdf-render
+    [ style>> set-style ] keep
+    swap '[ _ pdf-render drop ] each f ;
+
+M: div pdf-width
+    [ style>> set-style ] keep
+    items>> [ dupd pdf-width ] map nip supremum ;
+
+
+<PRIVATE
+
+: convert-string ( str -- str' )
+    {
+        { CHAR: “    "\""   }
+        { CHAR: ”    "\""   }
+    } escape-string-by [ 256 < ] filter ;
+
+PRIVATE>
+
+
+TUPLE: p string style ;
+
+: <p> ( string style -- p )
+    [ convert-string ] dip p boa ;
+
+M: p pdf-render
+    [ style>> set-style ] keep
+    [
+        over ?line-break
+        over [ font>> ] [ avail-width ] bi visual-wrap
+        over avail-lines short cut
+        [ draw-text ] [ "" concat-as ] bi*
+    ] change-string dup string>> empty? [ drop f ] when ;
+
+M: p pdf-width
+    [ style>> set-style ] keep
+    [ font>> ] [ string>> ] bi* string-lines
+    [ dupd text-width ] map nip supremum ;
+
+
+TUPLE: text string style ;
+
+: <text> ( string style -- text )
+    [ convert-string ] dip text boa ;
+
+M: text pdf-render
+    [ style>> set-style ] keep
+    [
+        over x>> 0 > [
+            2dup text-fits? [
+                over [ font>> ] [ avail-width ] bi visual-wrap
+                unclip [ "" concat-as ] dip
+            ] [ over line-break f ] if
+        ] [ f ] if
+        [
+            [ { } ] [ over [ font>> ] [ width ] bi visual-wrap ]
+            if-empty
+        ] dip [ prefix ] when*
+        over avail-lines short cut
+        [ draw-text ] [ "" concat-as ] bi*
+    ] change-string dup string>> empty? [ drop f ] when ;
+
+M: text pdf-width
+    [ style>> set-style ] keep
+    [ font>> ] [ string>> ] bi* string-lines
+    [ dupd text-width ] map nip supremum ;
+
+
+TUPLE: hr width ;
+
+C: <hr> hr
+
+M: hr pdf-render
+    [ f set-style ] dip
+    [
+        [ dup 0 > pick avail-lines 0 > and ] [
+            over avail-width over min [ - ] keep [
+                [ over ] dip [ draw-line ] [ inc-x ] 2bi
+            ] unless-zero dup 0 > [ over line-break ] when
+        ] while
+    ] change-width nip dup width>> 0 > [ drop f ] unless ;
+
+M: hr pdf-width
+    nip width>> ;
+
+
+TUPLE: br ;
+
+C: <br> br
+
+M: br pdf-render
+    [ f set-style ] dip
+    over avail-lines 0 > [ drop ?break f ] [ nip ] if ;
+
+M: br pdf-width
+    2drop 0 ;
+
+
+TUPLE: pb used? ;
+
+: <pb> ( -- pb ) f pb boa ;
+
+M: pb pdf-render
+    dup used?>> [ f >>used? drop f ] [ t >>used? ] if nip ;
+
+M: pb pdf-width
+    2drop 0 ;
+
+
+
+CONSTANT: table-cell-padding 5
+
+TUPLE: table-cell contents width ;
+
+: <table-cell> ( contents -- table-cell )
+    f table-cell boa ;
+
+M: table-cell pdf-render
+    {
+        [ width>> >>col-width 0 >>x drop ]
+        [
+            [ [ dupd pdf-render ] map nip ] change-contents
+            dup contents>> [ ] any? [ drop f ] unless
+        ]
+        [
+            width>> table-cell-padding +
+            swap margin>> [ + ] change-left drop
+        ]
+    } 2cleave ;
+
+TUPLE: table-row cells ;
+
+C: <table-row> table-row
+
+! save y before rendering each cell
+! set y to max y after all renders
+
+M: table-row pdf-render
+    {
+        [ drop ?line-break ]
+        [
+            [let
+                over y>> :> start-y
+                over y>> :> max-y!
+                [
+                    [
+                        [ start-y >>y ] dip
+                        dupd pdf-render
+                        over y>> max-y max max-y!
+                    ] map swap max-y >>y drop
+                ] change-cells
+
+                dup cells>> [ ] any? [ drop f ] unless
+            ]
+        ]
+        [ drop margin>> 54 >>left drop ]
+        [
+            drop dup width>> >>col-width
+            [ ?line-break ] [ table-cell-padding inc-y ] bi
+        ]
+    } 2cleave ;
+
+: col-widths ( canvas cells -- widths )
+    [
+        [
+            contents>> [ 0 ] [
+                [ [ dupd pdf-width ] [ 0 ] if* ] map supremum
+            ] if-empty
+        ] [ 0 ] if*
+    ] map nip ;
+
+: change-last ( seq quot -- )
+    [ drop length 1 - ] [ change-nth ] 2bi ; inline
+
+:: max-col-widths ( canvas rows -- widths )
+    H{ } clone :> widths
+    rows [
+        cells>> canvas swap col-widths
+        [ widths [ 0 or max ] change-at ] each-index
+    ] each widths >alist sort-keys values
+
+    ! make last cell larger
+    dup sum 400 swap - 0 max [ + ] curry dupd change-last
+
+    ! size down each column
+    dup sum dup 400 > [ 400 swap / [ * ] curry map ] [ drop ] if ;
+
+: set-col-widths ( canvas rows -- )
+    [ max-col-widths ] keep [
+        dupd cells>> [
+            [ swap >>width drop ] [ drop ] if*
+        ] 2each
+    ] each drop ;
+
+TUPLE: table rows widths? ;
+
+: <table> ( rows -- table )
+    f table boa ;
+
+M: table pdf-render
+    {
+        [
+            dup widths?>> [ 2drop ] [
+                t >>widths? rows>> set-col-widths
+            ] if
+        ]
+        [
+            [
+                dup rows>> empty? [ t ] [
+                    [ rows>> first dupd pdf-render ] keep swap
+                ] if
+            ] [ [ rest ] change-rows ] until nip
+            dup rows>> [ drop f ] [ drop ] if-empty
+        ]
+    } 2cleave ;
+
+M: table pdf-width
+    2drop 400 ; ! FIXME: hardcoded max-width
+
+
+: 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-catalog ( -- str )
+    {
+        "<<"
+        "/Type /Catalog"
+        "/Pages 15 0 R"
+        ">>"
+    } "\n" join ;
+
+: pdf-pages ( n -- str )
+    [
+        "<<" ,
+        "/Type /Pages" ,
+        "/MediaBox [ 0 0 612 792 ]" ,
+        [ "/Count %d" sprintf , ]
+        [
+            16 swap 2 range boa
+            [ "%d 0 R " sprintf ] map concat
+            "/Kids [ " "]" surround ,
+        ] bi
+        ">>" ,
+    ] { } make "\n" join ;
+
+: pdf-page ( n -- page )
+    [
+        "<<" ,
+        "/Type /Page" ,
+        "/Parent 15 0 R" ,
+        1 + "/Contents %d 0 R" sprintf ,
+        "/Resources << /Font <<" ,
+        "/F1 3 0 R /F2 4 0 R /F3 5 0 R" ,
+        "/F4 6 0 R /F5 7 0 R /F6 8 0 R" ,
+        "/F7 9 0 R /F8 10 0 R /F9 11 0 R" ,
+        "/F10 12 0 R /F11 13 0 R /F12 14 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 ;
+
+TUPLE: pdf-info title timestamp producer author creator ;
+
+: <pdf-info> ( -- pdf-info )
+    pdf-info new
+        now >>timestamp
+        "Factor" >>producer
+        "USER" os-env "unknown" or >>author
+        "created with Factor" >>creator ;
+
+M: pdf-info pdf-value
+    [
+        "<<" print [
+            [ timestamp>> [ "/CreationDate " write pdf-write nl ] when* ]
+            [ producer>> [ "/Producer " write pdf-write nl ] when* ]
+            [ author>> [ "/Author " write pdf-write nl ] when* ]
+            [ title>> [ "/Title " write pdf-write nl ] when* ]
+            [ creator>> [ "/Creator " write pdf-write nl ] when* ]
+        ] cleave ">>" print
+    ] with-string-writer ;
+
+
+TUPLE: pdf-ref object revision ;
+
+C: <pdf-ref> pdf-ref
+
+M: pdf-ref pdf-value
+    [ object>> ] [ revision>> ] bi "%d %d R" sprintf ;
+
+
+TUPLE: pdf info pages fonts ;
+
+: <pdf> ( -- pdf )
+    pdf new
+        <pdf-info> >>info
+        V{ } clone >>pages
+        V{ } clone >>fonts ;
+
+:: pages>objects ( pdf -- objects )
+    [
+        pdf info>> pdf-value ,
+        pdf-catalog ,
+        { $ sans-serif-font $ serif-font $ monospace-font } {
+            [ [ f >>bold? f >>italic? pdf-value , ] each ]
+            [ [ t >>bold? f >>italic? pdf-value , ] each ]
+            [ [ f >>bold? t >>italic? pdf-value , ] each ]
+            [ [ t >>bold? t >>italic? pdf-value , ] each ]
+        } cleave
+        pdf pages>> length pdf-pages ,
+        pdf pages>>
+        dup length 16 swap 2 range boa zip
+        [ pdf-page , , ] 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 ;
+
+! Rename to pdf>string, have it take a <pdf> object?
+
+: pdf>string ( seq -- pdf )
+    <pdf> swap pdf-layout  [
+        stream>> pdf-stream over pages>> push
+    ] each pages>objects objects>pdf ;
+
+: write-pdf ( seq -- )
+    pdf>string write ;
diff --git a/extra/pdf/pdf-docs.factor b/extra/pdf/pdf-docs.factor
new file mode 100644
index 0000000000..34e6714d14
--- /dev/null
+++ b/extra/pdf/pdf-docs.factor
@@ -0,0 +1,14 @@
+! Copyright (C) 2011-2012 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: help.markup help.syntax strings ;
+
+IN: pdf
+
+HELP: text-to-pdf
+{ $values { "str" string } { "pdf" string } }
+{ $description "Converts " { $snippet "str" } " into PDF instructions." } ;
+
+HELP: file-to-pdf
+{ $values { "path" string } { "encoding" "an encoding" } }
+{ $description "Converts " { $snippet "path" } " into a PDF, saving to " { $snippet "path.pdf" } "." } ;
diff --git a/extra/pdf/pdf-tests.factor b/extra/pdf/pdf-tests.factor
new file mode 100644
index 0000000000..6c4fb372f9
--- /dev/null
+++ b/extra/pdf/pdf-tests.factor
@@ -0,0 +1,7 @@
+! Copyright (C) 2010 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: pdf tools.test ;
+
+IN: pdf.tests
+
diff --git a/extra/pdf/pdf.factor b/extra/pdf/pdf.factor
new file mode 100644
index 0000000000..d2b32461df
--- /dev/null
+++ b/extra/pdf/pdf.factor
@@ -0,0 +1,15 @@
+! Copyright (C) 2011-2012 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: io.files io.styles kernel pdf.layout sequences splitting ;
+
+IN: pdf
+
+: text-to-pdf ( str -- pdf )
+    string-lines [
+        H{ { font-name "monospace" } { font-size 10 } } <p>
+    ] map pdf>string ;
+
+: file-to-pdf ( path encoding -- )
+    [ file-contents text-to-pdf ]
+    [ [ ".pdf" append ] dip set-file-contents ] 2bi ;
diff --git a/extra/pdf/streams/streams.factor b/extra/pdf/streams/streams.factor
new file mode 100644
index 0000000000..52ce89909a
--- /dev/null
+++ b/extra/pdf/streams/streams.factor
@@ -0,0 +1,85 @@
+! Copyright (C) 2011-2012 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: accessors arrays assocs destructors fry io io.styles
+kernel pdf.layout sequences splitting strings ;
+
+IN: pdf.streams
+
+<PRIVATE
+
+! FIXME: what about "proper" tab support?
+
+: string>texts ( string style -- seq )
+    [ string-lines ] dip '[ _ <text> 1array ] map
+    <br> 1array join ;
+
+PRIVATE>
+
+
+TUPLE: pdf-writer style data ;
+
+: new-pdf-writer ( class -- pdf-writer )
+    new H{ } >>style V{ } clone >>data ;
+
+: <pdf-writer> ( -- pdf-writer )
+    pdf-writer new-pdf-writer ;
+
+: with-pdf-writer ( quot -- pdf )
+    <pdf-writer> [ swap with-output-stream* ] keep data>> ; inline
+
+TUPLE: pdf-sub-stream < pdf-writer parent ;
+
+: new-pdf-sub-stream ( style stream class -- stream )
+    new-pdf-writer
+        swap >>parent
+        swap >>style
+    dup parent>> style>> '[ _ swap assoc-union ] change-style ;
+
+TUPLE: pdf-block-stream < pdf-sub-stream ;
+
+M: pdf-block-stream dispose
+    [ data>> ] [ parent>> ] bi
+    [ data>> push-all ] [ stream-nl ] bi ;
+
+TUPLE: pdf-span-stream < pdf-sub-stream ;
+
+M: pdf-span-stream dispose
+    [ data>> ] [ parent>> data>> ] bi push-all ;
+
+
+
+! Stream protocol
+
+M: pdf-writer stream-flush drop ;
+
+M: pdf-writer stream-write1
+    dup style>> '[ 1string _ <text> ] [ data>> ] bi* push ;
+
+M: pdf-writer stream-write
+    dup style>> '[ _ string>texts ] [ data>> ] bi* push-all ;
+
+M: pdf-writer stream-format
+    swap [ dup style>> ] dip assoc-union
+    '[ _ string>texts ] [ data>> ] bi* push-all ;
+
+M: pdf-writer stream-nl
+    <br> swap data>> push ; ! FIXME: <br> needs style?
+
+M: pdf-writer make-span-stream
+    pdf-span-stream new-pdf-sub-stream ;
+
+M: pdf-writer make-block-stream
+    pdf-block-stream new-pdf-sub-stream ;
+
+M: pdf-writer make-cell-stream
+    pdf-sub-stream new-pdf-sub-stream ;
+
+! FIXME: real table cells
+M: pdf-writer stream-write-table ! FIXME: needs style?
+    nip swap [
+        [ data>> <table-cell> ] map <table-row>
+    ] map <table> swap data>> push ;
+
+M: pdf-writer dispose drop ;
+
diff --git a/extra/pdf/streams/summary.txt b/extra/pdf/streams/summary.txt
new file mode 100644
index 0000000000..f068964597
--- /dev/null
+++ b/extra/pdf/streams/summary.txt
@@ -0,0 +1 @@
+PDF implementation of formatted output stream protocol
diff --git a/extra/pdf/summary.txt b/extra/pdf/summary.txt
new file mode 100644
index 0000000000..d991a79078
--- /dev/null
+++ b/extra/pdf/summary.txt
@@ -0,0 +1 @@
+Creating PDF files
diff --git a/extra/pdf/text/text.factor b/extra/pdf/text/text.factor
new file mode 100644
index 0000000000..338c5d772b
--- /dev/null
+++ b/extra/pdf/text/text.factor
@@ -0,0 +1,84 @@
+! Copyright (C) 2011-2012 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: accessors combinators formatting io kernel math
+pdf.values sequences ;
+
+IN: pdf.text
+
+: comment ( string -- ) "% " write print ;
+
+: foreground-color ( color -- ) pdf-write " rg" print ;
+
+: background-color ( color -- ) pdf-write " RG" print ;
+
+
+! text
+
+: text-start ( -- ) "BT" print ;
+
+: text-end ( -- ) "ET" print ;
+
+: text-location ( x y -- ) "1 0 0 1 %f %f Tm\n" printf ;
+
+: text-leading ( n -- ) "%d TL\n" printf ;
+
+: text-rise ( n -- ) "%d Ts\n" printf ;
+
+: text-size ( font -- )
+    [
+        [
+            name>> {
+                { "Helvetica" [ 1 ] }
+                { "Times"     [ 2 ] }
+                { "Courier"   [ 3 ] }
+                [ " is unsupported" append throw ]
+            } case
+        ]
+        [
+            {
+                { [ dup [ bold?>> ] [ italic?>> ] bi and ] [ 9 ] }
+                { [ dup bold?>> ] [ 3 ] }
+                { [ dup italic?>> ] [ 6 ] }
+                [ 0 ]
+            } cond nip +
+        ] bi
+    ] [ size>> ] bi "/F%d %d Tf\n" printf ;
+
+: text-write ( string -- ) pdf-write " Tj" print ;
+
+: text-nl ( -- ) "T*" print ;
+
+: text-print ( string -- ) pdf-write " '" print ;
+
+
+
+! graphics
+
+: line-width ( n -- ) "%d w\n" printf ;
+
+: line-dashed ( on off -- ) "[ %d %d ] 0 d\n" printf ;
+
+: line-solid ( -- ) "[] 0 d" print ;
+
+: line-move ( x y -- ) "%f %f m\n" printf ;
+
+: line-line ( x y -- ) "%f %f l\n" printf ;
+
+: gray ( percent -- ) "%.f g\n" printf ;
+
+: rectangle ( x y width height -- ) "%d %d %d %d re\n" printf ;
+
+: stroke ( -- ) "S" print ;
+
+: fill ( -- ) "f" print ;
+
+: B ( -- ) "B" print ;
+
+: b ( -- ) "b" print ;
+
+: c ( -- ) "300 400 400 400 400 300 c" print ; ! FIXME:
+
+
+
+
diff --git a/extra/pdf/units/units-tests.factor b/extra/pdf/units/units-tests.factor
new file mode 100644
index 0000000000..605ed8743f
--- /dev/null
+++ b/extra/pdf/units/units-tests.factor
@@ -0,0 +1,16 @@
+! Copyright (C) 2010 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: pdf.units tools.test ;
+
+IN: pdf.units.tests
+
+[ 0 ] [ "0" string>points ] unit-test
+[ 1 ] [ "1" string>points ] unit-test
+[ 1.5 ] [ "1.5" string>points ] unit-test
+
+[ 12 ] [ "12pt" string>points ] unit-test
+
+[ 72.0 ] [ "1in" string>points ] unit-test
+[ 108.0 ] [ "1.5in" string>points ] unit-test
+
diff --git a/extra/pdf/units/units.factor b/extra/pdf/units/units.factor
new file mode 100644
index 0000000000..b753889e81
--- /dev/null
+++ b/extra/pdf/units/units.factor
@@ -0,0 +1,26 @@
+! Copyright (C) 2011-2012 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: ascii combinators kernel math math.parser sequences ;
+
+IN: pdf.units
+
+: inch ( n -- n' ) 72.0 * ;
+
+: cm ( n -- n' ) inch 2.54 / ;
+
+: mm ( n -- n' ) cm 0.1 * ;
+
+: pica ( n -- n' ) 12.0 * ;
+
+: string>points ( str -- n )
+    dup [ digit? ] find-last drop 1 + cut
+    [ string>number ] dip {
+        { "cm"   [ cm ] }
+        { "in"   [ inch ] }
+        { "pt"   [ ] }
+        { ""     [ ] }
+        { "mm"   [ mm ] }
+        { "pica" [ pica ] }
+        [ throw ]
+    } case ;
diff --git a/extra/pdf/values/values.factor b/extra/pdf/values/values.factor
new file mode 100644
index 0000000000..f2c7a54f10
--- /dev/null
+++ b/extra/pdf/values/values.factor
@@ -0,0 +1,81 @@
+! Copyright (C) 2011-2012 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: accessors arrays assocs calendar colors colors.gray
+combinators combinators.short-circuit fonts formatting
+hashtables io kernel make math math.parser sequences strings
+xml.entities ;
+
+IN: pdf.values
+
+<PRIVATE
+
+: escape-string ( str -- str' )
+    H{
+        { 0x08    "\\b"  }
+        { 0x0c    "\\f"  }
+        { CHAR: \n   "\\n"  }
+        { CHAR: \r   "\\r"  }
+        { CHAR: \t   "\\t"  }
+        { CHAR: \\   "\\\\" }
+        { CHAR: (    "\\("  }
+        { CHAR: )    "\\)"  }
+    } escape-string-by ;
+
+PRIVATE>
+
+GENERIC: pdf-value ( obj -- str )
+
+M: number pdf-value number>string ;
+
+M: t pdf-value drop "true" ;
+
+M: f pdf-value drop "false" ;
+
+M: color pdf-value
+    [ red>> ] [ green>> ] [ blue>> ] tri
+    "%f %f %f" sprintf ;
+
+M: gray pdf-value
+    gray>> dup dup "%f %f %f" sprintf ;
+
+M: font pdf-value
+    [
+        "<<" ,
+        "/Type /Font" ,
+        "/Subtype /Type1" ,
+        {
+            [
+                name>> {
+                    { "sans-serif" [ "/Helvetica" ] }
+                    { "serif"      [ "/Times"     ] }
+                    { "monospace"  [ "/Courier"   ] }
+                    [ " is unsupported" append throw ]
+                } case
+            ]
+            [ [ bold?>> ] [ italic?>> ] bi or [ "-" append ] when ]
+            [ bold?>> [ "Bold" append ] when ]
+            [ italic?>> [ "Italic" append ] when ]
+        } cleave
+        "/BaseFont " prepend ,
+        ">>" ,
+    ] { } make "\n" join ;
+
+M: timestamp pdf-value
+    "%Y%m%d%H%M%S" strftime "D:" prepend ;
+
+M: string pdf-value
+    escape-string "(" ")" surround ;
+
+M: sequence pdf-value
+    [ "[" % [ pdf-value % " " % ] each "]" % ] "" make ;
+
+M: hashtable pdf-value
+    [
+        "<<\n" %
+        [ swap % " " % pdf-value % "\n" % ] assoc-each
+        ">>" %
+    ] "" make ;
+
+: pdf-write ( obj -- )
+    pdf-value write ;
diff --git a/extra/pdf/wrap/wrap.factor b/extra/pdf/wrap/wrap.factor
new file mode 100644
index 0000000000..59058d21d7
--- /dev/null
+++ b/extra/pdf/wrap/wrap.factor
@@ -0,0 +1,44 @@
+! Copyright (C) 2011-2012 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: kernel fry make math sequences ui.text unicode.categories
+wrap ;
+
+IN: pdf.wrap
+
+<PRIVATE
+
+: word-index ( string -- n/f )
+    dup [ blank? ] find drop [
+        1 + swap [ blank? not ] find-from drop
+    ] [ drop f ] if* ;
+
+PRIVATE>
+
+: word-split1 ( string -- before after/f )
+    dup word-index [ cut ] [ f ] if* ;
+
+<PRIVATE
+
+: word-split, ( string -- )
+    [ word-split1 [ , ] [ dup empty? not ] bi* ] loop drop ;
+
+PRIVATE>
+
+: word-split ( string -- seq )
+    [ word-split, ] { } make ;
+
+<PRIVATE
+
+: string>elements ( string font -- elements )
+    [ word-split ] dip '[
+        dup word-split1 "" or
+        [ _ swap text-width ] bi@
+        <element>
+    ] map ;
+
+PRIVATE>
+
+: visual-wrap ( line font line-width -- lines )
+    [ string>elements ] dip dup wrap [ concat ] map ;
+