REBOL [ Title: "PDF Maker" Author: "Gabriele Santilli " Purpose: { A dialect to create PDF files from REBOL. } Comments: { Thanks to Volker Nitsch for the AFM parser. } File: %pdf-maker.r Date: 10-Jan-2002 Version: 1.21.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 . } ] ] 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 tail data reduce [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 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 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 [ empty-line exit ] lh: any [txtb/lineheight txtb/max-size * txtb/linefactor] 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] ] ; render an empty line empty-line: does [ insert tail txtb/text 'T* ] 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 ] ; dialect rules endp: does [if txtb/in-para? [emit-last append txtb/text [0 -5 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) ]] 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! (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 ] 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 ] ]