|
Rebol [ |
|
Title: "PDF Experiment" |
|
Author: "Christopher Ross-Gill" |
|
Date: 18-Jan-2022 |
|
Home: https://gist.github.com/rgchris |
|
File: %pdf.r |
|
Version: 0.1.0 |
|
Rights: http://opensource.org/licenses/Apache-2.0 |
|
Purpose: { |
|
Build a PDF object model for atomic construction of PDF documents |
|
} |
|
|
|
Type: module |
|
Name: rgchris.pdf |
|
Exports: [ |
|
pdf |
|
] |
|
|
|
History: [ |
|
18-Jan-2022 0.1.0 "Objects, registry, templates, stitcher" |
|
22-Dec-2021 0.0.1 "Proof of concept: functions as an interface" |
|
] |
|
] |
|
|
|
_: none |
|
|
|
pdf: make object! [ |
|
; 255 -> %-based colors |
|
; |
|
color-constant: 20 / 51 |
|
|
|
header: #{255044462D312E330A25DECAFBAD0A} |
|
|
|
some: func [ |
|
"Returns a series unless empty (returns NONE)" |
|
series [series!] |
|
][ |
|
all [ |
|
not empty? series |
|
series |
|
] |
|
] |
|
|
|
has-substance: func [ |
|
value [any-type!] |
|
][ |
|
not any [ |
|
unset? :value |
|
none? value |
|
|
|
if object? value [ |
|
parse values-of value [ |
|
any none! |
|
] |
|
] |
|
|
|
if block? value [ |
|
parse value [ |
|
some none! ; empty blocks allowed |
|
] |
|
] |
|
] |
|
] |
|
|
|
reduce-only: func [ |
|
block [block!] |
|
/local value |
|
][ |
|
collect [ |
|
while [ |
|
not tail? block |
|
][ |
|
either set-word? first block [ |
|
keep first block |
|
block: next block |
|
][ |
|
set [value block] do/next block |
|
keep/only :value |
|
] |
|
] |
|
] |
|
] |
|
|
|
do-with: func [ |
|
body [block!] |
|
context [block!] |
|
/local args |
|
][ |
|
context: reduce-only context |
|
|
|
args: collect [ |
|
foreach [name value] context [ |
|
keep to lit-word! name |
|
] |
|
] |
|
|
|
do collect [ |
|
keep func args copy/deep body |
|
foreach [name value] context [ |
|
keep :value |
|
] |
|
] |
|
] |
|
|
|
collect-each: func [ |
|
{Evaluates a block for each value(s), storing values via KEEP function, and returns block of collected values.} |
|
'word [get-word! word! block!] {Word or block of words to set each time (will be local)} |
|
data [series!] "The series to traverse" |
|
body [block!] "Block to evaluate each time" |
|
][ |
|
collect reduce [ |
|
:foreach :word data body |
|
] |
|
] |
|
|
|
formatter: make object! [ |
|
pad-integer: func [ |
|
value [integer!] |
|
length [integer!] |
|
][ |
|
head insert insert/dup make string! length #"0" length - length? value: form value value |
|
] |
|
|
|
convert: func [ |
|
value [integer! decimal!] |
|
unit [word!] |
|
] compose/deep [ |
|
switch word [ |
|
pt point [value] |
|
mm [value * (72 / 25.4)] |
|
cm [value * (72 / 2.54)] |
|
pc pica [value * 12] |
|
px [value * (72 / 96)] |
|
] |
|
] |
|
|
|
mm2pt: func [mm] compose/deep [ |
|
mm * (72 / 25.4) |
|
] |
|
|
|
to-octal: func [ |
|
value [integer!] |
|
][ |
|
rejoin [ |
|
#"0" + mod shift value 6 8 |
|
#"0" + mod shift value 3 8 |
|
#"0" + mod value 8 |
|
] |
|
] |
|
|
|
load-octal: func [ |
|
value [string!] |
|
][ |
|
(shift/left add -48 value/1 6) |
|
+ |
|
(shift/left add -48 value/2 3) |
|
+ |
|
(add -48 value/3) |
|
] |
|
|
|
pow-85: [ |
|
52200625 614125 7225 85 1 |
|
] |
|
|
|
ascii85: charset [ |
|
#"!" - #"u" |
|
] |
|
|
|
whitespace: charset as-string #{ |
|
00 09 0A 0C 0D 20 |
|
} |
|
|
|
uint32-to-number: func [ |
|
value [binary!] |
|
][ |
|
add to integer! value pick [4294967296 0] value/1 > 127 |
|
] |
|
|
|
number-to-uint32: func [ |
|
value [integer! decimal!] |
|
][ |
|
debase/base to-hex to integer! subtract value pick [4294967296 0] value > 2147483647 16 |
|
] |
|
|
|
to-ascii85: func [ |
|
content [binary! string!] |
|
/local encoding part size counter |
|
][ |
|
content: as-binary content |
|
encoding: make string! "" |
|
counter: 0 |
|
size: 5 |
|
|
|
parse/all content [ |
|
any [ |
|
content: |
|
skip |
|
(part: shift/left to integer! content/1 24) |
|
[ |
|
skip |
|
(part: part + shift/left to integer! content/2 16) |
|
[ |
|
skip |
|
(part: part + shift/left to integer! content/3 8) |
|
[ |
|
skip |
|
(part: part + content/4) |
|
| |
|
(size: 4) |
|
] |
|
| |
|
(size: 3) |
|
] |
|
| |
|
(size: 2) |
|
] |
|
( |
|
if 16 = counter: counter + 1 [ |
|
append encoding newline |
|
counter: 1 |
|
] |
|
|
|
either all [ |
|
zero? part |
|
size = 5 |
|
][ |
|
append encoding #"z" |
|
][ |
|
part: part + pick [4294967296 0] negative? part |
|
|
|
repeat offset size [ |
|
append encoding add #"!" to integer! part / pow-85/:offset |
|
part: to integer! mod part pow-85/:offset |
|
] |
|
] |
|
) |
|
] |
|
] |
|
|
|
encoding |
|
] |
|
|
|
; PDF does not support Exponent notation |
|
; |
|
form-decimal: use [ |
|
digit onenine padding |
|
][ |
|
digit: charset "0123456789" |
|
onenine: charset "123456789" |
|
padding: "00000000000000000000000000000000" |
|
|
|
func [ |
|
"Render a decimal! value sans scientific notation" |
|
value [integer! decimal!] |
|
/local sign whole part exp |
|
][ |
|
if not parse/all form value [ |
|
[ |
|
copy sign #"-" |
|
| |
|
(sign: copy "") |
|
] |
|
|
|
copy whole [ |
|
onenine any digit |
|
| |
|
#"0" |
|
] |
|
|
|
[ |
|
#"." copy part [ |
|
any #"0" |
|
onenine |
|
any digit |
|
] |
|
| |
|
opt ".0" |
|
(part: "") |
|
] |
|
|
|
opt [ |
|
#"E" copy exp [ |
|
opt [ |
|
#"-" | #"+" |
|
] |
|
some digit |
|
] |
|
] |
|
][ |
|
make error! rejoin [ |
|
"Could not parse:" mold form value |
|
] |
|
] |
|
|
|
rejoin case [ |
|
not exp [ |
|
[ |
|
sign |
|
whole |
|
pick ["" #"."] empty? part |
|
part |
|
] |
|
] |
|
|
|
negative? exp: to integer! exp [ |
|
[ |
|
sign |
|
"0." |
|
copy/part padding -1 - exp |
|
whole |
|
part |
|
] |
|
] |
|
|
|
<else> [ |
|
[ |
|
sign |
|
whole |
|
part |
|
copy/part padding exp - length? part |
|
] |
|
] |
|
] |
|
] |
|
] |
|
|
|
; valid characters in strings |
|
; |
|
string-escapes: complement charset "()\" |
|
|
|
; this converts Rebol values to PDF values; it's not perfect but works. |
|
; |
|
form-value: func [ |
|
"Rebol to PDF" |
|
value |
|
/with result [string!] |
|
/only |
|
/local mark extent |
|
][ |
|
result: any [ |
|
:result |
|
make string! 256 |
|
] |
|
|
|
switch/default type?/word :value [ |
|
block! [ |
|
either empty? value [ |
|
append result "[]" |
|
][ |
|
if any [with only] [ |
|
append result "[" |
|
] |
|
|
|
mark: foreach kid value [ |
|
insert tail form-value/with :kid tail result pick "^/ " word? kid |
|
] |
|
|
|
head either any [with only] [ |
|
change back mark "]" |
|
][ |
|
remove back mark |
|
] |
|
] |
|
] |
|
|
|
object! [ |
|
append result "<<^/" |
|
|
|
foreach kid words-of value [ |
|
if has-substance get/any kid [ |
|
append result mold to refinement! kid |
|
append result #" " |
|
form-value/with get/any kid tail result |
|
append result #"^/" |
|
] |
|
] |
|
|
|
append result ">>" |
|
] |
|
|
|
path! [ |
|
foreach kid next to block! value [ |
|
insert tail form-value/with kid tail result #" " |
|
] |
|
|
|
append mark form value/1 |
|
] |
|
|
|
char! [ |
|
repend result [ |
|
#"(" |
|
pick [#"\" ""] found? find string-escapes value |
|
value |
|
#")" |
|
] |
|
] |
|
|
|
string! [ |
|
result: insert tail result #"(" |
|
parse/all value [ |
|
some [ |
|
mark: |
|
some string-escapes |
|
extent: |
|
( |
|
result: insert/part result mark extent) |
|
| |
|
skip |
|
(result: insert insert result #"\" mark/1) |
|
] |
|
] |
|
append result #")" |
|
] |
|
|
|
decimal! [ |
|
append result form-decimal value |
|
] |
|
|
|
issue! [ |
|
append result back change mold value #"/" |
|
] |
|
|
|
time! [ |
|
repend result [ |
|
value/1 " " value/2 " R" |
|
] |
|
] |
|
][ |
|
; other values simply molded currently. |
|
; |
|
append result mold :value |
|
] |
|
] |
|
] |
|
|
|
reference-of: func [ |
|
value [object! none!] |
|
][ |
|
case [ |
|
none? value [ |
|
_ |
|
] |
|
|
|
not in value 'id [ |
|
make error! "Not a PDF object" |
|
] |
|
|
|
not time? value/id [ |
|
make error! "Object not registered" |
|
] |
|
|
|
<else> [ |
|
value/id |
|
] |
|
] |
|
] |
|
|
|
form-of: func [ |
|
value [object! none!] |
|
][ |
|
case [ |
|
none? value [ |
|
_ |
|
] |
|
|
|
not in value 'template [ |
|
make error! "Not a PDF object" |
|
] |
|
|
|
not block? value/template [ |
|
make error! "Object missing template (should not happen)" |
|
] |
|
|
|
<else> [ |
|
make object! reduce-only value/template |
|
] |
|
] |
|
] |
|
|
|
prototype: make object! [ |
|
; |
|
; Page references come from the PDF Reference v1.4 |
|
; https://www.adobe.com/content/dam/acom/en/devnet/pdf/pdfs/pdf_reference_archives/PDFReference.pdf |
|
; Page # (pdf page #), figure/table |
|
|
|
prototype: make object! [ |
|
type: |
|
id: |
|
template: _ |
|
] |
|
|
|
make-prototype: func [ |
|
'name [set-word!] |
|
spec [block!] |
|
][ |
|
spec: make prototype spec |
|
spec/type: to word! name |
|
set name spec |
|
] |
|
|
|
; Page 68 (88), Table 3.12 |
|
; |
|
make-prototype trailer: [ |
|
size: |
|
previous: |
|
root: |
|
encrypt: |
|
info: _ |
|
|
|
template: [ |
|
Size: size |
|
Prev: previous |
|
Root: reference-of root |
|
Info: reference-of info |
|
] |
|
] |
|
|
|
; Page 83 (103), Table 3.16 |
|
; |
|
make-prototype catalog: [ |
|
pages: |
|
labels: |
|
names: |
|
; destinations: ; /Dests ; named destinations |
|
mode: ; [/UseNone /UseOutlines /UseThumbs /FullScreen] |
|
outlines: ; to research |
|
acroform: _ ; to research |
|
|
|
template: [ |
|
Type: /Catalog |
|
Version: #1.4 |
|
Pages: reference-of pages |
|
PageLabels: labels |
|
Outlines: reference-of outlines |
|
] |
|
] |
|
|
|
; Page 86 (106), Table 3.17 |
|
; |
|
make-prototype pages: [ |
|
kids: |
|
parent: _ ; for fragmented page trees |
|
|
|
template: [ |
|
Type: /Pages |
|
Count: length? kids |
|
Kids: collect-each page kids [ |
|
keep reference-of page |
|
] |
|
] |
|
] |
|
|
|
; Page 88 (108), Table 3.18 |
|
; |
|
make-prototype page: [ |
|
contents: |
|
parent: |
|
|
|
; For convenience, not binding |
|
; |
|
width: |
|
height: |
|
|
|
; Page 678 (698), Figure 9.3 |
|
; |
|
media-box: |
|
crop-box: |
|
bleed-box: |
|
trim-box: |
|
art-box: |
|
|
|
rotation: |
|
thumbnail: |
|
beads: |
|
transition: |
|
|
|
resources: |
|
annotations: |
|
stream: _ |
|
|
|
template: [ |
|
Type: /Page |
|
Contents: reference-of contents |
|
Parent: parent |
|
|
|
MediaBox: media-box |
|
Resources: form-of resources |
|
Annots: some annotations |
|
] |
|
] |
|
|
|
make-prototype content: [ |
|
filter: |
|
stream: _ |
|
|
|
template: [ |
|
Length: 0 |
|
Filter: _ |
|
] |
|
] |
|
|
|
; Page 97 (117), Table 3.21 |
|
; |
|
make-prototype resource: [ |
|
extended-graphics-state: |
|
color-space: |
|
pattern: |
|
shading: |
|
x-object: |
|
font: |
|
procedure-set: |
|
properties: _ |
|
|
|
template: [ |
|
XObject: some collect-each object x-object [ |
|
keep object/name |
|
keep reference-of object |
|
] |
|
|
|
Font: some collect-each object font [ |
|
keep object/name |
|
keep reference-of object |
|
] |
|
] |
|
] |
|
|
|
; Page 267 (287), Table 4.35 |
|
; |
|
make-prototype image: [ |
|
name: |
|
width: |
|
height: _ |
|
color-space: /DeviceRGB ; /DeviceGray |
|
bits-per-component: 8 |
|
image-mask: |
|
mask: |
|
s-mask: |
|
decode: |
|
interpolate: |
|
stream: _ |
|
|
|
template: [ |
|
Type: /XObject |
|
Subtype: /Image |
|
Width: width |
|
Height: height |
|
ColorSpace: color-space |
|
BitsPerComponent: bits-per-component |
|
|
|
Length: _ |
|
Filter: _ |
|
] |
|
] |
|
|
|
; Page 284 (304), Table 4.41 |
|
; |
|
; note that this is a reusable graphical element, not to |
|
; be confused with input forms/fields |
|
; |
|
make-prototype form: [ |
|
name: |
|
bounding-box: |
|
matrix: |
|
resources: |
|
stream: _ |
|
|
|
template: [ |
|
Type: /XObject |
|
Subtype: /Form |
|
BBox: bounding-box |
|
Matrix: matrix |
|
Resources: resources |
|
|
|
Length: _ |
|
Filter: _ |
|
] |
|
] |
|
|
|
; Page 317 (337), Table 5.8 |
|
; |
|
make-prototype font: [ |
|
; for convenience |
|
; |
|
style: |
|
weight: |
|
|
|
sub-type: |
|
name: |
|
base-font: |
|
first-character: |
|
last-character: |
|
widths: |
|
font-descriptor: |
|
encoding: |
|
to-unicode: |
|
stream: _ |
|
|
|
template: [ |
|
Type: /Font |
|
Subtype: sub-type |
|
BaseFont: base-font |
|
FirstChar: first-character |
|
LastChar: last-character |
|
Widths: widths |
|
FontDescriptor: reference-of font-descriptor |
|
Encoding: encoding |
|
|
|
Length: _ |
|
Filter: _ |
|
] |
|
] |
|
|
|
; Page 356 (376), Table 5.18 |
|
; |
|
make-prototype font-descriptor: [ |
|
name: |
|
flags: |
|
bounding-box: |
|
|
|
angle: |
|
ascent: |
|
descent: |
|
leading: |
|
|
|
capital-height: |
|
x-height: |
|
stem-v: |
|
stem-h: |
|
|
|
average-width: |
|
maximum-width: |
|
|
|
font-afb: |
|
font-ttf: _ |
|
|
|
template: [ |
|
Type: /FontDescriptor |
|
FontName: name |
|
Flags: flags |
|
FontBBox: bounding-box |
|
ItalicAngle: angle |
|
Ascent: ascent |
|
Descent: descent |
|
Leading: leading |
|
CapHeight: capital-height |
|
XHeight: x-height |
|
StemV: stem-v |
|
StemH: stem-h |
|
AvgWidth: average-width |
|
MaxWidth: maximum-width |
|
FontFile: font-afb |
|
FontFile2: font-ttf |
|
] |
|
] |
|
|
|
; Page 475 (495), Table 8.2 |
|
; |
|
make-prototype destination: [ |
|
page: |
|
top: |
|
left: _ |
|
zoom: 0 ; null |
|
; |
|
; Renders as: |
|
; [page /XYZ top left zoom] |
|
; e.g. [3 0 R /XYZ 0 792 0] |
|
|
|
template: [ |
|
page /XYZ top left zoom |
|
] |
|
] |
|
|
|
; Page 478 (498), Table 8.3 |
|
; |
|
make-prototype outlines: [ |
|
first: |
|
last: |
|
count: _ |
|
|
|
template: [ |
|
Type: /Outlines |
|
First: first |
|
Last: last |
|
Count: count |
|
] |
|
] |
|
|
|
; Page 478 (498), Table 8.4 |
|
; |
|
make-prototype outline: [ |
|
title: |
|
|
|
parent: |
|
previous: |
|
next: |
|
first: |
|
last: |
|
count: _ |
|
] |
|
|
|
; Page 483 (503), Table 8.6 |
|
; |
|
; used for managing page numbering, possibly ignored |
|
; by many readers |
|
; |
|
make-prototype label: [ |
|
style: |
|
prefix: |
|
start: _ |
|
|
|
template: [ |
|
Type: /PageLabel |
|
] |
|
] |
|
|
|
; Page 486 (506), Table 8.9 |
|
; |
|
make-prototype transition: [ |
|
type: 'transition ; /Trans |
|
id: _ |
|
|
|
duration: |
|
style: |
|
dimension: |
|
motion: |
|
direction: _ |
|
|
|
template: [ |
|
Type: /Trans |
|
] |
|
] |
|
|
|
; Page 490 (510), Table 8.10 |
|
; |
|
make-prototype annotation: [ |
|
sub-type: |
|
name: ; /NM |
|
page: ; /P |
|
contents: |
|
rectangle: ; required |
|
opacity: ; /CA |
|
title: _ |
|
border: [0 0 0] |
|
] |
|
|
|
; Page 500 (520), Table 8.15 |
|
; |
|
text-annotation: make annotation [ |
|
type: 'text-annotation ; /SubType /Text |
|
is-open: |
|
icon: _ ; /Name |
|
; |
|
; KIND is one of: |
|
; [/Comment /Key /Note /Help /NewParagraph /Paragraph /Insert] |
|
|
|
template: [ |
|
Type: /Annot |
|
Subtype: /Text |
|
|
|
Rect: rectangle |
|
Border: border |
|
CA: opacity |
|
|
|
T: title |
|
Contents: contents |
|
Open: is-open |
|
Name: icon |
|
] |
|
] |
|
|
|
; Page 501 (521), Table 8.16 |
|
; |
|
link-annotation: make annotation [ |
|
type: 'link-annotation |
|
highlight: /P ; Push instead of default Invert |
|
action: ; /A |
|
destination: _ ; /Dest |
|
; |
|
; A link annotation can refer to a URI (or any) Action or |
|
; a Destination, cannot refer to both |
|
; |
|
; Opting to refer to destinations by GoTo Action |
|
; though not compatible with PDF v1.0 |
|
|
|
template: [ |
|
Type: /Annot |
|
Subtype: /Link |
|
|
|
Rect: rectangle |
|
Border: border |
|
CA: opacity |
|
|
|
T: title |
|
H: highlight |
|
A: action |
|
Dest: reduce destination/template |
|
] |
|
] |
|
|
|
; action sub-types of interest: |
|
; [/GoTo /Thread /URI /SubmitForm /ResetForm] |
|
; |
|
; Page 523 (543), Table 8.40 |
|
; |
|
make-prototype goto-action: [ |
|
destination: _ ; /D |
|
|
|
template: [ |
|
Type: /Action |
|
S: /GoTo |
|
D: reduce destination/template |
|
] |
|
] |
|
|
|
; Page 523 (543), Table 8.40 |
|
; |
|
make-prototype uri-action: [ |
|
href: _ |
|
|
|
template: [ |
|
Type: /Action |
|
S: /URI |
|
URI: href |
|
] |
|
] |
|
|
|
; Page 576 (596), Table 9.2 |
|
; |
|
make-prototype info: [ |
|
title: |
|
author: _ |
|
creator: |
|
producer: "Rebol v2.7.8" |
|
subject: |
|
keywords: |
|
created: |
|
modified: _ |
|
|
|
template: [ |
|
Title: title |
|
Author: author |
|
Subject: subject |
|
Keywords: keywords |
|
Creator: creator |
|
Producer: producer |
|
CreationDate: created |
|
ModDate: modified |
|
] |
|
] |
|
] |
|
|
|
emit: func [ |
|
canvas [block!] |
|
command [word!] |
|
/with |
|
value [any-type!] |
|
][ |
|
if not none? value [ |
|
foreach value reduce compose [ |
|
(value) |
|
][ |
|
switch/default type?/word value [ |
|
tuple! [ |
|
switch length? value [ |
|
3 [ |
|
; RGB 255.255.255 |
|
; |
|
value: value * color-constant |
|
|
|
repend canvas [ |
|
0.01 * value/1 |
|
0.01 * value/2 |
|
0.01 * value/3 |
|
] |
|
] |
|
|
|
4 [ |
|
; CMYK 100.100.100.100 |
|
; |
|
repend canvas [ |
|
0.01 * min 100 value/1 |
|
0.01 * min 100 value/2 |
|
0.01 * min 100 value/3 |
|
0.01 * min 100 value/4 |
|
] |
|
] |
|
] |
|
] |
|
][ |
|
repend/only canvas value |
|
] |
|
] |
|
] |
|
|
|
append canvas command |
|
] |
|
|
|
add-graphic: func [ |
|
container [object!] |
|
'stroke [word! none!] |
|
'fill [word! none!] |
|
'clip [word! none!] |
|
body [block!] |
|
|
|
/local content mark |
|
][ |
|
assert [ |
|
all [ |
|
find [line shape none #[none]] stroke |
|
find [even-odd non-zero none #[none]] fill |
|
find [even-odd non-zero none #[none]] clip |
|
] |
|
] |
|
|
|
content: container/stream |
|
mark: tail content |
|
|
|
do-with body [ |
|
; Page 163 (183), Table 4.9 |
|
; |
|
move-to: func [ |
|
end-point [pair! block!] |
|
][ |
|
emit/with content 'm [ |
|
end-point/1 end-point/2 |
|
] |
|
] |
|
|
|
line-to: func [ |
|
end-point [pair! block!] |
|
][ |
|
emit/with content 'l [ |
|
end-point/1 end-point/2 |
|
] |
|
] |
|
|
|
curve-to: func [ |
|
control-1 [pair! block!] |
|
control-2 [pair! block!] |
|
end-point [pair! block!] |
|
][ |
|
emit/with content 'c [ |
|
control-1/1 control-1/2 |
|
control-2/1 control-2/2 |
|
end-point/1 end-point/2 |
|
] |
|
] |
|
|
|
smooth-starting-curve-to: func [ |
|
control-2 [pair! block!] |
|
end-point [pair! block!] |
|
][ |
|
emit/with content 'v [ |
|
control-2/1 control-2/2 |
|
end-point/1 end-point/2 |
|
] |
|
] |
|
|
|
smooth-ending-curve-to: func [ |
|
control-1 [pair! block!] |
|
end-point [pair! block!] |
|
][ |
|
emit/with content 'y [ |
|
control-1/1 control-1/2 |
|
end-point/1 end-point/2 |
|
] |
|
] |
|
|
|
close-path: func [] [ |
|
emit content 'h |
|
] |
|
|
|
rectangle: func [ |
|
point [pair! block!] |
|
end-point [pair! block!] |
|
][ |
|
emit/with content 're [ |
|
point/1 point/2 |
|
end-point/1 end-point/2 |
|
] |
|
] |
|
] |
|
|
|
switch clip [ |
|
even-odd [ |
|
emit content 'W* |
|
] |
|
|
|
non-zero [ |
|
emit content 'W |
|
] |
|
] |
|
|
|
emit content switch fill switch stroke [ |
|
line [ |
|
[ |
|
even-odd ['B*] |
|
non-zero ['B] |
|
none #[none] ['S] |
|
] |
|
] |
|
|
|
shape [ |
|
[ |
|
even-odd ['b*] |
|
non-zero ['b] |
|
none #[none] ['s] |
|
] |
|
] |
|
|
|
none #[none] [ |
|
[ |
|
even-odd ['f*] |
|
non-zero ['f] |
|
none #[none] ['n] |
|
] |
|
] |
|
] |
|
|
|
mark |
|
] |
|
|
|
; Content cannot exist outwith the context of a page as |
|
; it is dependent on references to fonts, images and |
|
; other resources |
|
; |
|
add-content: func [ |
|
container [object!] |
|
body [block!] |
|
/local content mark |
|
][ |
|
content: container/stream |
|
mark: tail content |
|
|
|
do-with body [ |
|
; Page 156 (176), Table 4.7 |
|
; |
|
page: container |
|
|
|
rotation: _ |
|
|
|
push: func [ |
|
body [block!] |
|
][ |
|
emit content 'q |
|
add-content container body |
|
emit content 'Q |
|
] |
|
|
|
set-matrix: func [ |
|
matrix [block!] |
|
][ |
|
assert [ |
|
parse reduce matrix [6 number!] |
|
] |
|
|
|
emit/with content 'cm matrix |
|
] |
|
|
|
draw: func [ |
|
'stroke [word! none!] "LINE, SHAPE or NONE" |
|
'fill [word! none!] "EVEN-ODD, NON-ZERO or NONE" |
|
body [block!] |
|
][ |
|
add-graphic container :stroke :fill :none body |
|
] |
|
|
|
clip: func [ |
|
'clip [word! none!] "EVEN-ODD, NON-ZERO or NONE" |
|
body [block!] |
|
][ |
|
add-graphic container :none :none :clip body |
|
] |
|
|
|
; set-translation |
|
; set-rotation |
|
; set-scale |
|
|
|
set-line-width: func [ |
|
width [number!] |
|
][ |
|
emit/with content 'w width |
|
] |
|
|
|
set-line-cap: func [ |
|
type [integer! word!] |
|
][ |
|
type: switch/default type [ |
|
butt 0 [0] |
|
round 1 [1] |
|
square 2 [2] |
|
][ |
|
make error! "Unsupported Line Cap" |
|
] |
|
|
|
emit/with content 'J type |
|
] |
|
|
|
set-line-join: func [ |
|
type [integer! word!] |
|
][ |
|
type: switch/default type [ |
|
miter 0 [0] |
|
round 1 [1] |
|
bevel 2 [2] |
|
][ |
|
make error! "Unsupported Line Join" |
|
] |
|
|
|
emit/with content 'j type |
|
] |
|
|
|
set-miter-limit: func [ |
|
limit [number!] |
|
][ |
|
emit/with content 'M limit |
|
] |
|
|
|
set-dash-array: func [ |
|
array [block!] |
|
phase [number!] |
|
][ |
|
assert [ |
|
parse array: reduce array [ |
|
0 2 number! |
|
] |
|
] |
|
|
|
emit/with content 'd [ |
|
array phase |
|
] |
|
] |
|
|
|
set-pen: func [ |
|
color [integer! tuple!] |
|
][ |
|
case [ |
|
integer? color [ |
|
emit/with content 'G [ |
|
(max 0 min 100 color) / 100 |
|
] |
|
] |
|
|
|
3 = length? color [ |
|
emit/with content 'RG color |
|
] |
|
|
|
4 = length? color [ |
|
emit/with content 'K color |
|
] |
|
] |
|
] |
|
|
|
set-fill: func [ |
|
color [integer! tuple!] |
|
][ |
|
case [ |
|
integer? color [ |
|
emit/with content 'g [ |
|
(max 0 min 100 color) / 100 |
|
] |
|
] |
|
|
|
3 = length? color [ |
|
emit/with content 'rg color |
|
] |
|
|
|
4 = length? color [ |
|
emit/with content 'k color |
|
] |
|
] |
|
] |
|
] |
|
|
|
; Returning the point at which additions began so as to permit |
|
; isolation for other uses |
|
; |
|
mark |
|
] |
|
|
|
add-text: _ |
|
|
|
; A page cannot exist outwith the context of a document |
|
; It is dependent on the document for fonts, images and |
|
; other resources |
|
; |
|
add-page: func [ |
|
document [object!] |
|
size [pair!] |
|
body [block!] |
|
/local page |
|
][ |
|
page: make prototype/page [ |
|
id: register document self |
|
|
|
parent: reference-of document/pages |
|
|
|
media-box: reduce [ |
|
0 0 size/1 size/2 |
|
] |
|
|
|
width: media-box/3 |
|
height: media-box/4 |
|
|
|
contents: make prototype/content [ |
|
id: register document self |
|
length: 0 |
|
] |
|
|
|
contents/stream: stream: make block! 0 |
|
|
|
resources: make prototype/resource [ |
|
font: make block! 0 |
|
x-object: make block! 0 |
|
] |
|
|
|
annotations: make block! 0 |
|
] |
|
|
|
add-content page body |
|
|
|
append document/pages/kids page |
|
|
|
page |
|
] |
|
|
|
add-font: func [ |
|
document [object!] |
|
name [refinement!] |
|
spec [block!] |
|
|
|
/local font |
|
][ |
|
font: make prototype/font [ |
|
id: _ |
|
type: /Font |
|
sub-type: |
|
name: |
|
base-font: |
|
first-char: |
|
last-char: |
|
widths: |
|
font-descriptor: |
|
encoding: |
|
to-unicode: |
|
stream: _ |
|
] |
|
] |
|
|
|
add-image: func [ |
|
document [object!] |
|
name [refinement! issue!] |
|
spec [block!] |
|
][ |
|
image: make prototype/image [ |
|
id: register document self |
|
] |
|
|
|
do-with spec [ |
|
image: image |
|
] |
|
|
|
assert [ |
|
all [ |
|
integer? image/width |
|
integer? image/height |
|
] |
|
] |
|
|
|
repend document/images [ |
|
name image |
|
] |
|
|
|
image |
|
] |
|
|
|
register: func [ |
|
document [object!] |
|
value |
|
|
|
/local id |
|
][ |
|
id: document/last-id + 1:00 |
|
|
|
repend document/registry [ |
|
id value |
|
] |
|
|
|
document/last-id: id |
|
] |
|
|
|
create: func [ |
|
body [block!] |
|
/local document |
|
][ |
|
document: make object! [ |
|
index: make prototype/trailer [] |
|
|
|
pages: _ |
|
|
|
fonts: make block! 0 |
|
images: make block! 0 |
|
forms: make block! 0 |
|
actions: make block! 0 |
|
|
|
last-id: 0:00 |
|
|
|
registry: make map! 0 |
|
] |
|
|
|
document/index/root: make prototype/catalog [ |
|
id: register document self |
|
|
|
document/pages: pages: make prototype/pages [ |
|
id: register document self |
|
kids: make block! 0 |
|
] |
|
] |
|
|
|
do-with body [ |
|
info: func [ |
|
spec [block!] |
|
][ |
|
document/index/info: make prototype/info [ |
|
id: register document self |
|
] |
|
|
|
do-with spec [ |
|
title: func [ |
|
title [string!] |
|
][ |
|
document/index/info/title: title |
|
] |
|
|
|
author: func [ |
|
author [string!] |
|
][ |
|
document/index/info/author: author |
|
] |
|
|
|
date: func [ |
|
date [date!] |
|
][ |
|
document/index/info/creation-date: date |
|
] |
|
|
|
modified: func [ |
|
date [date!] |
|
][ |
|
document/index/info/mod-date: date |
|
] |
|
] |
|
] |
|
|
|
add-page: func [ |
|
size [pair!] |
|
content [block!] |
|
][ |
|
add-page document size content |
|
] |
|
|
|
add-font: func [ |
|
name [issue! refinement!] |
|
spec [block!] |
|
][ |
|
add-font document name spec |
|
] |
|
|
|
add-image: func [ |
|
name [issue! refinement!] |
|
spec [block!] |
|
][ |
|
add-image document name spec |
|
] |
|
] |
|
|
|
document |
|
] |
|
|
|
render: func [ |
|
document [object!] |
|
|
|
/local content xref xref-offset stream |
|
][ |
|
xref: make block! document/last-id/1 |
|
|
|
content: tail as-string copy header |
|
|
|
foreach [reference object] document/registry [ |
|
append xref -1 + index? content |
|
|
|
content: insert content reduce [ |
|
form reference/1 " " form reference/2 " obj^/" |
|
] |
|
|
|
either object? object [ |
|
assert [ |
|
word? in object 'template |
|
] |
|
|
|
either not any [ |
|
object/type == 'page |
|
not in object 'stream |
|
none? object/stream |
|
][ |
|
stream: switch/default type?/word object/stream [ |
|
binary! [ |
|
as-string object/stream |
|
] |
|
][ |
|
formatter/form-value object/stream |
|
] |
|
|
|
stream: head clear skip tail compress stream -4 |
|
stream: formatter/to-ascii85 copy stream |
|
|
|
object: form-of object |
|
object/length: length? stream |
|
object/filter: [/A85 /FlateDecode] |
|
|
|
content: insert tail content reduce [ |
|
formatter/form-value object |
|
"^/stream^/" as-string stream "^/endstream" |
|
] |
|
][ |
|
content: insert content formatter/form-value form-of object |
|
] |
|
][ |
|
content: insert content formatter/form-value/only object |
|
] |
|
|
|
content: insert content "^/endobj^/" |
|
] |
|
|
|
xref-offset: index? content |
|
|
|
document/index/size: document/last-id/1 + 1 |
|
|
|
content: insert content reduce [ |
|
"^/xref^/0 " document/index/size |
|
"^/0000000000 65535 f ^/" |
|
] |
|
|
|
foreach offset xref [ |
|
content: insert content reduce [ |
|
formatter/pad-integer offset 10 |
|
" 00000 n ^/" |
|
] |
|
] |
|
|
|
content: insert content reduce [ |
|
"trailer^/" |
|
formatter/form-value form-of document/index |
|
"^/startxref^/" |
|
xref-offset |
|
"^/%%EOF^/" |
|
] |
|
|
|
head content |
|
] |
|
] |