pdf: adding a pdf render vocab.
John Benediktsson
parent
adb3a15d21
commit
ccf46b6846
|
|
@ -0,0 +1 @@
|
|||
John Benediktsson
|
||||
|
|
@ -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 ;
|
||||
|
|
@ -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 ;
|
||||
|
|
@ -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" } "." } ;
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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 ;
|
||||
|
|
@ -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 ;
|
||||
|
||||
|
|
@ -0,0 +1 @@
|
|||
PDF implementation of formatted output stream protocol
|
||||
|
|
@ -0,0 +1 @@
|
|||
Creating PDF files
|
||||
|
|
@ -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:
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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 ;
|
||||
|
|
@ -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 ;
|
||||
|
|
@ -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 ;
|
||||
|
||||
Loading…
Reference in New Issue