REBOL [
    Title: "PDF Maker alpha version"
    Date: 23-Jun-2001/18:08:54+2:00
    Version: 0.0.0
    File: %pdf-maker.r
    Author: "Gabriele Santilli"
    Purpose: "Dialect to create Adobe Acrobat (PDF) files."
    Email: g.santilli@tiscalinet.it
    Web: http://web.tiscalinet.it/rebol/pdf-maker.r
    Category: [text util 4 lib]
]

context [
    pdf-start: "%PDF-1.3^/"
    pdf-end: "%%EOF"
    pdf-string-valid: complement charset "()\"
    pdf-form: func ["REBOL to PDF" value /only /local result mrk1 mrk2] [
        result: make string! 256
        if block? :value [
            if only [insert result "["]
            foreach element value [
                insert insert tail result pdf-form/only element #" "
            ]
            either only [change back tail result "]"] [remove back tail result]
            return result
        ]
        if char? :value [
            return head insert result reduce [
                #"("
                either find pdf-string-valid value [""] [#"\"] value
                #")"
            ]
        ]
        if string? :value [
            insert result "("
            parse/all value [
                some [
                    mrk1: some pdf-string-valid mrk2: (
                        insert/part tail result mrk1 mrk2
                    )
                  | mrk1: skip (
                        insert insert tail result #"\" mrk1/1
                    )
                ]
            ]
            insert tail result ")"
            return result
        ]
        if issue? :value [return form value]
        mold :value
    ]
    xref: []
    contents: #{}

    pdf-words: context [
        obj: func [id data] [
            insert tail xref reduce [id index? tail contents]
            insert tail contents reduce [
                id " 0 obj^/" pdf-form data "^/endobj^/"
            ]
        ]
        stream: func [id data] [
            insert tail xref reduce [id index? tail contents]
            if block? data [data: pdf-form data]
            insert tail contents reduce [
                id " 0 obj^/"
                pdf-form compose [
                    #<< /Length (length? data) #>>
                ]
                "^/stream^/"
                data
                "^/endstream^/endobj^/"
            ]
        ]
    ]

    zero-padded: func [val n] [
        val: form val
        head insert insert/dup make string! n #"0" n - length? val val
    ]
    make-xref: has [pos] [
        pos: tail contents
        insert pos "xref^/0 1^/0000000000 65535 f ^/"
        foreach [id ofs] xref [
            insert tail pos reduce [
                id " 1^/"
                zero-padded ofs 10 " 00000 n ^/"
            ]
        ]
        insert tail pos reduce [
            newline
            "trailer^/"
            pdf-form compose [
                #<< /Size (1 + divide length? xref 2)
                    /Root 1 0 R ; this assumes root will always be 1
                #>>
            ]
            "^/startxref^/"
            index? pos newline
        ]
    ]
    set 'make-pdf func [spec [block!]] [
        clear xref
        clear contents
        insert contents pdf-start
        do bind spec in pdf-words 'self
        make-xref
        copy head insert tail contents pdf-end
    ]

    pages: []
    used-fonts: []
    font-resources: []
    pdf-spec: []
    default-page: context [
        size: [211 297] ; mm. (ISO A4)
        rotation: 0
        contents: []
    ]
    default-textbox: context [
        bbox: [10 17 191 263]
        text: []
    ]
    make-docroot: does [
        insert tail pdf-spec [
            obj 1 [
                #<< /Type /Catalog
                    /Outlines 2 0 R
                    /Pages 100 0 R
                #>>
            ]

            obj 2 [
                #<< /Type /Outlines
                    /Count 0
                #>>
            ]

            obj 3 [ ; ProcSet to use in pages
                [/PDF /Text]
            ]
        ]
    ]
    new: val1: val2: bb: txtb: none
    txtb-emit: func [data] [
        insert tail txtb/text reduce data
    ]
    use-font: func [name size] [
        used-fonts: union used-fonts reduce [name]
        txtb-emit [to-refinement name size 'Tf size / 10 + size 'TL]
    ]
    font-def: ['font set val1 word! set val2 number! (use-font val1 val2)]
    offset-text: ['offset set val1 number! set val2 number! (txtb-emit [mm2pt val1 mm2pt val2 'Td])]
    set-lead: ['line 'height set val1 number! (txtb-emit [val1 'TL])]
    process-text: func [text] [
        text: parse/all text "^/"
        if pick text 1 [txtb-emit [pick text 1 'Tj]]
        foreach line next text [
            txtb-emit ['T* line 'Tj]
        ]
    ]
    draw-text: [set val1 string! (process-text val1)]
    c2d: func [val] [divide any [val 0] 255]
    set-color: [set val1 tuple! (txtb-emit [c2d val1/1 c2d val1/2 c2d val1/3 'rg])]
    textbox-rule: [
        [font-def | none (use-font 'Helvetica 12)]
        (txtb-emit [mm2pt txtb/bbox/1 mm2pt txtb/bbox/2 + txtb/bbox/4 'Td 'T*])
        some [
            font-def
          | offset-text
          | 'newline (insert tail txtb/text 'T*)
          | set-lead
          | draw-text
          | set-color
        ]
    ]
    page-rule: [
        (insert tail pages new: make default-page [])
        opt ['page any [
            'size set val1 number! set val2 number! (new/size: reduce [val1 val2])
          | 'rotation set val1 integer! (new/rotation: val1)
        ]]
        any [
            'textbox (insert tail new/contents txtb: make default-textbox [])
            opt [(bb: clear []) 4 [set val1 number! (append bb val1)] (change txtb/bbox bb)]
            into textbox-rule
        ]
    ]
    parse-spec: func [spec] [
        parse spec [some [into page-rule]]
    ]
    make-fonts: has [i] [
        i: 4
        clear font-resources
        foreach font used-fonts [
            insert tail font-resources reduce [to-refinement font i 0 'R]
            insert tail pdf-spec compose/deep [
                obj (i) [
                    #<< /Type /Font
                        /Subtype /Type1
                        /BaseFont (to-refinement font)
                        /Encoding /WinAnsiEncoding
                    #>>
                ]
            ]
            i: i + 1
        ]
    ]
    mm2pt: func [mm] [mm * 72 / 25.4]
    make-pages: has [i kids mediabox stream] [
        i: 101
        kids: clear []
        foreach page pages [
            insert tail kids reduce [i 0 'R]
            mediabox: reduce [0 0 mm2pt page/size/1 mm2pt page/size/2]
            stream: clear []
            foreach textbox page/contents [
                insert tail stream compose [
                    q
                    (mm2pt textbox/bbox/1) (mm2pt textbox/bbox/2)
                    (mm2pt textbox/bbox/3) (mm2pt textbox/bbox/4) re W n
                    BT (textbox/text) ET
                    Q
                ]
            ]
            insert tail pdf-spec compose/deep [
                obj (i) [
                    #<< /Type /Page
                        /Parent 100 0 R
                        /MediaBox [(mediabox)]
                        /Rotate (page/rotation)
                        /Contents (i + 1) 0 R
                        /Resources #<<
                            /ProcSet 3 0 R
                            /Font #<< (font-resources) #>>
                        #>>
                    #>>
                ]

                stream (i + 1) [
                    (stream)
                ]
            ]
            i: i + 2
        ]
        insert tail pdf-spec compose/deep [
            obj 100 [
                #<< /Type /Pages
                    /Kids [(kids)]
                    /Count (length? pages)
                #>>
            ]
        ]
    ]
    set 'layout-pdf func [spec [block!]] [
        clear pages
        clear used-fonts
        make-docroot
        parse-spec spec
        make-fonts
        make-pages
        make-pdf pdf-spec
    ]
]