The main function is layout-pdf, lets see an example:
a: [
[
line 10 281 201 281
line 10 16 201 16
textbox 10 250 191 30 [center font Helvetica 20
"REBO License"]
textbox 10 20 191 230 [
(system/license)
]
apply rotation 20 translation 180 255 [
solid box 200.200.200 edge width 0.2 0 0 26 16
textbox 3 3 20 7 [
center font Helvetica 3
"APPROVED"
]
]
]
]
write/binary %license.pdf layout-pdf compose/deep aHere is the result:
The guide is here: http://www.colellachiara.com/soft/Misc/pdf-maker-doc.pdf
Here is the source:
REBOL [
Title: "PDF Maker"
Purpose: {
A dialect to create PDF files from REBOL.
}
Author: "Gabriele Santilli"
EMail: giesse@rebol.it
Comments: {
Thanks to Volker Nitsch <volker.nitsch@gmail.com> for the AFM parser.
}
File: %pdf-maker.r
License: {
Copyright (c) 2001-2006, Gabriele Santilli
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* The name of Gabriele Santilli may not be used to endorse or
promote products derived from this software without specific
prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.
}
Date: 3-Aug-2006
Version: 1.27.1 ; 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.)
}
11-Aug-2005 1.25.1 "Port to View 1.3; backported some changes from version 2"
2-Jun-2006 1.26.1 "Fixed a bug with images"
3-Aug-2006 1.27.1 "Fixed a bug (make-images returning none if there where no images)"
]
]
context [
; font metrics information for the 14 standard fonts (THANKS VOLKER!)
; now handles € (it was somehow left out, don't ask me why :)
metrics: load decompress 64#{
eJztnVmT1UaWx9/7U9wpv4LjpqTUYj8x3maeHJ6xzTCOeihDNV1tTNlAQdMT8yGa
4YkXfxXA8AW8he0wEaxhCgyE2YLN0aNM5e8odbfSLekWdSkRV+hfWlKZ55zcjv4n
9donq5/+dXn/sX/pffKnt1bXjqwsH3mj98knh1cPL/e28X9xv99tL2kTBUylidqq
nJjqiHuHrt84gakzXzv5Hbot5k1GvnW/7rdDf4u91/7nT333792R/5J33327/+7b
76TvvvPO20lxoPrvT/+7SCe8+19XDx3oeuJum7R1PXFnfwPbYtcTd78d/ZtJT/z+
p4dWvlxb7jrkbpu0dR1yZ38D22LXIXe/Hf1rvUPuOuNuq7F1nXFnfwPbYtcZd78d
/WutM/635UPHl4+t7F+ah244SFK7hVr3tI7tlqZZL46TnspULwzDYsuP6TQqrs3/
5j7u2WiT6/M0ZMuPq77S9mFmS4LAbvZvpXpJfoP5295o2qn8uM1gngF7bX7c3ueu
k/sczqJI0jbHyYTZojizaZnCSEbzZ/gZFmzykG/mvNmn/j1us+mY89yX48TdwxaG
uQDjYm8EYDVgLi5UYa52Kam+lxU5YMph/hivTZdRtCYPsLeXCbs/BvviPHkLfJlI
Eibj5CYJ84wkrieVktij+dnIPCI/KLZDcvl57MdusS5uTHN5sBk9ic4GtopU/BMo
FQPBkKxhDGwmZxhM4kSOwRjZmQyMs2JTM3wjGbTuWrUijUY/g3S3pjN+beEfC73d
uU5fW/i/HIQGfJWDzIBLgH2AvTmIDPg4B9qADy2o96hT+bW58vK7TheIEz3yMOaK
jRLukQkPDl30T/L+B+Ak4ATgOOApwngBeA54BljzBVbk+pKgfYL2Iiojs8SAnzjy
C+BnwEe+XFVg0Ac85nvAj4BvAD8AvgN8C3gf8B7gLQusTF7PoX3ILsBPNt8ub4q8
KfKmyvtC7vPSSjiWTGNI9uKvOXIRcBZwAXAecA6wxwJUfMT8pXtFXpSV4yNy+gRw
H/AY8BDwALAKuAm4DbgFWAcs+8IonnoNNd4AXAZcB1wFXAEsAYwsUmSRIosUWaTI
IkUWKbJI+1Wjf4peXwCeA54B1gADWnXlCChHQDkCyhFQjoByBJQjoBwB5QgoR0A5
AsoRUI6AcgR9qbOaOqups3rqGvoIe3kCuA94DHgIeABYBdwE3AbcAqwDlgHfk8Mf
Ad8AfgB8B/gW8P6CNGH/JNd/AE4CbPsYS/sYSesTSesTSesTUdESKppS0rSovmcl
r5P3XYCvuO0SYB/gvxZcY72XXFU6g6gVxdsKnKI6jeo0qtOoTqM6jeo0qtOoTqM6
jeo0qtOoTksFTjH8CMOPMPwIw48w/AjDjzB8Kb8SASiRgBIRKJGBEiEokYJyYqjX
Gn9F/i8B9gGGdfQTefwF8DPgI8CH3PU9qvkR8A3gB8B3gG8B71f16HUwYt8x9l2U
+aSgE4KeCnoh6LmgZ4LWBL3Jw47IodcFPeKpT+TQfUGPBT0U9EDQqqDdUq9uktxt
OXlL0LqgZUG7BL1BNq+Rxg05d1nQdUFXBV0RtCToe5T2I+AbwA+A7wDfAt5v21KH
m5CGHXphAAn6T1B/gvYTlJ+g+6jUuHYaT9F4isJT9J2i7hRtpyg7Rdcpqk5RdYqm
UxSdoue0VLN2ao5Qc4KaE7ScoOQEHSeoOEHDSQsKfs/XR4NBRVFvA+qtVFupq7U7
49dJu+HYbDclm3qQ1kYT36RpdNrQaEOjDY02NNrQaEOjDd33B3dFl/5C0HNBzwSt
CXqTFsfWkgglKBkbKRkcKRkdKRkeKRkfKRkgFegO5VoBVJtKJcMnJeMnJQMoJSMo
JW1Igd4gw9fk0A1BlwVdF3RV0BVBS4KM0lLtlGbBN4AfAN8BvgW8D/haBHlR0FlB
FwSdF3RO0J6F6qhr5Px0zLDvBEI9vlDpRcfUxuN+tZxq9G+FdGjB67PtkU8XZKzx
mX9SaT/zY3Lzt5GlkJZAaT8xO8S1pp4PcMVSZQy/lTM5mQCFWF2I0YXYXIjJhVhc
iMG5WfGRUnTjFOzZwCNE9ARwH/AY8BDwALAKuAm4DbgFWAcsY0KSJ6uBPwAnAbZ1
kcZF2hZpWqRl6W+UUsUep0xyTI2oGJU8RDH390YiG6Vk7QsbDH2D5gauD53thq4o
9mkv3P652z9z+zW3P7bQi1zLK4+z9v2FO/D7Qs8OFw67/eduf8gl8Jnb/+b299z+
rtvfcfsVt9/FA95wD7iGZG8ALgOuA64CrgCWSjWcGF9d/QmkdOk2+08A9wGPAQ8B
DwCrgJuA24BbgHXAMqDSk9sjNwCXAdcBVwFXANZLoSX7sXSG0hdKVyg9oXSE0g9K
Nyg9nXR00s9JNye9HOZZdm1kX5F9RfYV2VdkX5F912TWb9rKuXVftLUVzQ020xd1
YZBTOpWklVQYmcLIFEamMDKFkSmMTGFkCiNTGJnCyBRG5ll4bW/68Hx3nM9dJ+Kv
tsP8M9Tbo4AjgFP28hwcWPCHfz3at6H0N6yxO3UEKdOwV28A2eKve1cy6l1JJ5NO
Jp1MOpl0MpmVTOoPsbbfy6ouR12OmuVoW2ZqJi92Wk9yVhntpkfzOz3alEN9R1y+
ONqP36YT/1VOaeRkeR49311KkpJN7O/5X9qcN6kmpJqQakKqtqk6wZHjgKfc/gLw
HPAMsAY4BjgDOAo4AvgSYPKbGfAFRx4BngDuAx4DHgIeAFYBvwMOAz4HHAJ8Bvgr
4DfAPcBdwB3ACuAvgIOAPwNuAm4DbgHWAcuAA4BdCOFXjuwHfAq4BrgBuAy4DrgK
uAKwtMth3+icu8nnvwzth+LMzaJRxEdESVSJOrBhMGHaWjyOxGV48TgmKiFLdBk9
MSkch6iJ/Phmw3HIt+TDC8chQoK9OW5DQ7wwHiIvbLySO8dm5ePdZ/Pry8eEwOTX
BGlfZDkQjuMF8mw2HIeMupibceE4LtHpwnHSJuE4iKRWOM6gPbDNPhzHpLFROM6E
YDPJx4Bx+BuGP3S8NL7FrQ/HsW+3rTfPtouXBO0TtJfLPgZ8WLS+9R7XYyh0SlI8
XaC6V9R7QhWOHEJPmL+EDLQ26QtVIj0l0lNIL65Ir64v1EaxfECWWuBo2pTfKoW1
IfW7V8yXbSkvAs4CLgDOA84B9iyU/tZRQR8TPE6VsJ1WPTfFeKGdkUPvpUbQeK//
ey2FwIx5TTB1CEzIlCFkyhAyZQiZMoRMGUKmDOF0pIleszcDG7UHthmKpBkSH2nN
JrIMgckaRcBIdIW8Shn2uzbg9w5GLoj/UNyH4j0U56H4DsV1KN5BK7naIWwBFTCk
AoZUwJAKGFIBQypgSAUMKX9Rky8KOivogqDzgs4J2rNAD2bFQIWy+1YiYqQJk4iY
gCQDkgxIMkCvFjSMiBHrlgCYGOu24ATg6YLrY14AngOeAdYAEvxwBFOvEPIaBkEo
mQFKwEuMGcWYUYwZxZiRvb8SBJFiTinmlGJOKeaUYk4p5pQi9gYd7NdI6iLgLOAC
4DzgHGAPrcSoXrJxBX+KsF4AngOeAdYAA+EtaDZDsxmazdBshmYzNJuh2QzNSnjL
dBFywZBmJYopRrMxmo3RbIxmYzQbo9nNhkv2vKHTrMNbIlx7Ea69CNdehGvPgjdp
jyp1UELPYjQVo6kYTcVoKkZTMZoqW3L64JA+OKQPDumDhc4sVVChqAhFyQseeb8j
r3fk7Y683JEx7mZbPqefGP3E6CdGPzH6idFPjH7iasBLnzpToOeCnglaE/Qm5lH1
hBXoiaD7gh4LeijogaBVQdMHhfVRhkSIZygjQxkZyshQRoYyMpSRoYwEZSQoI0EZ
CcpIUEaCMiTYfqaBLGMq0rAv/uBC5aXHmPs2F9FyqJq2Im1F2oqr7OXySuwvA/eN
frczXJYDte772/gEvMGOS+eUI/Gf9sIHFFbc0J87FVPd5ecgx26aLBb3czt3c/MG
avUspgmhu56aNppV1LerOqYqs7MpX/nVeT3pvVecWHSvNmL42L1y+bT7Y87mznD7
UcCXPL8SHtHA6HYDDvo1RubL9hG/cmR/WcQTXoFkNNZGBGk1goTWePp3Ld78saGI
vHeb9avosEwahuBM1TKIADc7W6S0tdqTtnysUWyhdCw9SnIGSzwKOIJuT9n7el6X
cWChdBiRxqgnDlhwN56Zn/FMi7/Oz03Knp+7E0knkk4knUg6kcxAJPV6pe358qPL
UZejZjnalpmaybuE1pOcVUa7Gc/C9pvxzMRlu4PvK/1y3NqOx3kqz/Grmc7IGfU2
8sS+uvc1u3VgtDm3jsp5L8GMOPVz9MWpjlrfUes7an1HrTego9bvQJ9YR61nyNZR
653MOmp9KM1QJM2QOMs6ar0FHbW+o9b3Omr9QAfbUesBHbUefXTU+o5aD+pezHTU
+o5a31HrO2p9R62f1ttQnT921PrNvLHqqPWCuvHM9hrPtPjr/Nyk3NFhO5F0IulE
0olktiKp1yttz5cfXY66HDXL0bbMVEet72Y8BmyjGc+8UNbn5b7SL8etHbW+o9bP
+X3Nbh0Ybc6to3LeSzADav2c0eot11nrCnvYsIxVplqj1cv1Hq2+IHznFQN69ERe
veOV2wxuklfvU5+juOTB+9x3P8OCTR4MBTs/b/apf49HfrfnPXZ84u5hC8NcgHGx
H8GrdyTvCv19Sl69yyhaG8erd39Mx6uPm/DqbXJhUo9X71Pm/W32vHoXuDGRV+/l
YRyvfmJtcLz6oeOka2l+W+B5r/DqxaVjR+KXAPsAwxzBDxfKidFGj7IMVTtXOF0g
TvTIw5grNkq4tyDzqN6Y/HRf7Bz1FdNhWnY9GunABFiOJRxLpjEkmbc15cvbF5Ju
dJwPtRiJNHgRPj1HWKbAmqGIZiiiGYpohiKaoYhmKNIGZc8z+qlJ+lW3RgvBBgHl
CChHQDkCyhFQjoByeCNyTZ3V1Fk9dQ1tgSkeYQURVhBhBRFWIL5qTTXVVFNNNdVU
U0011VRTXY/jH0v7KF67Al0StE/QXupXleNf9XJsz++WKplKaFSnUZ1GdRrVaVSn
UZ1GdRrVaVSnUZ1GdVoqsMwlGlBCrRNKBKBEAkpEoEQGSoSgRAoqqBnrtFiD1F/V
0U/k8RfAz4CPAB9yV0NS/1AHI/YtLH8lk2VVeo8CKriStktJ46Wk9VLSfBXoTR52
RA5VWeHCNVZCQFLCQFJCQVLCQVJCQlJC1Cq/2iqs/+LkLUHrgpYFVQniAUYmBHEl
zauS9lVJA6ukhVXSxBaohQCANix1Rt/vTdB/gvoTtJ+g/ATdR6XGda+VCA+JA5jO
H24fX4kDkG/zJmg5QckJOk5QcYKGkxYU/J6vj1nGAdTujNsiKVbp/yioziCtjSa+
BdZ/09dQtoUs/belA7f04JYuXEUtmd8PXCtR1yvwheuR89MJHA3x3NdjWku1nGr0
b4Ukb2GkKTefaHVjjeEvT0/l/5b8SUugtJ+YHeJaU88HuGKpMobfypmcTIAaeMXd
UGTyuN6zgRaCFwLKKGMSGZLIiKT63mLMy6dNvBwak1LFHqdMckyNaO9L09a+sMHQ
N2hu4HpYUqErinKBb8rFvSkX9qZc1JvdH1voRa7llcdZ+/7CHfh9oWeHC4fd/nO3
P+QS+Mztf3P7e25/1+3vuP2K2+/iAW+4B1xDsjcAlwHXAVcBVwBLpRpO+KKqVtdZ
vPix4DbgFmAdsAyoBiloV0ILLgOuA64CrgCsl0JL9iWOQ0lfKF2h9ITSEUo/KN2g
9HTS0Uk/J92c9HKYZ9m1kX1F9hXZV2RfkX1F9l2TWb9pK+fWwhfZkuam5xNFGseU
NImK6k2zYsP03vTh+e44n7tOxF9th/lnqLdHAUcAp+zlPfc59YEFaEalv2GN3akj
SJmGvXoDyBZ/3buSUe9KOpl0Mulk0smkk8msZFJ/iLX9XlZ1Oepy1CxH2zJTM3mx
03qSs8poNz2a3+nRphzqO+LyxdF+/Dad+K9ySiMny/Po+e5SkpRsYn/P/9LmvEk1
IdWEVBNSTYnISbCUBBVr90qgAM8BzwBrgGOAM4CjgCOALwEmv5kBX3DkEeAJ4D7g
MeAh4AFgFfA74DDgc8AhwGeAvwJ+A9wD3AXcAawA/gI4CPgz4CbgNuAWYB2wDDgA
2IUQfuXIfsCngGuAG4DLgOuAq4ArAEu7HPaNzrmbfP7L0FpIzocrny8ftV+6mItY
HN13sRJaQkZsyEPqfQ+COBOdNz3cYPb+5xQ22iSdpF9u+fEs7EsoxMhYHJMHFwJB
7I2JsZFYHC9mhxCNyjcR/ESrH7lQkjHiIKIokr1/XO7hIxdEl3hxGfaePKOhd84P
xrHns6gX5FZn9jogloWPUcgT0YEvu0kfpyj/q2ir7z2gGoxDPgfuNtkdyokkYTJO
bpIoF6acJCrHHiUYJz9orggRsRFJVNpPcZwb84Ns2tPZ6I9cuM0PxrEFciFkEdYx
Lhgn6VeDcbwH+pFUozZzjUl/cBsKxikDa4Y3Z/kvPRjnK/qkS4B9gMoc3wY5CEv3
a665CDgLuAA4DzgH2DOq2xuTr1PcdNo+fOThemmNeYAdckUMuSKGXJEbaWWMtIpu
xQ61GE1rRtOa0bRmNC1vT21CZvRk3/xv7B9VImllRV171Rpz8Qco6HvAj4BvAD8A
vgN8C3gf8B7SfQvpbu3HL2xfbGQVIaoISUUIKhKLlCdjiCGGGGKIIYYYYoghhlgS
b+yQRcmQhUHuFnBJsqDXjEvSa7yeulcj7IyR6QQUo91wjHZDMipnNAEy2xJqRK8Z
b6W5mboXKNq1GRacBEwlvK20s1Y+AKIptKbQFpySmnPar73WrC8B9gH2Aj4G2AYs
wP4aO44nRKX8l9+EyLuoYcd1Yy+z15Bs4dxHGpLN0u5c8W2vdRFwFnABcB5wDrDH
gmoLXj+GKGTkETLyCGXkoVES3WFIkiFJhiQZVhTZ0ORLPw/Dg5DhQcjwwJb9KZJ/
AXgOeAZYA7zJXUcA1smCtdhrngDuAx4DHgIeAFYBxhWi0l7hCrFgN6es4yNwhmTB
LU6tA5YBu8jYG4Br3HWDay5z5DrgKuAK1ywBvic/PwK+AfwA+A7wLeB9QCtfCpEo
OwlzbfDlg02o3ILi1Qwtf/P1soxfLDT0vHuAu4A7gBXAbrR5U+6/LeiWoHVBy4KK
0KLMmYQ0MtmQSWSYRIZJZONNouEAVSYgSgZ+SkZ+SoZ+SsZ+SgZ/SkZ/Kixd9GO+
/zPVkN8ujca4yJbUaDqhj0/o4xP6+IQ+PqGPT+jjLRhdqa1CbSAg3X9M9x/T/cd0
/3FlmPkGObzGqRuAy4DrgKuAK4AlgK3UNK6KxlXRuCoaV0XjqmhcpZdpHv3XsC6K
gpRSVEWL7gt6LOihoAeCVgWNrm/S+CbK6cmCW3LbuqBlQRVVSWVLUVWKqlJUlaKq
FFWlqCqVoR+VLaSyhVS2kMoWUtlCKlvIcHlmsUf2PZUWKPEfATUuoMYF1LiAGmeB
vFKRUKFFiMjKTxe3AV6DcgHDFkbiKwDvrd/rJZzwQQicCzVe6bUxwypb/d74EIEB
9URlMIa96Pioi+yZL2mjSu//F5x7xLkngPuAx4CHgAeAVcDvFOMwQNpB/wMoxcW3
AbcA64BlgNSyXzmy34LhVzGJZL/sr3uzjs+QJrpRAE1b2S9yNFIoW7nYWgNH31DD
Y1cfCmnepHWTxk3aNmnapGWThq1fNmHmmI2oMCOsM5jmUcARrjnFY4vvrMiEt0EO
ahS26yLntots8dc5u+s6uzs5dXLq5NTJqZPTPMupRoc49+8auufv5OdvgyzMxL3e
epKzymg3sZqfidWQs3FqWHF4DTkXJ8B+HSh/jXW4tX1s/GGvsC/d2/NyszADLvC/
H1s6tLJ/bhjBhnDrMYLt4ves2j9jQnAaBhVqpxCCIfZ6hGCIwmaNdOH5eovxW0Kw
9zdfGbALvitV5QMnZb58zq5wdwf4wJQ1gFY6QPeEkgqlNHIfBpD0zPkoLfjAUVqy
aLcPH9iIqEiGNegn8YGD2K3cH/fjGnzgpBBXhQ/cH8MHHrc4f+b0U5sOPGKzdGD/
b0fz5eMNk2x4lnRgz/YWt4wOPCb2t7KusyygbocdFwFnARcA5wHnAJZPl9TLjpmU
2sniaQsmHt5UeTeYUFtwHDDVkggyn95ApMVs+mNKVHcKrZlCa0Zb9tQmVgDvFVNo
O8I1U+h4Ot6v7WAvAs4CLgDOA84B9njDqg2Xkha6r27rgbLIVbFub+aGF1YhTwD3
AY8BDwEPAKuA38jnPcBdwB3ACqAJC+caVnIDcBlwHXAVcAWwBPhakrwo6KygC4LO
CzonqHjrNIIxHFEhIipERIWIqBCRiJvBnESnS3C6xKZLaLpEpktgughQQs8l8lwC
zyXuvAw77/daWV69geFtuJRxbdrD3FGHbZv/B+AkQAI5vuLIJcA+wF7AxwC7Jkzq
O/Ea8bm3gwelbIEahNdO/80BaU8aVoqUSpFSKVIqRUqlSKkUKZUirdnHiJYsUeMS
YB9gL+BjwE9kru7HBiIMPMLAIww8wsAjDDzCwEsv3AQbPwF4CngBeA54BlgDVIjC
9kjFbZRhJRlWkmElGVaSYSUZVmLBBv6iqYjC4iwSonBDVmhDonCDaDRXkUkgIoGI
BCISiEggIoFIS0dYOxJfFFyt/u34A6sx8Zb7S6c5rT+wZP6KjouTNwRdFnRd0FVB
VwQtCWphCS/VStszIaxlam0K89cKquFXIEbXUo0Wh5v5jGY+o5nPaOaFzi+0soYu
XYVLV+HSVbh0FS5dhUtX4dKV6KsG8SUN3e6imVlVswlu92Q6r3vDhjRARQEqClBR
gIoCVBSgoqAdFY2ZZjdk9hZrg9h6L59ntoe9K6D4VqYZY6iPExiPZs2QkjlKhRLH
8Ag/eQsM0ZA6HVKnQ+p0SBbCwRca3oI0iomFYmJhwd8AJ1CwvJ/wPewSJxDrasle
pwHayhhPuyh+0v7zEXEd9799aGMS7lTEa6+0IoGWfHr/oH56VPtjPKzCXbXg6II3
/rQXiyvrQNV8Nnpw11rPY2vdnuF1zlWGrIPO1U4ynWQ6yXSS6STzciRTo/Oae+dy
9/yd/PxtkIUW/KoNE2gnE900pjef05hRbqOKz2gDOJRcY7fLq35fs1s9SY90hgwf
bpmkOWcETcOqC0oSmRA0VVTh/MWJbkzQNGmw2RVb8+dCoBSCpvsbEp3NH4RHHdv8
+deyh/jG3/Y6c9yR4CBQmn3kyHnjCJp+2SDecdxfiHUkQdOlAWEQgmZk09IFgzFS
4wiapoQeRbLkZ7o/NuZnuvJK+qljZGbpWHamXD+anem0ZdmZsfkbdmZ+oiBZxn1h
Z5qDFXamSS4Iq+xMNY6diTEMbL5I/ONiWDmGnekv2+tvJmOj2JmwcCcZsK/MDdmZ
49JI9MjjL4edqd14zoJ9gApXzoZQFFwZ18FacBFwFnABcB5wDmAJX2m9fNl1AO3T
TxdogxObKvyEF7YnAMcBU71wOkWvssFiuHYGa5km/WnmsjbpD9BPE85Jz62AZZ7u
fddrK6maEdOJiOmEzCLE/GTy0HRlVvkwgX2pZy94JOJ/Iui+oMeCHgp6IGhVkGVs
GnAPcBdwB7ACuEkduw24BVgHLAN2SU6vcegG4DLgOuAq4ApgCVBEQCHAAp0VdEHQ
eUHnBBURUANv854i4xeA54BngDXA61jAVi+JGyC6ENGFiC5EdCGiCxFdiOgkeKzR
vHXCh/Kmory2wHQNEV6I8EKEFyK8sKmPTAo95ssmlQYyoAUIaAEC8SPQQGo6oHK1
NtsAESwQECwQECwQECwQECwQECwQJG05MxqRxKptUAOCz03AbcAtwDpgGVBtT+yh
G4DLgOuAq4ArgCVA49U0XxJZszWO5gZu8KlJX5Y2UemhxN3TcDHXERw+1u8c5mjq
8RzNYfbXS+ZoYn4a89OYn8b8NOanMT9d0iOqvUQrH9uzMnoBeA54BlgDzIy1+RvG
eQ9wF3CHZ64AdqPNZoTOGIN46YTOxpH4Ez6dtbkqXWVbt12TZQXXzbGt45ZqckN/
bdMVGaZ2qbeqmalr3ITmdyuV1pB826D5HTMlL1bgFI1OyfAUD709Zj30FR/yhM/s
2TtGf2bPgoMLrrXfVeYwH8TKixlFvbQJCefTu7qSlBA1p2IRVt8hTPSLb9kqo6Nf
ZhznooODF53hzFHAlzRixdcOlMt9xBwxYo4YMUeMmCNGzBEj5ogRzWLA06V9tOA2
4BZgHbAMOADYJRn6lUP7AU2+HDL8ZsK2B8UIa8wxOSxfEmx7DdO8pFXdHaOC9EQO
Z6gGRwF2PVKTpVNykV2QdIakzq7pxpy2T9Pd4q9zzI53zHaS6STTSaaTTCeZlyOZ
Gp3X3Lulu+fv5OdvgyzMxDXbepKzymg3HerN4XSo4rraFFwc7byaiedqhyY51FdP
9Fi1fWz8YS9HIz08w4dbpqn+x+rnS4fniqXaLwl2sFRV2q+uTBlHm2apCokvT4PN
kPOyoFz202eewjaFpRq6pUMHlxEVVurAMqJmy7wlJQeXEY3iTHiXPjt1aBlRP+99
bxnRUSxcj6UqBEiPiBjl8gwMTiexVM2VDZcRhUE5vIzoBJ6qye3QeqYlT9XLTIWn
ahQ5xFM1Bwd5qpGuwVOdtAroNDzVsauIxtFInqrZfILxqK0Nnqo1/clVZXHLeKoZ
A9KMAWnGOFS+GiHj0DaWcaqRLxu0aJ552oKJhzdV8H8yyPkDcBJwAiDxlqULvvjS
BrPrAu0TtBfZ2fl1KPNrA34B/Az4CPChJF+No2TopRl6aYZemqGXZuilGXpZ8B5d
9FtlR1yXe9qUCrqB/0FMSmY0bcwVLHGq4eIju0inySuoXnthUi1RLgLcTQHupgDn
ks3uC8BzwDPAGuARqn4CuA94DHgIeABYBWz9WpZjfGynqNobfzHHKuVjOWQ/hhP4
imlQT+o7Aspvqw85Aho9v3wlXL6LbcHsrWwvAs4CLgDOA84B9iDXaWiLMc1LTPMS
07xoBGZrct01Jm29aYu/mDK1SplapcyoLLDEZGpeRM2LqHkRNc8CWbTuCFpsdfU6
k+AKoBqn2u8NrHRlj6wDlgFV/iLtp5VNhf9qj1QWKx3Df22Bv5iF2GGIHYbYYYgd
hthhiB2GUrmbsxVRcIKCExScoOAEBY9gK6aZU2xx6D6HHgMeyrkHglYFGXeTncff
A9wF3MHeVwC7F2jlNhGgPGLtyWSYqZhAVEzgKSaTaIoN3y1Ie9TWh+eT0FVpC04C
nmLxdT88P7xIbMMKHKHICEXGdLgRFTiiAk8grovfUDg4DQjstgKjQYUGFRpUaFCh
QYUGZRDa4ofnraG9ADwXO3smaE1QZU2AESvOK2F8DS85r0rKV8n5UihqmF9aPPEm
lfA2oO4S85VFAWK0VVx1mUPXAVfl3BVBS4JaoAa3orFRM7WKJzLwnICMYjdDZpzw
vfeJ53suMt6ASmR8gGd04Dv2d3h4hcMosVONli00CTBeY7jGaI3BGmM1hmrekrqu
dDJAFskGdcSwlURIPoFVI1v1Fn6YZh2FIVdxhQUpbNRqxKy3XucjLn8CuA94DHgI
eABYBUy9JKe8+QmwjQDjCLCOAPMIsI8AAwn0cPYb6LmSo+aLdNYSRLUAw+ulNnOZ
FYt0ulYvpdFLafNSmryUFi+lwUtp79KyFbNDg2MYUmWNT2tsRxe88b+9WNbzOoSQ
Diz0iL1pmKcaxd8xXWpx8lXsU1v87URHalfirsRdibsSz1uJazTmc+/X7p6/k5+/
DbLQ1lqcm0+gnUzsmGH+q+M5G+0qm/2xiS6Zjfw19bxpr0AC4lir8w37LXZxbf/L
N3WHVzNGeoOGD7dG//zPk59/unponpifiXJ0vygT5mcUZlXmZ37OXM9+U8zP/F42
y7SMssqSkrFya47GYS/uh8L8jEPHEE3jCvMzidNeErk1SDO3tmk+Ajd5N+fiSPeS
TAtFMI0dTVCXeTdpS56yyN6rA9WLTFp5HsK82zB7ybv5GnpQ3gM219h78/NGniav
UcZ+kPmZbQPt1/jP8DHjvMMJosRmWhlFOWNJdFjZVD8KelmaWEmwj5zlGGkiMZOA
lUjcr1iEfYBhqZobC5DrKQ0KGRo9mlStzuPiONikOHbjfG4XZkvNFoRix1ZX/dA9
dFQR8qwaIyCBJC0UHKbRyM0WzdsKQm1geMGRLQlbnQTMzYtbwAbtft1v+/5qdc0T
z7+T2K75v5e++PPbK4cPfrp07OhcdNB5p5nlzUYWq2KfmgYrb4tS2qOiw8vypjQL
iyY0zedKWd7cZobrb/Z5J2juTfLjaZS3XbHpOPPmOJ/ZxUliO1tD3E90nqYumh2t
g54O8zY/Px/nHatt89K02OxzTYMa9VIVFw1xnp8074gNNgMIezzvWDNzzvLxzZ48
5x113pgnpqM0jbNJ3zy7n+eln3faaf5336SVp5EPem1Z0+J8bNrkzDSfmctT4hr3
fICQartPk9CWryinSzvf0vw5qS2LKYfp6NOeCs3AJMm7J90L83Nmi83AId+KdjvP
sN1UYjcT82A23c/sFuUjULMFYWS30G2z7pfDXD92AJXbhCrWz7Y6NJvJnhn05PqJ
A09v23RLjR0ZXfRzo4m0GdHlRh9ExV4ZnORbarc0l61RcBoU19gt10sWmgqQj9py
Y05TY4RxseWCMZs1mnxLE6cbA4y0MlMj8pqQxrrY5znKzE0mZ2FhTTYDSd9mpuuQ
u1/3qzdXfje0nfK774zvkBcX/x+JkUJfi50BAA==
}
; guess what are these?
; note: we will actually emit a 1.4 version PDF file, tough
; we'll use the key in the root catalog to state the real version;
; this way we should stay compatible with 1.3 (i.e. Acrobat 4)
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
; now has full support for the alpha channel (PDF 1.4)
; you are required to supply the ID for the SoftMask
image: func [
id "Object id for the image (generation will always be 0)"
aid "Object id for the SoftMask (generation will always be 0)"
img [image!] "Image data"
/local rgb alpha
] [
insert tail xref compose/deep [(id) [(-1 + index? tail contents)]]
; requires View 1.3
rgb: img/rgb
alpha: img/alpha
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
/SMask (aid) 0 R
/Length (length? rgb)
#>>
]
"^/stream^/"
rgb
"^/endstream^/endobj^/"
]
insert tail xref compose/deep [(aid) [(-1 + index? tail contents)]]
; NOTE: I'm not using the Matte key, i.e. I'm assuming that the image
; is not preblended. handling all that would go far beyond the scope of
; the PDF Maker. if you need to use preblended images you could apply the
; inverse formula on the image before passing it to the PDF Maker, or you could
; hack it here adding /Matte for your own purpose... :)
insert tail contents reduce [
aid " 0 obj^/"
pdf-form compose [
#<< /Type /XObject
/Subtype /Image
/Width (img/size/x)
/Height (img/size/y)
/ColorSpace /DeviceGray
/BitsPerComponent 8
/Interpolate true
; REBOL's alpha channel is inverted with respect to PDF's
/Decode [1 0]
/Length (length? alpha)
#>>
]
"^/stream^/"
alpha
"^/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
repeat i pick tail xref -2 [
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]
but: func [a [any-type!] b [any-type!]] [:a]
pop: does [if not empty? stack [but last stack remove back tail stack]]
; this creates the document's root objects
make-docroot: func [pages] [
insert tail pdf-spec [
obj 1 compose [
#<< /Type /Catalog
/Version /1.4
/Outlines 2 0 R
/Pages (pages) 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
gfx-emit [
val1/1 + val1/3 val1/2 'm
val1/1 + val1/3 val1/3 * 0.552 + val1/2
val1/3 * 0.552 + val1/1 val1/2 + val1/3
val1/1 val1/2 + val1/3 'c
-0.552 * val1/3 + val1/1 val1/2 + val1/3
val1/1 - val1/3 val1/3 * 0.552 + val1/2
val1/1 - val1/3 val1/2 'c
val1/1 - val1/3 -0.552 * val1/3 + val1/2
-0.552 * val1/3 + val1/1 val1/2 - val1/3
val1/1 val1/2 - val1/3 'c
0.552 * val1/3 + val1/1 val1/2 - val1/3
val1/1 + val1/3 -0.552 * 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
]
i
]
image-resources: []
used-images: []
; this creates the Image XObjects in the PDF file
make-images: func [i] [
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) (i + 1) (image) ]
i: i + 2
]
i
]
; guess what's this? ;)
mm2pt: func [mm] compose [mm * (72 / 25.4)]
; this creates the page objects
make-pages: func [i /local kids mediabox stream pid] [
kids: clear []
pid: (2 * length? pages) + i
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 (pid) 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 (i) [
#<< /Type /Pages
/Kids [(kids)]
/Count (length? pages)
#>>
]
]
i + 1
]
; 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"
/local pgs
] [
clear pages
clear used-fonts
clear used-images
clear pdf-spec
parse-spec spec
pgs: make-pages make-images make-fonts
make-docroot pgs - 1
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
but (any [txtb/last-lh 0]) * 0.1818 + txtb/text-height txtb: none
]
]
No comments:
Post a Comment