Script Library: 1238 scripts
  • Home
  • Script library
  • AltME Archive
  • Mailing list
  • Articles Index
  • Site search
 

Archive version of: pdf-maker.r ... version: 3 ... gabriele 11-Aug-2004

REBOL [
  Library: [
     level: 'advanced
     platform: 'all
     type: 'dialect
     domain: [dialects graphics printing]
     tested-under: none
     support: none
     license: none
     see-also: none
   ]

    Title: "PDF Maker"
    Author: "Gabriele Santilli"
    EMail: giesse@rebol.it
    Purpose: {
        A dialect to create PDF files from REBOL.
    }
    Comments: {
        Thanks to Volker Nitsch <agem@crosswinds.net> for the AFM parser.
    }
    File: %pdf-maker.r
    Date: 23-Jul-2003
    Version: 1.24.0 ; majorv.minorv.status
                    ; status: 0: unfinished; 1: testing; 2: stable
    History: [
        15-Jul-2001 1.1.0 "History start"
        15-Jul-2001 1.2.0 "Added some comments; this will hopefully be appreciated :)"
        15-Jul-2001 1.3.0 "Added graphics system and some primitives"
        15-Jul-2001 1.4.0 "Added coordinate transformations"
        16-Jul-2001 1.5.0 "Added circle (approx) and bezier"
        16-Jul-2001 1.6.0 "(Hopefully) fixed buggy XREF handling"
        17-Jul-2001 1.7.0 "Added paths; now graphics lacks only images"
        17-Jul-2001 1.8.0 "Better decimal handling in PDF-FORM"
        17-Jul-2001 1.9.0 "Added images (not efficient, but works!)"
        21-Jul-2001 1.10.0 "Added font metrics information (THANKS VOLKER!)"
        22-Jul-2001 1.11.0 "Text sizing experiments..."
        26-Jul-2001 1.12.0 "Added text typesetter (alpha version, only justification)"
        26-Jul-2001 1.13.0 "Fixed bugs in justification"
        26-Jul-2001 1.14.0 "Finished typesetting engine"
        27-Jul-2001 1.15.0 "Fixed various bugs"
        31-Jul-2001 1.16.0 "Fixed a nasty bug (layout-pdf wasn't clearing pdf-spec)"
         1-Aug-2001 1.17.0 "Added the ability to disable wrapping"
         9-Aug-2001 1.18.0 "Changed the behaviour of the newline command in textboxes"
         9-Aug-2001 1.19.0 "Changed path-rule a bit; now allows circles in a path too"
        25-Aug-2001 1.20.0 "traslation -> translation (fixed the spelling)"
        10-Jan-2002 1.21.0 {
            Fixed a bug: if a page ended with graphic commands, and the following page
            started with graphic commands, these were rendered in the previous page.
            Added support for the Euro char (€) in font metrics .
        }
        24-Feb-2003 1.22.0 {Uploaded new version with temporary PRECALC-TEXTBOX function.}
        20-Jun-2003 1.23.0 {
            Fixed a bug that caused an error when layouting a string starting with a space
            or a newline
        }
        23-Jul-2003 1.24.0 {
            Small change to PRECALC-TEXBOX, now should add enough space for letters that
            expand below the baseline (as pqg etc.); it is just an hack, and don't expect
            it to really be precise. (That is, the typesetter is too stupid right now
            to take this kind of things into account. Maybe I'll change it, or you'll just
            have to wait for version 2.)
        }
    ]
]

context [
    ; font metrics information for the 14 standard fonts (THANKS VOLKER!)
    ; now handles € (it was somehow left out, don't ask me why :)
    metrics: do decompress 64#{
        eJztnduS1UaWhu/nKfZUXw7YOyWlDnbMBeOO8MyV2zO2aaaDizKU6WoDZQMFTU/M
        QzTDFTd+FcDwAj6F7TARVFGEKTAQ5hScHD3KVH5LqX0q7ZKqqE2J2EJ/6ZDKXGvl
        aelfqX86Nv/pQm/p478sHDr1z70//VMv//fO0vKJxYUTb/X+9KfjS8cXejv4v7jf
        77ZXtIkCptJEbVVOTHXEvUPXb5zA1Jmvnfwu3Q7mTUa+db/ut0t/B3tx9Lv/2Wf+
        /eHNyr9P3uz/IVx6c1m9+WZYHk3/9X8P+p3u3n9bOnq463m7bdLW9byd/Q1sB7ue
        t/vt6l8rPe97Hx9d/Hx5oeuAu23S1nXAnf0NbAe7Drj77epf4w6463y7rcbWdb6d
        /Q1sB7vOt/vt6t+mO99/Xzh6euHU4qH5Weh2gyS1W6h1T+vYbmma9eI46alM9cIw
        LLb8mE6j4tr8b+7jno02uT5PQ7b8uOorbR9mtiQI7Gb/VqqX5DeYv+2Npl3Kj9sM
        5hmw1+bH7X3uOrnP4SyKJG1znEyYLYozm5YpjGQ0f4afYcEmD/lmzpt96t/jNpuO
        Oc99OU7cPWxhmAswLvZGAFYD5uJCFeZql5Lqe1mRA6Yc5o/x2nQZRWvyAHt7mbD7
        Y7DvzZO3wJeJJGEyTm6SMM9I4npOKYk9mp+NzCPyg2I7JJefx37sFuvixjSXB5vR
        k+hsYKtIxT+BUjEQDMkaxsBmcobBJE7kGIyRncnAOCs2NcM3kkHrrlUr0mj0M0h3
        ezrf3839fa63N9fp7+b+LwehAV/kIDPgGuAAYH8OIgM+yoE24AML6j3qXH5trrz8
        rvMF4kSPPIy5YqOEe2TCg0MX/YO8/wY4CzgDOA14hjBeAl4AngOWfYEVub4m6ICg
        /YjKyCwx4AeO/AT4EfChL1cVGPQ+j/kW8D3gK8B3gG8AXwPeA7wLeMcCK5M3cmgf
        sgfwg823y5sib4q8qfK+kPu8tBKOJdMYkr34S45cBVwEXAFcBlwC7LMAFZ8wf+le
        kRdl5fiYnD4FPAA8ATwCPAQsAW4B7gBuA9YBC74wiqfeQI03AdcBa4BVwApgHmBk
        kSKLFFmkyCJFFimySJFF2q8a/TP0+hLwAvAcsAwY0KorR0A5AsoRUI6AcgSUI6Ac
        AeUIKEdAOQLKEVCOgHIElCPoS53V1FlNndVT19DH2MtTwAPAE8AjwEPAEuAW4A7g
        NmAdsAD4lhx+D/gK8B3gG8DXgPfmpAn7B7n+DXAWYNvHWNrHSFqfSFqfSFqfiIqW
        UNGUkqZF9T0reYO87wF8wW3XAAcAf5xzjfV+clXpDKJWFG8rcIrqNKrTqE6jOo3q
        NKrTqE6jOo3qNKrTqE6jOi0VOMXwIww/wvAjDD/C8CMMP8LwpfxKBKBEAkpEoEQG
        SoSgRArKiaFea/wF+b8GOAAY1tEP5PEnwI+ADwEfcNe3qOZ7wFeA7wDfAL4GvFfV
        o9fBiH3H2HdR5rOCzgh6JuiloBeCngtaFvQ2Dzshh94Q9JinPpVDDwQ9EfRI0ENB
        S4L2Sr26RXJ35ORtQeuCFgTtEfQW2bxBGjfl3HVBa4JWBa0Imhf0LUr7HvAV4DvA
        N4CvAe+1banDTUjDDr0wgAT9J6g/QfsJyk/QfVRqXDuNp2g8ReEp+k5Rd4q2U5Sd
        ousUVaeoOkXTKYpO0XNaqlk7NUeoOUHNCVpOUHKCjhNUnKDhpAUFv+vro8Ggoqi3
        AfVWqq3U1dqd8Ruk3XBstpeSTT1Ia6OJb9I0Om1otKHRhkYbGm1otKHRhu77g7ui
        S38p6IWg54KWBb1Ni2NrSYQSlIyNlAyOlIyOlAyPlIyPlAyQCnSXci0Cqk2lkuGT
        kvGTkgGUkhGUkjakQG+R4Rty6Kag64LWBK0KWhE0L8goLdVOaRZ8BfgO8A3ga8B7
        gC9FkFcFXRR0RdBlQZcE7ZurjrpGzk/HDPvOINTTc5VedExtPO1Xy6lG/1ZIR+e8
        Ptse+XhOxhqf+ieV9jM/Jjd/HVkKaQmU9hOzQ1xr6vkAVyxVxvDbOZOTCVCI1YUY
        XYjNhZhciMWFGJybFZ8oRTdOwZ4NPEZETwEPAE8AjwAPAUuAW4A7gNuAdcACJiR5
        shr4DXAWYFsXaVykbZGmRVqW/kYpVexxyiTH1IiKUclDFHN/bySyUUrWvrDB0Ddo
        buD60Nlu6Ipin/bS7V+4/XO3X3b7U3O9yLW88jhr35+5A7/O9exw4bjbH3P7oy6B
        T93+F7e/7/b33P6u2y+6/R4e8JZ7wA0kexNwHbAGWAWsAOZLNZwZX139CaR06Tb7
        TwEPAE8AjwAPAUuAW4A7gNuAdcACoNKT2yM3AdcBa4BVwArAeim0ZD+WzlD6QukK
        pSeUjlD6QekGpaeTjk76OenmpJfDPMuujewrsq/IviL7iuwrsu+azPpNWzm37ou2
        tqO5wWb6oi4MckqnkrSSCiNTGJnCyBRGpjAyhZEpjExhZAojUxiZwsg8C6/tTR+e
        747zuetE/NV2mH+BensScAJwzl6eg8Nz/vCvR/s2lP6GNXa3jiBlGvb6DSBb/HXv
        Ska9K+lk0smkk0knk04mWyWT+kOsnfeyqstRl6NmOdqRmdqSFzutJ7lVGe2mR7M7
        PdqUQ31XXH5wtB+/TSf+65zSyMnyLHq+u5QkJZvY3/K/tDlvUk1INSHVhFRtU3WG
        I6cBz7j9JeAF4DlgGXAKcAFwEnAC8DnA5Dcz4DOOPAY8BTwAPAE8AjwELAF+BRwH
        HAMcBXwK+AvgF8B9wD3AXcAi4M+AI4BPALcAdwC3AeuABcBhwB6E8DNHDgE+BtwA
        3ARcB6wBVgErAEu7HPaNzribfPbL0Dz0ZmYWfSIeIkqiSpSBDXsJ09bibyQOw4u/
        MVEIWaLLaIlJ4TdESeTHNxt+Q74lH174DRER7M1xGwrihe0QaWHjk9w5Nisf7z6b
        X18+JuQlvyZI+yLLgfAbL3Bns+E3ZNTF2IwLv3GJThd+kzYJv0EktcJvBu2BbevD
        b0waG4XfTAguk3wMGIe/YfhDx0vjO7j94Tf2bbb13tl28JqgA4L2c9lHgA+K1rbe
        43oMfc5JiucLVPeKek+owpFD5gnzlZCB1SZ9n0qkp0R6CunFFenV9X3aqJX3yVIL
        nEyb8julsDakeveK+bEt5VXARcAVwGXAJcC+udK/OirIY4KHqRKm06qnphgftDNS
        6L3SiBnvdX+vpZCXMa8Fpg55CZkihEwRQqYIIVOEkClCyBQhnI4k0Wv2JmCj9sA2
        Q5E0Q+ITrdlEliEvWaOIF4mmkFcnw37WBnzewUgF8ReKu1C8heIsFF+huArFG2gl
        VztkLaAChlTAkAoYUgFDKmBIBQypgCHlL2ryVUEXBV0RdFnQJUH75ujBrBioUHbf
        SgSMNGESAROQZECSAUkG6NWChhEwYt0S8BJj3RacATybc33MS8ALwHPAMkCCHU5g
        6hUCXsOgByUzPglwiTGjGDOKMaMYM7L3V4IeUswpxZxSzCnFnFLMKcWcUsTeoIP9
        EkldBVwEXAFcBlwC7KOVGNVLNq7gzxDWS8ALwHPAMmAgnAXNZmg2Q7MZms3QbIZm
        MzSboVkJZ5kuIi4Y0qxELcVoNkazMZqN0WyMZmM0u9nwyJ43dNrqcJYIV16EKy/C
        lRfhyrPgbdqjSh2UULMYTcVoKkZTMZqK0VSMpsqWnD44pA8O6YND+mChL0sVVCgq
        QlHyQkfe58jrHHmbIy9zZIy72ZbP6SdGPzH6idFPjH5i9BOjn7ga4NKnzhTohaDn
        gpYFvY15VD1fBXoq6IGgJ4IeCXooaEnQ9EFgfZQhEeEZyshQRoYyMpSRoYwMZWQo
        I0EZCcpIUEaCMhKUkaAMCa7f0sCVMRVp2Pd+ZK7ykmPMfZuLYDlaTVuRtiJtxVX2
        cnkF9ueB+0a/yxkuy+Fa9/11fALeYMelc86R9s974QIKK27ov52Kme7yc4Rjt0wW
        i/u5nbu5eQO1ehbThMBdT00bzSrq21UdU5XZ2ZSv+Oq8jvTeI04sulcbMXzsXrl8
        2v0pZ3MXuP0k4HOeXwmHaGB0ewFH/Boj82X7iJ85cqgs4hmvQDIaayNitBoxQms8
        /bsVb/7YUETeu8z6VXRYJg1DbqZqGUSAm50tUtpa7UlbPtYotlA6lh4luYAlngSc
        QLfn7H09r8s4PFc6jEhj1BMHLLgbz8zOeKbFX+fnJmXPz92JpBNJJ5JOJJ1ItkAk
        9Xqlnfnyo8tRl6NmOdqRmdqSdwmtJ7lVGe1mPHM7b8azJS7bXXxf6Zfj1nY8zlN5
        jl/PdEbOqHeQJ/b1va/ZrQOjzZl1VM56CVri0M/QF6Q6Kn1Hpe+o9B2V3oCOSr8L
        fWAdlZ4hWkeldzLrqPShNEORNEPiHOuo9BZ0VPqOSt/rqPQDHWxHpQd0VHr00VHp
        Oyo9qHsR01HpOyp9R6XvqPQdlX5ab0N1/thR6Tfzhqqj0gvqxjM7azzT4q/zc5Ny
        R3/tRNKJpBNJJ5KtFUm9XmlnvvzoctTlqFmOdmSmOip9N+MxYAfNeGaFoj4r95V+
        OW7tqPQdlX7G72t268Boc2YdlbNeghao9DNGo7fcZq0rbGHDKlaZao1GL9d7NPqC
        4J1XBOjQE3n0jkduM7hJHr1PdY7ikvfuc939DAs2eTCU6/y82af+PR7Z3Z732PCJ
        u4ctDHMBxsV+BI/ekbordPcpefQuo2htHI/e/TEdjz5uwqO3yYVJPR69T5H3t63n
        0btAjYk8ei8P43j0E2uD49EPHSddS+vbBk97hUcvLhw78r4GOAAY5gR+MFdOhDZ6
        lGWk2rnB+QJxokcexlyxUcK9OZk39cbkp/sC56ivkg7TsOvRRgcmvHIs4VgyjSHJ
        PK0pP96+gHSj4XxoxcijwYvv6TnBMuXVDD00Qw/N0EMz9NAMPTRDjzYoep7RT03K
        r7oxWgguCChHQDkCyhFQjoByBJTDG4Fr6qymzuqpa2gLzPAIK4iwgggriLAC8U1r
        qqmmmmqqqaaaaqqppprqepz+WNpH8dIV6JqgA4L2U7+qnP6qV2NnfodUydRBozqN
        6jSq06hOozqN6jSq06hOozqN6jSq01KBZe7QgAJqnU4iACUSUCICJTJQIgQlUlBB
        zdimgzVI/FUd/UAefwL8CPgQ8AF3NSTxD3UwYt/C6lcyOValtyiggitpu5Q0Xkpa
        LyXNV4He5mEn5FCVBS7cYiWEIyWMIyWUIyWcIyWkIyXErPIrrMLyL07eFrQuaEFQ
        lRAeYGRCCFfSvCppX5U0sEpaWCVNbIFaIPy3Yalb9D3eBP0nqD9B+wnKT9B9VGpc
        91qJ6BDe/3T+b/v4Cu9fvrWboOUEJSfoOEHFCRpOWlDwu74+tpL3X7szbouUWKX7
        o6A6g7Q2mvgWWP5NXzvZFrL015YO29JjW7psFbVkdj9YrURdr8EXq0fOTydwMsRT
        X49ZLdVyqtG/FZK8dZGm3Hxy1Y01hr8kPZW/W/InLYHSfmJ2iGtNPR/giqXKGH47
        Z3IyAWrgBXdDkcnjes8GWghWCCijjElkSCIjkup7ijEvmzbxMmhMShV7nDLJMTWi
        vS9HW/vCBkPfoLmB62FFha4oygW6KRfnplyYm3JRbnZ/aq4XuZZXHmft+zN34Ne5
        nh0uHHf7Y25/1CXwqdv/4vb33f6e2991+0W338MD3nIPuIFkbwKuA9YAq4AVwHyp
        hjO+qKrVdSte9FhwB3AbsA5YAFSDErQroQXXAWuAVcAKwHoptGRf4jaU9IXSFUpP
        KB2h9IPSDUpPJx2d9HPSzUkvh3mWXRvZV2RfkX1F9hXZV2TfNZn1m7Zybi38kG1p
        bno+MaRxDEmTKKjeNCs0TO9NH57vjvO560T81XaYf4F6exJwAnDOXt5zn0cfWHBm
        VPob1tjdOoKUadjrN4Bs8de9Kxn1rqSTSSeTTiadTDqZbJVM6g+xdt7Lqi5HXY6a
        5WhHZmpLXuy0nuRWZbSbHs3u9GhTDvVdcfnB0X78Np34r3NKIyfLs+j57lKSlGxi
        f8v/0ua8STUh1YRUE1JNicBJsJQEFWv3SqAALwDPAcuAU4ALgJOAE4DPASa/mQGf
        ceQx4CngAeAJ4BHgIWAJ8CvgOOAY4CjgU8BfAL8A7gPuAe4CFgF/BhwBfAK4BbgD
        uA1YBywADgP2IISfOXII8DHgBuAm4DpgDbAKWAFY2uWwb3TG3eSzX4ZNh+B8sHhs
        4aT9ksVMxN7ovouN0BIiYkMcUu97D8SV6Lyp4Qaz9z+XsNEm6ST9csuPZ2FfQh9G
        xt6YPLiQB2JtTEyNxN54MTqEZFS+eeAnWv2IhZKMEfcQRZHs/eNyDx+xIJrEi8Ow
        9+QZDb1zfvCNPZ9FvSC3MrPXAbErfGxCnogOfNlN+vhE+V9FW33vAdXgG/I5cLfJ
        7lBOJAmTcXKTRLkw5SRROPYowTf5QXNFiIiNSKLSforj3JgfZNOezkZ/xMJtfvCN
        LZALGYuwjnHBN0m/GnzjPdCPnBq1mWtM+oPbUPBNGUgzvDnLf+XBN1/QB10DHABU
        5vQ2qEFYuV9yzVXARcAVwGXAJcC+Ud3cmHyd46bz9uEjD9dLa8wD7BArYogVMcSK
        3MgqY2RVdCN2aMXoWTN61oyeNaNneVtqEzKjJfumf2N/qBJJKyvq2qvSmIvfR0Hf
        Ar4HfAX4DvAN4GvAe4B3ke47SHd7P25h+14jqwhRRUgqQlCRWKQ8GUMMMcQQQwwx
        xBBDDDHEkmhjhyhKhigMareBO5IFvWbckV7j9dK9GmFniEwfoBTthVO0F1JROYMJ
        kNm2UCF6zXgqzc3UvTDRrs2w4CxgKuFtp5218oEPTaE1hbbgnNSc837ttWZ9DXAA
        sB/wEcA2YAH219hRPCEK5Y9+EyLvnoYd1Y29yl5Dso1zHWlINkuzc8W3vdZVwEXA
        FcBlwCXAPguqLXj9mKGQkUfIyCOUkYdGSXSHIUmGJBmSZFhRZEOTL/06DA9Chgch
        wwNb9mdI/iXgBeA5YBnwNnedAFinCtZir3kKeAB4AngEeAhYAhjXh0p7hevDgr2c
        so6OwBmSBbc5tQ5YAOwhY28BbnDXTa65zpE1wCpghWvmAd+Sn+8BXwG+A3wD+Brw
        HqCVL4FIVJ2EtTb4ssEmVG5B8SqGlr/5eljGDxYaOt59wD3AXcAiYC/avCX33xF0
        W9C6oAVBRShR5kxCGplsyCQyTCLDJLLxJtFwgCoTECUDPyUjPyVDPyVjPyWDPyWj
        PxWWLvkx3/eZashvlz5jXGRLajSd0Mcn9PEJfXxCH5/Qxyf08RaMrtRWoTbwj+4/
        pvuP6f5juv+4Msx8ixze4NRNwHXAGmAVsAKYB9hKTeOqaFwVjauicVU0rorGVXqZ
        5tF+DeuiKEgpRVW06IGgJ4IeCXooaEnQ6PomjW+inJ4suC23rQtaEFRRlVS2FFWl
        qCpFVSmqSlFViqpSGfpR2UIqW0hlC6lsIZUtpLKFDJe3LNbIvpfSAiXeI6DGBdS4
        gBoXUOMskFcoEhp0EOKx8tPFbYDXoFygsIWR+CLAe8v3RgknfPAB50KNV3htzLDK
        Vr83PiRgQD1RGXxhLzo96iJ75nPaqNLb/xnnHnPuKeAB4AngEeAhYAnwK8U4DpB2
        0P/ASXHxHcBtwDpgASC17GeOHLJg+NVLItkv++veVsdjSBPdKGCmrewXORoplO1c
        TK2Bo2+o4bGrDYU0b9K6SeMmbZs0bdKyScPWL5swc8xGUJgR1gVM8yTgBNec47HF
        d1RkwtsgBzUK23WRM9tFtvjrnN11nd2dnDo5dXLq5NTJaZblVKNDnPl3Dd3zd/Pz
        d0AWtsS93nqSW5XRbmI1OxOrIWfj1LDi8BpyLk6A/TpQ/hrrcGv72PjDXmFfubfn
        1WahBe7vf5yaP7p4aGYYwIZg6zGA7eL2rMq/xQTgNAwqVE4hAEPk9QjAEIPNGujC
        6/UW27cEYO9vviJgF3RXqsr/Tcp8+Rxd4eoO8H8pawCNdIDeCQUVCmnkFv6X9Mz5
        KC34v1FasmZ3Dv/XiKhIhjXmJ/F/g9itzB/34xr836QQV4X/2x/D/x23+H7m9FOb
        /jtis/Rf/29H6+XjDJNseCvpv57tHdw2+u+Y2N7Kus2yQLodZlwFXARcAVwGXAJY
        /lxSLztmEmonh+ctmHh4U+XdYAJtwWnAVEseyPx5A5EWs+ePKFHdKbNmyqwZXdlT
        m1jhu1dMme2I1kyZ4+l4vrZDvQq4CLgCuAy4BNjnDaM2XCpa6L26rQfKIlbFuryZ
        G05YhTwFPAA8ATwCPAQsAX4hn/cB9wB3AYuAJqybG1jJTcB1wBpgFbACmAd8KUle
        FXRR0BVBlwVdElS8ZRrBEI6oEBEVIqJCRFSISMTN4E2izyX4XGLPJfRcIs8l8FwE
        KKHlElkugeUSV16Glfd7rSyf3sDwNlyquDbNYeaowrbN/w1wFiCBG19w5BrgAGA/
        4COAXfMl9Z12jfjbO8FjUrZADcJnp/+mgLQnDStFSqVIqRQplSKlUqRUipRKkdbs
        Y0RLlphxDXAAsB/wEeAHMlf3YwIRBh5h4BEGHmHgEQYeYeCl122CjZ8BPAO8BLwA
        PAcsAyrEYHuk4ibKsJIMK8mwkgwrybCSDCuxYAP/0FTEYHEOCTG4IQu0ITG4QfSZ
        q8gkEJFARAIRCUQkEJFApKUjrB1pLwquVv92/H/VmHfL9aXTnNb/VzJ9RcfFyZuC
        rgtaE7QqaEXQvKAWluhSrbQ9E8JYptamMH2toBp+5WF0LdVocbiZz2jmM5r5jGZe
        6PtCI2vowlW4cBUuXIULV+HCVbhwFS5cibZqEE/S0M0umtmqajbBzZ5M52Vv2JAG
        qChARQEqClBRgIoCVBS0o6Ix0+yGTN5i7Q9b7+Vzy/awdwWU3so0YwzVcQLD0awJ
        UjJFqVDiCB7hF2+BERpSp0PqdEidDslCOPgCw1twRjGxUEwsLPgr4AwKlvcRvkdd
        4gJiXS3ZGzRA2xnTaRe9T9p/PiKu4+63D21Mup2KaO2VViTQkk/v79RPj1p/iodV
        uKoWnJzzxp/2YnFlHa6az0YP7lrrWWyt2zO8zrnKkHXQudpJppNMJ5lOMp1kXo1k
        anReM+9c7p6/m5+/A7LQgl+1YQLtZKKbxvRmcxozym1U8RltAIeSa+x2ed3va3ar
        J+mRzpDhww1JmTNGyDQsuqAkjQkhU0UVjl+c6MaETJMGm12RNX8uhEkhZLq/Ic3Z
        /EFw1LHNn38te4hu/G2vM8cd6Q3CpNlHjow3jpDplw2iHcf9hVZHEjJdGhAEIWRG
        Ni1dMBYjNY6QaUroUSJLPqb7Y2M+piuvpJ86BmaWjmVjyvWj2ZhOW5aNGZu/YWPm
        JwpSZdwXNqY5WGFjmuSCsMrGVOPYmBjDwOaLxD8uhpVj2Jj+srz+ZjI2io0J63aS
        AfvK3JCNOS6NRI88/mrYmNqN3yw4AKhw42yIRMGNcR2qBVcBFwFXAJcBlwCW4JXW
        y5dd588+/XyBNjixqcJPeEF7BnAaMNULpnP0IhssdmtnrJZZ0p9m7mqTfh/9NOGY
        9NwKV+bp3ne6tpOaGTF9iJg+yKxBzE8mC01XXpUPDdiXePaCxyL+p4IeCHoi6JGg
        h4KWBFmGpgH3AfcAdwGLgFvUsTuA24B1wAJgj+T0BoduAq4D1gCrgBXAPKCIcEKA
        Bboo6Iqgy4IuCSoinAbe3j1Dxi8BLwDPAcuAN7CA7V7yNkB0IaILEV2I6EJEFyK6
        ENFJcFijeeqED99NRXFtgdkaIrwQ4YUIL0R4YVOfmBR6zJdKKg1kQAsQ0AIE4jeg
        gdR0QOVqbLYBIjggIDggIDggIDggIDggIDggSNpyXjQihVXboAaEnluAO4DbgHXA
        AqDanthDNwHXAWuAVcAKYB7QeLXMV0TObI2TuYHbe2qSl6VJVHooce80XKx1BGeP
        9TmHOZl6PCdzmO31ijmZmJ/G/DTmpzE/jflpzE+XdIhqL9HKx/OsjF4CXgCeA5YB
        W8bS/AXjvA+4B7jLMxcBe9FmMwJnjEG8cgJn40j7CZ/C2lyVrrKr267JskLr5tjV
        cUs1uaF/tumKC1O70FvVzNQ1bkLzu51Ka0i2bdD8jpmSFytsikanZHSKR94esx75
        is94wmfz7B2jP5tnwZE519rvKXOYD2LlRYyiXtqEhOPpXV1JSoiZU7EGq+8MJvrB
        t20V0dEvL05z0ZHBiy5w5iTgcxqx4msGyuU+Yo4YMUeMmCNGzBEj5ogRc8SIZjHg
        6dI+WnAHcBuwDlgAHAbskQz9zKFDgCZfBhl+E2Hbg2KENeaYHJYvA7a9Rmle0qru
        TlFBeiKHC1SDkwC73qjJ0jm5yC44uoUkzq7pxpx2TtPd4q9zzI53zHaS6STTSaaT
        TCeZVyOZGp3XzLulu+fv5ufvgCxsiWu29SS3KqPddKg3g9OhiutqU/DgaOfVlniu
        dmmSQ331RI9V28fGH/ZyNNLDM3y4IS31P5eOzR+fKVZqvyTUwUpVab+68mQcbZqV
        KqS9PA02Q8bLgnJZT59pCrsUVmrolgYdXCZUWKgDy4SaLfOWjBxcJjSKM+FZ+mzU
        oWVC/bz3vWVCR7FuPVaqEB494mGUyzMwOJ3ESjVXNlwmFMbk8DKhE3ipJrdD65WW
        vFQvMxVeqlHkEC/VHBzkpUa6Bi910iqf0/BSx64SGkcjealm8wnFo7Y2eKnW9CdX
        lYPbxkvNGIBmDEAzxp3yFQgZd7axTFONfNmgRPPM8xZMPLypgv+DQc1vgLOAMwCJ
        pyxd7sWXM5hNF+iAoP3Izs6nQ5lPG/AT4EfAh4APJPlqnCRDLc1QSzPU0gy1NEMt
        zVDLgnfpkt8pO966XNOm1M8N/A1iUjKDaWNuYIlSDRcX2UM6TV459doLg2qJYhHg
        XgpwLwU4k6b6rH2IZEMkGyLZEMmGSDZEshbsqM/a26q98RdwrFI+kkP24zaVD9o3
        qCf1J/7lt9KHJv6Nnl++Ai7fvbZg9la2VwEXAVcAlwGXAPuQ6zQ0xZjmJaZ5iWle
        NAKzNbnuGpK23rTFV0yZSqVMpVJmUBZYIjI1L6LmRdS8iJpngSxKdwIttro6nUlw
        EVCNQ+33BlayskfWAQuAKl+R9tPKpsJ3tUcqi5GO4bu2wFfMQuwwxA5D7DDEDkPs
        MMQOQ6nczdmJKDhBwQkKTlBwgoJHsBPTzCm2OPSAQ08Aj+TcQ0FLgox7yc7b7wPu
        Ae5i74uAvXO0cpsIQB6xtmQyzExMICYm8BKTSbTEhu8SpD1q60PySeiqtAVnAc+w
        +Lofkh9eBLZhBY5QZIQiYzrciAocUYEnENXFTyicmwaEdVuB0aBCgwoNKjSo0KBC
        gzIIbfFD8tbQXgJeiJ09F7QsqBLzP2JFeSUMr+El5VVJ8So5XgpFDfNJiyfeohLe
        AdRdQr4S9B+jreKq6xxaA6zKuRVB84JaoAK3orFRM7WK5zHwnH6MYjdDXpzw/faJ
        53su8t2ASuR7gCd04Lv0d3l4hbMosVKNliU0CTBeY7jGaI3BGmM1hmrekrmudDJA
        FskGdcSwncRHPmlVI1v1FnaYZp2EIddwhfUo7NNqhKy3HudjLn8KeAB4AngEeAhY
        Aky95Ka86QmwjQDjCLCOAPMIsI8AAwn0cPYb6LmSo+aLcNYSRLUAw+uhNnOZFYtw
        ulYvpdFLafNSmryUFi+lwUtp79KyFbNDg1MYUmUNT2tsJ+e88b+9WNbrOoqQDs/1
        iLVpmKcaxd81XWpx8nXsU1v87UZHalfirsRdibsSz1qJazTmM+/X7p6/m5+/A7LQ
        1lqbm0+gnUzsmmH+6+M5G+0q2/pjE10yG/lr6nnTXoMExLFW55v02+zi2vmXb+oO
        r2aM9AYNH9403fO/zh77eOnoLDE9E+XofVEmTM8ozKpMz/ycuZ79ppie+b1sllkZ
        ZZUlI2Pl1hSNw17cD4XpGYeOEZrGFaZnEqe9JHJrjGZu7dJ8xG3ybs7Fke4lmRZK
        YBo7WqAu827Sljxlkb1XB6oXmbTyPIR5N2H2knfzdfOgvAdsrrH35ueNPE1eo4z9
        INMz2wHar/Gf4V/GeQcTRInNtDKKcsaS6LCyqX4U9LI0sZJgHznLMdJEYiYBK5G4
        X7EI+wDDSjU3FiDXUxoUMjR6NKlancfFcbBJcezG+dwuzJaaLQjFjq2u+qF76Kgi
        5Fk1RkACSVooOEyjkZstmrcVBNrA8IAjWxK2OgmYmw9uA/uz+3W/nfub0BWfMQd/
        Xz14XLri/57/7JPfLx4/8vH8qZMz0SHnnWSWNxNZrIp9ahqovO1JaX+KDi7Lm84s
        LJrMNJ8LZXnzmhkuv9nnnZ65N8mPp1HeVsWmo8yb33zmFieJ7VwNMT/ReZq6aGa0
        Dno6zNv4/Hycd6S2jUvTYrPPNQ1o1EtVXDS8eX7SvOM12AwY7PG8I83MOcu3N3vy
        nHfMeeOdmI7RNMYmffPsfp6Xft5Jp/nffZNWnkY+qLVlTYvzsWmDM9NcZi5PiWvM
        8wFBqu0+TUJbvqKcLu18S/PnpLYsphymY097KjQDkSTvjnQvzM+ZLTYDhXwr2uk8
        w3ZTid1MTIPZdD+zW5SPMM0WhJHdQrdtdT8c5vqxA6bcJlSxHrbVodlM9swgJ9dP
        HHh626FbauzI6KKfG02kzQguN/ogKvbK4CTfUruluWyNgtOguMZuuV6y0FSAfJSW
        G3OaGiOMiy0XjNms0eRbmjjdGGCklZkakdeENNbFPs9RZm4yOQsLa7IZSPo2M10H
        3P2636S5cPpm3gH/y4gO+OD/A+B97vKunAEA
    }
    ; guess what are these?
    pdf-start: "%PDF-1.3^/"
    pdf-end: "%%EOF"
    ; form a decimal value avoiding scientific format etc.
    form-decimal: func [
        "Form a decimal number"
        num [number!]
        /local str sign float ip fp
    ] [
        if zero? num [return copy "0"]
        sign: either negative? num [
            num: abs num
            "-"
        ] [""]
        str: make string! 20
        num: form multiply power 10 negate float: to-integer log-10 num to-decimal num
        ip: first num
        fp: copy skip num 2
        ; understanding this is left as an exercise to the reader. >:->
        insert/dup
            insert/part
                insert
                    insert/dup
                        insert
                            insert str sign
                            either float < 0 ["0."] [""]
                        #"0"
                        -1 - float
                    ip
                fp
                either float < 0 [tail fp] [float]
            #"0"
            float - length? fp
        if all [float >= 0 float < length? fp] [
            insert insert tail str #"." skip fp float
        ]
        str
    ]
    ; valid characters in strings
    pdf-string-valid: complement charset "()\"
    ; this converts REBOL values to PDF values; it's way from perfect but works.
    pdf-form: func ["REBOL to PDF" value /only /local result mrk1 mrk2] [
        result: make string! 256
        if block? :value [
            if empty? value [return copy "[]"]
            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 decimal? :value [return form-decimal value]
        ; issues are used for tricks. ;-)
        if issue? :value [return form value]
        ; other values simply molded currently.
        mold :value
    ]
    ; this will hold the document's xref table
    xref: []
    ; this will hold the document itself
    contents: #{}

    ; LOWLEVEL PDF DIALECT
    ; (this is what people on the ml were looking for. :)
    pdf-words: context [
        ; creates an object
        obj: func [
            id "Object id (generation will always be 0)"
            data "A block of data (will use PDF-FORM above)"
        ] [
            insert tail xref compose/deep [(id) [(-1 + index? tail contents)]]
            insert tail contents reduce [
                id " 0 obj^/" pdf-form data "^/endobj^/"
            ]
        ]
        ; creates a stream
        stream: func [
            id "Object id (generation will always be 0)"
            data "Block (will use PDF-FORM) or any-string"
        ] [
            insert tail xref compose/deep [(id) [(-1 + 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^/"
            ]
        ]
        ; creates an Image XObject
        image: func [
            id "Object id (generation will always be 0)"
            img [image!] "Image data"
            /local data
        ] [
            insert tail xref compose/deep [(id) [(-1 + index? tail contents)]]
            data: make binary! length? img
            foreach [b g r a] img [
                insert insert insert tail data r g b
            ]
            insert tail contents reduce [
                id " 0 obj^/"
                pdf-form compose [
                    #<< /Type /XObject
                        /Subtype /Image
                        /Width (img/size/x)
                        /Height (img/size/y)
                        /ColorSpace /DeviceRGB
                        /BitsPerComponent 8
                        /Interpolate true
                        /Length (length? data)
                    #>>
                ]
                "^/stream^/"
                data
                "^/endstream^/endobj^/"
            ]
        ]
    ]

    ; guess what's this? :)
    zero-padded: func [val n] [
        val: form val
        head insert insert/dup make string! n #"0" n - length? val val
    ]
    ; makes the xref table for the document
    make-xref: has [pos xref' lastfree firstfree cur] [
        pos: tail contents
        sort/skip xref 2
        xref': clear []
        firstfree: lastfree: 0
        for i 1 pick tail xref -2 1 [
            either cur: select xref i [
                insert/only tail xref' reduce [cur/1 'n]
            ] [
                either firstfree = 0 [firstfree: i] [xref'/:lastfree/1: i]
                lastfree: i
                insert/only tail xref' copy [0 f]
            ]
        ]
        insert pos reduce [
            "xref^/0 " 1 + length? xref' "^/" zero-padded firstfree 10 " 65535 f ^/"
        ]
        foreach item xref' [
            insert tail pos reduce [
                zero-padded item/1 10 " 00000 " item/2 " ^/"
            ]
        ]
        insert tail pos reduce [
            "trailer^/"
            pdf-form compose [
                #<< /Size (1 + length? xref')
                    /Root 1 0 R ; this assumes root will always be 1
                #>>
            ]
            "^/startxref^/"
            -1 + index? pos newline
        ]
    ]
    ; THIS IS THE LOWLEVEL FUNCTION
    ; use this to make a PDF file using the three lowlevel commands defined above
    ; (OBJ, STREAM and IMAGE)
    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
    ]

    ; high level dialect begins here...
    ; this will hold the pages etc.
    pages: []
    used-fonts: []
    font-resources: []
    ; this will hold the spec then passed to MAKE-PDF
    pdf-spec: []
    ; default page object
    default-page: context [
        size: [211 297] ; mm. (ISO A4)
        offset: [0 0]
        rotation: 0
        contents: []
    ]
    ; default textbox object
    default-textbox: context [
        bbox: [10 17 191 263]
        ; default font is Helvetica 4.23 (12pt)
        font-name: 'Helvetica
        font-size: 4.23
        ; last used font (to avoid setting it each time)
        last-font: [none none]
        ; line height handling
        max-size: 0
        linefactor: 1.1
        lineheight: none
        ; last used line height (to avoid setting it each time)
        last-lh: none
        left: right: 0 ; margins
        last-offset: 0 ; current x text offset
        ; this is the amount of space a text line can consume
        ; before being wrapped
        fuel: bbox/3 - left - right ; text width
        wrappers: charset "+-\/"
        no-wrap?: no ; set to yes to disable wrapping
        in-para?: no
        mode: 'justify ; 'left 'right 'center 'as-is
        ; justify: word spacing vs char spacing factor
        word-spacing: 0.5
        ; buffer holding each rendered line
        linebuff: []
        ; buffer holding the entire text
        text: []
        ; text color (default is black)
        color: 0.0.0
        last-color: none
        ; current y position of text (actually, this is a sort of
        ; temporary text-height; text-height gets the maximum value
        ; reached by this word) (needed for automatic page breaks)
        current-y-pos: 0
        ; actual height of text (textbox autosizing, automatic page breaks)
        text-height: 0
        ; space between paragraphs
        para-skip: 5
        to-pdf: does [
            compose [
                q
                (bbox/1) (bbox/2)
                (bbox/3) (bbox/4) re W n
                BT (bbox/1) (bbox/2 + bbox/4) Td (text) ET
                Q
            ]
        ]
    ]
    ; default space object
    default-space: context [
        translate: none ; [x y]
        scale: none ; [sx sy]
        rotate: none ; angle
        skew: none ; [alpha beta]
        contents: []
        to-pdf: has [result] [
            result: make block! 256
            insert result 'q
            ; apply transformations...
            if translate [
                insert tail result reduce [1 0 0 1 translate/1 translate/2 'cm]
            ]
            if rotate [
                insert tail result reduce [
                    cosine rotate sine rotate
                    negate sine rotate cosine rotate 0 0 'cm
                ]
            ]
            if scale [
                insert tail result reduce [scale/1 0 0 scale/2 0 0 'cm]
            ]
            if skew [
                insert tail result reduce [1 tangent skew/1 tangent skew/2 1 0 0 'cm]
            ]
            ; handle contents
            foreach object contents [
                insert tail result object/to-pdf
            ]
            head insert tail result 'Q
        ]
    ]
    ; default graphics object
    default-gfx: context [
        contents: []
        to-pdf: does [
            contents
        ]
    ]
    ; this is a "context" stack; it is used to make spaces work
    stack: []
    push: func [thing] [insert tail stack thing]
    pop: does [if not empty? stack [first reduce [last stack remove back tail stack]]]
    ; this creates the document's root objects
    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 /ImageC]
            ]
        ]
    ]
    new: val1: val2: txtb: gfx: none
    gfx-emit: func [data] [
        if not gfx [insert tail new/contents gfx: make default-gfx []]
        insert tail gfx/contents reduce data
    ]
    ; TEXT TYPESETTER
    typeset-text: none
    emit-line: none
    context [
        sum: chset: widths: kern: prev: char: buff: wbuff: wstr: invalid: wrappers: none
        ; emit first char in a line
        emit-veryfirst: func [char] [
            wbuff: reduce [wstr: to-string char]
            sum: pick widths prev: 1 + to-integer char
            emit-char: :emit-other
        ]
        ; emit first char in a word
        emit-first: func [char /local k] [
            clear wbuff
            either k: select/case pick kern prev char [
                sum: k
                insert insert tail wbuff negate k wstr: to-string char
            ] [
                sum: 0
                insert tail wbuff wstr: to-string char
            ]
            sum: sum + pick widths prev: 1 + to-integer char
            emit-char: :emit-other
        ]
        ; emit any other char
        emit-other: func [char /local k] [
            either k: select/case pick kern prev char [
                sum: sum + k
                insert insert tail wbuff negate k wstr: to-string char
            ] [
                insert tail wstr char
            ]
            sum: sum + pick widths prev: 1 + to-integer char
        ]
        emit-char: :emit-veryfirst
        ; handles spaces at the end of a word; they should not be
        ; rendered if we are at the end of the line
        old-spaces: [0 0 0 [""]]
        spaces: [0 0 0 []]
        emit-space: has [k] [
            if all [prev k: select/case pick kern prev #" "] [
                spaces/3: spaces/3 + k
                spaces/2: spaces/2 - k
            ]
            spaces/1: spaces/1 + 1
            spaces/3: spaces/3 + pick widths prev: 33
            spaces/4: buff
        ]
        ; this actually assumes #"?" is available in any font...
        char-rule: [char: chset (emit-char char/1 bc) | invalid (emit-char #"?" bc)]
        wrapper-rule: [char: wrappers (emit-char char/1 bc)]
        word-rule: [
            [some wrapper-rule any char-rule | some char-rule]
            opt wrapper-rule
            opt [#" " (emit-space) any [#" " (if txtb/mode = 'as-is [emit-space])]]
        ]
        ; needed for justification
        word-chars: word-spaces: 0
        line-chars: line-spaces: 0
        bc: does [word-chars: word-chars + 1]
        bs: does [word-spaces: word-spaces + 1]
        reset-margin: does [
            if txtb/left <> txtb/last-offset [
                insert tail txtb/text reduce [txtb/left - txtb/last-offset 0 'Td]
                txtb/last-offset: txtb/left
            ]
        ]
        set 'emit-line has [lh ofs] [
            if txtb/max-size = 0 [
                return empty-line
            ]
            lh: any [txtb/lineheight txtb/max-size * txtb/linefactor]
            if txtb-vskip lh [
                ;print "overflow"
                return false
            ]
            if lh <> txtb/last-lh [
                insert insert tail txtb/text lh 'TL
            ]
            txtb/last-lh: lh
            insert tail txtb/text 'T*
            switch txtb/mode [
                justify [
                    reset-margin
                    ; no space should be added after the last char!
                    line-chars: line-chars - 1
                    either line-spaces > 0 [
                        if line-chars > 0 [
                            insert tail txtb/text reduce [
                                txtb/fuel * txtb/word-spacing / line-spaces 'Tw
                                1 - txtb/word-spacing * txtb/fuel / line-chars 'Tc
                            ]
                        ]
                    ] [
                        if line-chars > 0 [
                            insert tail txtb/text reduce [
                                txtb/fuel / line-chars 'Tc
                            ]
                        ]
                    ]
                ]
                right [
                    ofs: txtb/left + txtb/fuel
                    insert tail txtb/text reduce [ofs - txtb/last-offset 0 'Td]
                    txtb/last-offset: ofs
                ]
                center [
                    ofs: txtb/left + txtb/fuel / 2
                    insert tail txtb/text reduce [ofs - txtb/last-offset 0 'Td]
                    txtb/last-offset: ofs
                ]
                left [
                    reset-margin
                ]
                as-is [
                    reset-margin
                ]
            ]
            insert tail txtb/text txtb/linebuff
            txtb/fuel: txtb/bbox/3 - txtb/left - txtb/right
            txtb/max-size: 0
            clear txtb/linebuff
            emit-char: :emit-veryfirst
            old-spaces: [0 0 0 [""]]
            line-spaces: line-chars: 0
            insert tail txtb/linebuff reduce [buff: copy/deep [""] 'TJ]
            true
        ]
        ; render an empty line
        empty-line: does [
            if txtb-vskip any [txtb/last-lh 0] [
                return false
            ]
            insert tail txtb/text 'T*
            true
        ]
        emit-word: does [
            sum: sum * txtb/font-size / 1000
            old-spaces/3: old-spaces/3 * txtb/font-size / 1000
            either any [txtb/no-wrap? sum + old-spaces/3 <= txtb/fuel line-chars = 0] [
                ; let's render spaces we did not render before
                if old-spaces/2 <> 0 [
                    insert insert tail old-spaces/4 old-spaces/2 copy ""
                ]
                insert/dup tail last old-spaces/4 #" " old-spaces/1
                line-spaces: line-spaces + old-spaces/1 + word-spaces
                line-chars: line-chars + old-spaces/1 + word-chars
                insert tail buff either integer? wbuff/1 [
                    wbuff
                ] [
                    insert tail last buff wbuff/1
                    next wbuff
                ]
                txtb/fuel: txtb/fuel - sum - old-spaces/3
            ] [
                emit-line
                spaces/4: buff
                if integer? wbuff/1 [wbuff: next wbuff]
                insert tail last buff wbuff/1
                insert tail buff next wbuff
                txtb/fuel: txtb/fuel - sum
                txtb/max-size: txtb/font-size
                line-spaces: word-spaces
                line-chars: word-chars
            ]
            emit-char: :emit-first
            old-spaces: spaces
            spaces: copy [0 0 0 [""]]
            word-spaces: word-chars: 0
        ]
        set 'typeset-text func [text /local wrp] [
            if empty? text [exit]
            replace/all text newline #" "
            txtb/max-size: max txtb/max-size txtb/font-size
            set [widths kern chset] get in metrics txtb/font-name
            if txtb/last-font <> reduce [txtb/font-name txtb/font-size] [
                used-fonts: union used-fonts reduce [txtb/font-name]
                insert tail txtb/linebuff reduce [to-refinement txtb/font-name txtb/font-size 'Tf]
                txtb/last-font/1: txtb/font-name
                txtb/last-font/2: txtb/font-size
            ]
            if txtb/last-color <> txtb/color [
                txtb/last-color: txtb/color
                insert tail txtb/linebuff reduce [
                    c2d txtb/color/1 c2d txtb/color/2 c2d txtb/color/3 'rg
                ]
            ]
            either all [not empty? txtb/linebuff 'TJ = last txtb/linebuff] [
                buff: pick tail txtb/linebuff -2
            ] [
                insert tail txtb/linebuff reduce [buff: copy/deep [""] 'TJ]
            ]
            chset: exclude make bitset! chset wrp: union wrappers: txtb/wrappers charset " ^/"
            invalid: exclude complement chset wrp
            emit-char: :emit-veryfirst
            spaces: copy [0 0 0 [""]]
            parse/all text [
                opt [
                    #" " (emit-space) any [#" " (if txtb/mode = 'as-is [emit-space])]
                    (old-spaces: spaces spaces: copy [0 0 0 [""]])
                ]
                some [word-rule (emit-word) | newline (empty-line)]
            ]
        ]
    ]
    ; sets the current font; notice that the line height is set to
    ; size * 1.1 as a reasonable default.
    use-font: func [name size] [
        txtb/font-name: name
        txtb/font-size: size
    ]
    txtb-vskip: func [amount] [
        txtb/current-y-pos: txtb/current-y-pos + amount
        txtb/text-height: max txtb/text-height txtb/current-y-pos
        txtb/text-height > txtb/bbox/4
    ]
    ; dialect rules
    endp: does [
        if txtb/in-para? [
            emit-last
            txtb-vskip txtb/para-skip
            append txtb/text compose [0 (negate txtb/para-skip) Td] 
            txtb/in-para?: no
        ]
    ]
    end-para: [opt 'end ['p | 'paragraph] (endp)]
    set-wrappers: [
        'wrap (txtb/no-wrap?: no) opt ['on set val1 string! (txtb/wrappers: charset val1)]
      | 'don't 'wrap (txtb/no-wrap?: yes)
    ]
    set-margins: [opt 'with [
        'left 'margin set val1 number! (txtb/left: val1)
      | 'right 'margin set val1 number! (txtb/right: val1)
    ]]
    set-para: [
        set val1 ['justify | 'left 'align | 'right 'align | 'center | 'as-is] (
            endp
            txtb/mode: val1
        )
        any [
            set-margins
          | opt ['with 'word] 'spacing opt 'factor set val1 number! (txtb/word-spacing: val1)
        ] (txtb/fuel: txtb/bbox/3 - txtb/left - txtb/right)
    ]
    font-def: ['font set val1 word! set val2 number! (use-font val1 val2)]
    set-lead: ['line [
        'height set val1 number! (txtb/lineheight: val1)
      | 'factor set val1 number! (txtb/lineheight: none txtb/linefactor: val1)
    ]]
    set-para-skip: [
        'space 'after opt 'paragraphs set val1 number! (txtb/para-skip: val1)
    ]
    draw-text: [set val1 string! (
        txtb/in-para?: yes
        either txtb/mode = 'as-is [
            val1: parse/all val1 "^/"
            if not empty? val1 [
                typeset-text val1/1
                foreach text next val1 [
                    emit-line
                    typeset-text text
                ]
            ]
        ] [typeset-text val1]
    )]
    ; 0-255 -> 0.0-1.0
    c2d: func [val] [divide any [val 0] 255]
    set-color: [set val1 tuple! (txtb/color: val1)]
    vspace: [opt ['vertical] 'space set val1 number! (txtb-vskip val1 append txtb/text reduce [0 negate val1 'Td])]
    emit-last: does [
        either txtb/mode = 'justify [
            txtb/mode: 'left
            append txtb/text [0 Tc 0 Tw]
            emit-line
            txtb/mode: 'justify
        ] [
            emit-line
        ]
    ]
    textbox-rule: [
        some [
            font-def
          | 'newline (emit-line)
          | vspace
          | end-para
          | set-para
          | set-lead
          | draw-text
          | set-color
          | set-wrappers
          | set-para-skip
        ] end (emit-last)
    ]
    gfxstate-words: context [
        butt: 0 round: 1 square: 2
        miter: 0 bevel: 2
    ]
    gfxstate-rule: [
        'width set val1 number! (gfx-emit [val1 'w])
      | 'cap set val1 ['butt | 'round | 'square] (
            gfx-emit [get in gfxstate-words val1 'J]
        )
      | 'join set val1 ['miter | 'round | 'bevel] (
            gfx-emit [get in gfxstate-words val1 'j]
        )
      | 'miter 'limit set val1 number! (gfx-emit [val1 'M])
      | 'dash [
            'solid (gfx-emit [[] 0 'd])
          | set val1 into [some number!] set val2 number! (gfx-emit [val1 val2 'd])
        ]
    ]
    color-rule: [opt ['color] set val1 tuple! (gfx-emit [c2d val1/1 c2d val1/2 c2d val1/3])]
    sc-rule: [color-rule (gfx-emit ['RG])]
    fc-rule: [color-rule (gfx-emit ['rg])]
    box-rule: [
        copy val1 4 number! (
            gfx-emit [val1/1 val1/2 val1/3 val1/4 're]
        )
    ]
    lineopt-rule: [any [gfxstate-rule | sc-rule]]
    boxopt-rule: [any ['line gfxstate-rule | sc-rule]]
    sboxopt-rule: [any ['edge gfxstate-rule | 'edge sc-rule | fc-rule]]
    circle-rule: [
        copy val1 3 number! (
            ; approximates a circle; error should be less than 1%
            gfx-emit [
                val1/1 + val1/3 val1/2 'm
                val1/1 + val1/3 val1/3 * 0.55 + val1/2
                val1/3 * 0.55 + val1/1 val1/2 + val1/3
                val1/1 val1/2 + val1/3 'c
                -0.55 * val1/3 + val1/1 val1/2 + val1/3
                val1/1 - val1/3 val1/3 * 0.55 + val1/2
                val1/1 - val1/3 val1/2 'c
                val1/1 - val1/3 -0.55 * val1/3 + val1/2
                -0.55 * val1/3 + val1/1 val1/2 - val1/3
                val1/1 val1/2 - val1/3 'c
                0.55 * val1/3 + val1/1 val1/2 - val1/3
                val1/1 + val1/3 -0.55 * val1/3 + val1/2
                val1/1 + val1/3 val1/2 'c 'h
            ]
        )
    ]
    move-to: ['move opt 'to]
    line-to: ['line opt 'to]
    boxpath-rule: ['box copy val1 4 number! (gfx-emit [val1/1 val1/2 val1/3 val1/4 're])]
    path-rule: [some [boxpath-rule | 'circle circle-rule | shape-rule]]
    shape-rule: [
        opt move-to copy val1 2 number! (gfx-emit [val1/1 val1/2 'm]) some [
            opt line-to copy val1 2 number! (gfx-emit [val1/1 val1/2 'l])
          | move-to copy val1 2 number! (gfx-emit [val1/1 val1/2 'm])
          | 'bezier copy val1 6 number! (gfx-emit [val1/1 val1/2 val1/3 val1/4 val1/5 val1/6 'c])
          | 'bezier 'to copy val1 4 number! (gfx-emit [val1/1 val1/2 val1/3 val1/4 'v])
          | 'bezier 'from copy val1 4 number! (gfx-emit [val1/1 val1/2 val1/3 val1/4 'y])
          | 'close (gfx-emit ['h])
        ]
    ]
    contents-rule: [
        any [
            'textbox (gfx: none insert tail new/contents txtb: make default-textbox [])
            opt [copy val1 4 number! (change txtb/bbox val1 txtb/fuel: val1/3 - txtb/left - txtb/right)]
            into textbox-rule
          | 'apply (
                push new
                gfx: none
                insert tail new/contents new: make default-space []
            ) any [
                'translation copy val1 2 number! (new/translate: val1)
              | 'rotation set val1 number! (new/rotate: val1)
              | 'scaling copy val1 2 number! (new/scale: val1)
              | 'skew copy val1 2 number! (new/skew: val1)
            ] into contents-rule (new: pop gfx: none)
          | 'line lineopt-rule opt [
                copy val1 4 number! (gfx-emit [val1/1 val1/2 'm val1/3 val1/4 'l 'S])
            ]
          | 'bezier lineopt-rule copy val1 8 number! (
                gfx-emit [
                    val1/1 val1/2 'm
                    val1/3 val1/4 val1/5 val1/6 val1/7 val1/8 'c 'S
                ]
            )
          | 'box boxopt-rule box-rule (gfx-emit ['S])
          | 'solid 'box sboxopt-rule box-rule (gfx-emit ['B])
          | 'circle boxopt-rule circle-rule (gfx-emit ['S])
          | 'solid 'circle sboxopt-rule circle-rule (gfx-emit ['B])
          | 'stroke boxopt-rule into path-rule (gfx-emit ['S])
          | 'fill (val2: 'f) any [fc-rule | 'even-odd (val2: 'f*)] opt [into path-rule (gfx-emit [val2])]
          | 'paint (val2: 'B) any [
                'edge gfxstate-rule | 'edge sc-rule | fc-rule | 'even-odd (val2: 'B*)
            ] into path-rule (gfx-emit [val2])
          | 'clip opt 'to (val2: 'W) opt ['even-odd (val2: 'W*)] into path-rule (gfx-emit [val2 'n])
          | 'image (
                push new
                gfx: none
                insert tail new/contents new: make default-space []
            ) opt 'at copy val1 2 number! (new/translate: val1)
            opt 'size copy val1 2 number! (new/scale: val1) any [
                'rotated set val1 number! (new/rotate: val1)
              | 'skew copy val1 2 number! (new/skew: val1)
            ]  set val1 [image! | file! | word!] (
                if word? val1 [val1: get val1]
                if file? val1 [val1: load val1]
                insert insert tail used-images val2: join "Img" length? used-images val1
                gfx-emit [to-refinement val2 'Do]
                new: pop gfx: none
            )
        ]
    ]
    page-rule: [
        (insert tail pages new: make default-page [] gfx: none)
        opt ['page any [
            'size set val1 number! set val2 number! (new/size: reduce [val1 val2])
          | 'rotation set val1 integer! (new/rotation: val1)
          | 'offset set val1 number! set val2 number! (new/offset: reduce [val1 val2])
        ]]
        contents-rule
    ]
    ; dialect parser
    parse-spec: func [spec] [
        parse spec [some [into page-rule]]
    ]
    ; this creates the font objects in the PDF file
    ; only the 14 standard PDF fonts supported currently
    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
        ]
    ]
    image-resources: []
    used-images: []
    ; this creates the Image XObjects in the PDF file
    make-images: has [i] [
        i: 101 + (2 * length? pages)
        clear image-resources
        foreach [name image] used-images [
            insert tail image-resources reduce [to-refinement name i 0 'R]
            insert tail pdf-spec compose/deep [
                image (i) (image)
            ]
            i: i + 1
        ]
    ]
    ; guess what's this? ;)
    mm2pt: func [mm] compose [mm * (72 / 25.4)]
    ; this creates the page objects
    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 []
            insert tail stream compose [(mm2pt 1) 0 0 (mm2pt 1) (mm2pt page/offset/1) (mm2pt page/offset/2) cm]
            foreach object page/contents [
                insert tail stream object/to-pdf
            ]
            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
                            (either empty? font-resources [] [compose [/Font #<< (font-resources) #>>]])
                            (either empty? image-resources [] [compose [/XObject #<< (image-resources) #>>]])
                        #>>
                    #>>
                ]

                stream (i + 1) [
                    (stream)
                ]
            ]
            i: i + 2
        ]
        insert tail pdf-spec compose/deep [
            obj 100 [
                #<< /Type /Pages
                    /Kids [(kids)]
                    /Count (length? pages)
                #>>
            ]
        ]
    ]
    ; MAIN FUNCTION - takes a dialect block and returns a binary
    set 'layout-pdf func [
        "Layout a PDF file (based on the provided spec)"
        spec [block!] "PDF contents, see documentation for details"
    ] [
        clear pages
        clear used-fonts
        clear used-images
        clear pdf-spec
        make-docroot
        parse-spec spec
        make-images
        make-fonts
        make-pages
        make-pdf pdf-spec
    ]
    ; quick hack to allow the creation of tables and so that things like 
    ; MDP will be able to use the PDF Maker
    set 'precalc-textbox func [
        "Precalculate a textbox, to get its vertical space"
        width [number!] "Width of the textbox"
        spec [block!] "Textbox spec"
    ] [
        txtb: make default-textbox [
            bbox/3: width
            fuel: width - left - right
        ]
        parse spec textbox-rule
        first reduce [(any [txtb/last-lh 0]) * 0.1818 + txtb/text-height txtb: none]
    ]
]
Notes