Qtask Markup Language - PDF emitter Purpose: { This program implements a QML to PDF converter. The input is a QML document tree (from the QML parser), and the output is a PDF document. } Author: "Gabriele Santilli" EMail: giesse@rebol.it File: %pdf-emitter.r License: { Copyright (c) 2006 Prolific Publishing, Inc. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. } Date: 25-Sep-2006 Version: 1.9.0 ; majorv.minorv.status ; status: 0: unfinished; 1: testing; 2: stable History: [ 4-Sep-2006 1.1.0 "History start" 4-Sep-2006 1.2.0 "First version" 5-Sep-2006 1.3.0 "hrule and definitions, correct bold/italic handling" 8-Sep-2006 1.4.0 "Temporary solution for all block level elements except table" 9-Sep-2006 1.5.0 "Font handling" 21-Sep-2006 1.6.0 "Now using tables for enum, definitions, and boxes" 22-Sep-2006 1.7.0 "Fixed a number of bugs" 22-Sep-2006 1.8.0 "Implemented tables" 25-Sep-2006 1.9.0 "Minor table improvements" ] \note Warning This documentation is incomplete. It will be finished as soon as possible. /note ===Introduction ===Overview -main-: #include %pdf-maker.r pdf-emitter: context [ out: none -parse-rules- -pdf-template- generate: func [qml-doc [block!]] [ out: make block! 1024 output: reduce [out none] spc: str: shr: 0 pen: none parse qml-doc qml-rule ;write clipboard:// mold/only out layout-pdf template ] ] ===The |parse| rules that generate the document -parse-rules-: qml-rule: ['qml some block-level] block-level: [ -block-level-rules- ] ---Block level rules -block-level-rules-: ;here: (print ["block-level:" copy/part trim/lines mold here 80]) into [ 'para opts [ end (emit-space val: cur-para/cur-font/size / 0.846 val * 0.1 val * 0.06 para-indent?: no) | ( flush-space new-para/set-opts [] manual-indent?: no option? [indent:] [para-indent?: no manual-indent?: yes] if all [para-indent? cur-para/alignment = [justify]] [ emit compose [space (cur-para/cur-font/size / 0.52875)] ] ) some inline-level (end-para para-indent?: not manual-indent?) ] | 'hrule to end ( para-indent?: no emit-penalty +infty emit-space 3 2 2 flush-space emit [ vbox 4 [line width 0.7 cap butt dash [3] 0 255.153.0 xbl ybl + 2 xtr ybl + 2] ] emit-penalty -200 emit-space 3 2 2 ) | ['header1 | 'header1*] opts (start-header 1) any inline-level (end-header 1) | ['header2 | 'header2*] opts (start-header 2) any inline-level (end-header 2) | ['header3 | 'header3*] opts (start-header 3) any inline-level (end-header 3) | 'header4 opts (start-header 4) any inline-level (end-header 4) | 'header5 opts (start-header 5) any inline-level (end-header 5) | 'header6 opts (start-header 6) any inline-level (end-header 6) | 'bullets (pre-list) any bullets (post-list) | 'enum (pre-enum) any enum-items (post-enum) | 'checks (pre-list) any checks (post-list) | 'definitions (pre-def) any definitions (post-def) | 'box opts ( emit-space 1 1 1 flush-space emit compose/deep [table [(cur-para/width - 20)]] start-block emit [ top padding 1 bottom padding 1 left margin 5 left padding 5 right padding 5 break penalty 10000 ] option? [shadow:] [if value [emit [right margin 5 bottom margin 2]]] emit-box-decor loop 2 [start-block] new-para/set-opts [width: width - 20] ) opt [ into [ 'title opts (start-header/box 2) any inline-level (end-header 2) ] ] (para-indent?: no) any block-level ( end-para emit-penalty +infty flush-space loop 3 [end-block] emit-space 3 1 1 para-indent?: no ) | 'section opt [ into [ 'toc opt [into ['title opts (start-header 1) any inline-level (end-header 1)]] any toc-headers ] ] any block-level | 'table opts val: to end (make-table options val) | 'center opts (new-para/set-opts [alignment: [center]]) any block-level (end-para) | 'left opts (new-para/set-opts [alignment: [left align]]) any block-level (end-para) | 'right opts (new-para/set-opts [alignment: [right align]]) any block-level (end-para) | 'justify opts (new-para/set-opts [alignment: [justify]]) any block-level (end-para) | 'escape string! set val string! to end ( emit-space 3 2 2 new-para/margins/font [alignment: [left align]] [0 0 10 0] 'courier none foreach line parse/all val "^/" [ either empty? line [ emit-space tmp: cur-para/cur-font/size / 0.846 tmp * 0.1 tmp * 0.06 ] [ flush-space emit compose [(line) vpenalty 300] ] ] emit-space 3 2 2 end-para ) | 'command copy val [string! skip] ] | error ---The |emit| function and other local words -parse-rules-: emit: func [value] [ append output/1 value ] start-block: does [ append/only output/1 make block! 256 output: reduce [last output/1 output] ] end-block: does [ output: output/2 ] output: reduce [out none] val: none tmp: none para-indent?: no manual-indent?: no spc: str: shr: 0 emit-space: func [a b c] [ spc: spc + a str: add* str b shr: shr + c ] pen: none emit-penalty: func [a] [ either pen [ pen: max* pen a ] [ pen: a ] ] flush-space: does [ if pen [ emit compose/only [vpenalty (pen)] pen: none ] unless all [zero? spc eq* str 0 zero? shr] [ emit compose/only [vglue (spc) (str) (shr)] spc: str: shr: 0 ] ] Font handling: -parse-rules-: fnode!: context [ name: bold: italic: times: helvetica: courier: none fixed: no ] mkfnode: func [spec] [ make fnode! spec ] fonts-graph: context [ times: mkfnode [ name: 'Times-Roman bold: mkfnode [ name: 'Times-Bold bold: self italic: mkfnode [ name: 'Times-BoldItalic bold: self italic: self times: self helvetica: 'helvetica/bold/italic courier: 'courier/bold/italic ] times: self helvetica: 'helvetica/bold courier: 'courier/bold ] italic: mkfnode [ name: 'Times-Italic bold: 'times/bold/italic italic: self times: self helvetica: 'helvetica/italic courier: 'courier/italic ] times: self helvetica: 'helvetica courier: 'courier ] helvetica: mkfnode [ name: 'Helvetica bold: mkfnode [ name: 'Helvetica-Bold bold: self italic: mkfnode [ name: 'Helvetica-BoldOblique bold: self italic: self times: 'times/bold/italic helvetica: self courier: 'courier/bold/italic ] times: 'times/bold helvetica: self courier: 'courier/bold ] italic: mkfnode [ name: 'Helvetica-Oblique bold: 'helvetica/bold/italic italic: self times: 'times/italic helvetica: self courier: 'courier/italic ] times: 'times helvetica: self courier: 'courier ] courier: mkfnode [ name: 'Courier bold: mkfnode [ name: 'Courier-Bold bold: self italic: mkfnode [ name: 'Courier-BoldOblique bold: self italic: self times: 'times/bold/italic helvetica: 'helvetica/bold/italic courier: self ] times: 'times/bold helvetica: 'helvetica/bold courier: self ] italic: mkfnode [ name: 'Courier-Oblique bold: 'courier/bold/italic italic: self times: 'times/italic helvetica: 'helvetica/italic courier: self ] times: 'times helvetica: 'helvetica courier: self ] ] fix-node: func [fnode /local val] [ fnode/fixed: yes foreach word [bold italic times helvetica courier] [ val: get word: in fnode word case [ word? val [ set word val: get in fonts-graph val ] path? val [ val/1: in fonts-graph val/1 set word val: do val ] ] unless any [fnode = val val/fixed] [fix-node val] ] ] foreach node [times helvetica courier] [ fix-node get in fonts-graph node ] change-font: func [new-path new-size /color new-color] [ case [ word? new-path [ new-path: get in cur-para/cur-font/fnode new-path ] path? new-path [ new-path/1: in cur-para/cur-font/fnode new-path/1 new-path: do new-path ] ] cur-para/cur-font: make cur-para/cur-font [ prev: cur-para/cur-font fnode: new-path size: new-size color: any [new-color color] ] emit-font ] emit-font: does [ emit compose [font (cur-para/cur-font/fnode/name) (cur-para/cur-font/size) (cur-para/cur-font/color)] ] reset-font: does [ cur-para/cur-font: cur-para/cur-font/prev emit-font ] Paragraph state and stack: -parse-rules-: paragraph!: context [ alignment: [justify] margins: [0 0] width: 150 cur-font: context [ fnode: fonts-graph/helvetica size: 3.52 prev: self color: black ] prev: self ] cur-para: make paragraph! [ ] new-para: func [spec /margins mgs /set-opts /font path size] [ spec: make cur-para spec spec/prev: cur-para cur-para: spec cur-para/margins: copy cur-para/margins if margins [increase-margins mgs] if all [set-opts options] [set-para-options] emit compose/deep [ (cur-para/alignment) with margins [(cur-para/margins)] with tolerance 3 ] either font [change-font path any [size cur-para/cur-font/size]] [emit-font] ] end-para: does [ cur-para: cur-para/prev emit [p] ] |set-para-options|: -parse-rules-: set-para-options: has [fpath fsize fcolor app] [ app: func [word] [ either fpath [ append fpath word ] [ fpath: make path! reduce [word] ] ] foreach [word value] options [ switch word [ indent: [increase-margins [value * 20 0]] bold: [if value [app 'bold]] fontsize: [fsize: value / 2.84] italic: [if value [app 'italic]] typeface: [if word? value [app value]] color: [fcolor: to-color value] ] ] if any [fpath fsize fcolor] [ fpath: any [fpath 'self] fsize: any [fsize cur-para/cur-font/size] change-font/color fpath fsize fcolor ] ] set-font-options: has [fpath fsize fcolor] [ if options [ fpath: make path! [self] foreach [word value] options [ switch word [ bold: [if value [append fpath 'bold]] fontsize: [fsize: value / 2.84] italic: [if value [append fpath 'italic]] typeface: [if word? value [append fpath value]] color: [fcolor: to-color value] ] ] change-font/color fpath any [fsize cur-para/cur-font/size] fcolor ] ] increase-margins: func [new-margins /local para-margins diff] [ new-margins: reduce new-margins para-margins: cur-para/margins diff: subtract length? para-margins length? new-margins case [ diff < 0 [ insert/dup tail para-margins copy skip tail para-margins -2 diff / -2 ] diff > 0 [ insert/dup tail new-margins copy skip tail new-margins -2 diff / 2 ] ] forall para-margins [ para-margins/1: para-margins/1 + new-margins/1 new-margins: next new-margins ] ] option?: func [value code] [ if all [options value: select options value] [do bind code 'value] ] |start-header| and |end-header|: -parse-rules-: start-header: func [level /box] [ do pick [ [unless box [emit-penalty -500] emit-space 3 2 2] [unless box [emit-penalty -200] emit-space 3 2 2] [unless box [emit-penalty -100] emit-space 0 2 0] [emit-space 0 2 0] [emit-space 0 1 0] [emit-space 0 1 0] ] level flush-space new-para [ ] change-font/color 'bold pick [ 7 6.34 5.63 4.93 4.23 3.52 ] level 255.153.0 new-para/set-opts [] option? [number:] [emit value] ] end-header: func [level] [ loop 2 [end-para] if level < 3 [ emit compose/deep [ vbox 1 [ line width (pick [0.7 0.4] level) cap round dash [0.001 (pick [1.4 0.8] level)] (pick [0.8 0.5] level) 255.153.0 xbl ybl + 0.5 xtr ybl + 0.5 ] ] ] emit-penalty +infty do pick [ [emit-space 3 2 2] [emit-space 3 2 2] [emit-space 1 2 0] [emit-space 1 1 0] [emit-space 0 1 0] [emit-space 0 1 0] ] level para-indent?: no ] Lists: -parse-rules-: pre-list: does [ emit-space 3 2 2 ] post-list: does [ emit-space 2 1 2 para-indent?: no ] pre-enum: func [/only] [ unless only [ emit-space 3 2 2 flush-space ] emit compose/deep [ table [8 (cur-para/width - 10)] ] start-block emit [ top margin 0 bottom margin 1 stretch 1 top padding 0 bottom padding 0 ] ] post-enum: func [/only] [ end-block unless only [emit-space 3 2 2] ] pre-def: does [ emit-space 3 2 2 flush-space emit compose/deep [ table [20 (cur-para/width - 22)] ] start-block emit [ bottom margin 1 stretch 1 ] ] post-def: does [ end-block emit-space 3 2 2 ] Boxes: -parse-rules-: emit-box-decor: has [bgcol olcol shadow? olstyle] [ either options [ bgcol: yellow shadow?: no foreach [word value] options [ switch word [ background: [bgcol: to-color value] outline-color: [olcol: to-color value] shadow: [shadow?: value] outline-style: [olstyle: value] ] ] if olcol [olstyle: any [olstyle 'solid]] if olstyle [olcol: any [olcol black]] either olstyle = 'rounded [ emit compose/deep [ decor [ (either shadow? [ [set-fill color gray rounded-box-fill xbl + 2 ybl - 2 xtr + 2 ytr - 2] ] [[ ]]) set-fill (bgcol) rounded-box-fill xbl ybl xtr ytr ] ] ] [ either olstyle [ olstyle: switch olstyle [ solid [[edge width 0.2]] dashed [[edge width 0.2 edge dash [3] 0]] dotted [[edge width 0.2 edge dash [0.5] 0]] ] emit compose/deep [ decor [ (either shadow? [ [fill color gray [box xbl + 2 ybl - 2 xtr - xbl ytr - ybl]] ] [[ ]]) solid box edge (olcol) (olstyle) (bgcol) xbl ybl xtr - xbl ytr - ybl ] ] ] [ emit compose/deep [ decor [ (either shadow? [ [fill color gray [box xbl + 2 ybl - 2 xtr - xbl ytr - ybl]] ] [[ ]]) fill (bgcol) [box xbl ybl xtr - xbl ytr - ybl] ] ] ] ] ] [ emit [ decor [ fill color yellow [box xbl ybl xtr - xbl ytr - ybl] ] ] ] ] Colors: -parse-rules-: to-color: func [value] [ switch type?/word value [ issue! [to tuple! debase/base value 16] refinement! [select color-names value] tuple! [value] ] ] color-names: [ /Maroon 128.0.0 /Red 255.0.0 /Orange 255.165.0 /Yellow 255.255.0 /Olive 128.128.0 /Purple 128.0.128 /Fuchsia 255.0.255 /White 255.255.255 /Lime 0.255.0 /Green 0.128.0 /Navy 0.0.128 /Blue 0.0.255 /Aqua 0.255.255 /Teal 0.128.128 /Black 0.0.0 /Silver 192.192.192 /Gray 128.128.128 /AliceBlue 240.248.255 /AntiqueWhite 250.235.215 /Aquamarine 127.255.212 /Azure 240.255.255 /Beige 245.245.220 /Bisque 255.228.196 /BlanchedAlmond 255.235.205 /BlueViolet 138.43.226 /Brown 165.42.42 /BurlyWood 222.184.135 /CadetBlue 95.158.160 /Chartreuse 127.255.0 /Chocolate 210.105.30 /Coral 255.127.80 /CornflowerBlue 100.149.237 /Cornsilk 255.248.220 /Crimson 220.20.60 /Cyan 0.255.255 /DarkBlue 0.0.139 /DarkCyan 0.139.139 /DarkGoldenRod 184.134.11 /DarkGray 169.169.169 /DarkGreen 0.100.0 /DarkKhaki 189.183.107 /DarkMagenta 139.0.139 /DarkOliveGreen 85.107.47 /Darkorange 255.140.0 /DarkOrchid 153.50.204 /DarkRed 139.0.0 /DarkSalmon 233.150.122 /DarkSeaGreen 143.188.143 /DarkSlateBlue 72.61.139 /DarkSlateGray 47.79.79 /DarkTurquoise 0.206.209 /DarkViolet 148.0.211 /DeepPink 255.20.147 /DeepSkyBlue 0.191.255 /DimGray 105.105.105 /DodgerBlue 30.144.255 /Feldspar 209.146.117 /FireBrick 178.34.34 /FloralWhite 255.250.240 /ForestGreen 34.139.34 /Gainsboro 220.220.220 /GhostWhite 248.248.255 /Gold 255.215.0 /GoldenRod 218.165.32 /GreenYellow 173.255.47 /HoneyDew 240.255.240 /HotPink 255.105.180 /IndianRed 205.92.92 /Indigo 75.0.130 /Ivory 255.255.240 /Khaki 240.230.140 /Lavender 230.230.250 /LavenderBlush 255.240.245 /LawnGreen 124.252.0 /LemonChiffon 255.250.205 /LightBlue 173.216.230 /LightCoral 240.128.128 /LightCyan 224.255.255 /LightGoldenRodYellow 250.250.210 /LightGrey 211.211.211 /LightGreen 144.238.144 /LightPink 255.182.193 /LightSalmon 255.160.122 /LightSeaGreen 32.178.170 /LightSkyBlue 135.206.250 /LightSlateBlue 132.112.255 /LightSlateGray 119.136.153 /LightSteelBlue 176.196.222 /LightYellow 255.255.224 /LimeGreen 50.205.50 /Linen 250.240.230 /Magenta 255.0.255 /MediumAquaMarine 102.205.170 /MediumBlue 0.0.205 /MediumOrchid 186.85.211 /MediumPurple 147.112.216 /MediumSeaGreen 60.179.113 /MediumSlateBlue 123.104.238 /MediumSpringGreen 0.250.154 /MediumTurquoise 72.209.204 /MediumVioletRed 199.21.133 /MidnightBlue 25.25.112 /MintCream 245.255.250 /MistyRose 255.228.225 /Moccasin 255.228.181 /NavajoWhite 255.222.173 /OldLace 253.245.230 /OliveDrab 107.142.35 /OrangeRed 255.69.0 /Orchid 218.112.214 /PaleGoldenRod 238.232.170 /PaleGreen 152.251.152 /PaleTurquoise 175.238.238 /PaleVioletRed 216.112.147 /PapayaWhip 255.239.213 /PeachPuff 255.218.185 /Peru 205.133.63 /Pink 255.192.203 /Plum 221.160.221 /PowderBlue 176.224.230 /RosyBrown 188.143.143 /RoyalBlue 65.105.225 /SaddleBrown 139.69.19 /Salmon 250.128.114 /SandyBrown 244.164.96 /SeaGreen 46.139.87 /SeaShell 255.245.238 /Sienna 160.82.45 /SkyBlue 135.206.235 /SlateBlue 106.90.205 /SlateGray 112.128.144 /Snow 255.250.250 /SpringGreen 0.255.127 /SteelBlue 70.130.180 /Tan 210.180.140 /Thistle 216.191.216 /Tomato 255.99.71 /Turquoise 64.224.208 /Violet 238.130.238 /VioletRed 208.32.144 /Wheat 245.222.179 /WhiteSmoke 245.245.245 /YellowGreen 154.205.50 ] ---Options processing -parse-rules-: opts: [ 'opts set val block! (options: val) | (options: none) ] options: none ---Inline level -parse-rules-: inline-level: [ -inline-level-rules- ] ---Other rules -parse-rules-: error: [here: skip (print ["error" copy/part trim/lines mold here 80])] blevel: 1 ilevel: 0 bullets: [ into [ 'item opts ( flush-space new-para/margins/set-opts [width: width - 10] [5 + ilevel 0 10 + ilevel 0] emit compose [bullet (blevel) (cur-para/cur-font/size)] ) any inline-level (end-para emit-space 1 1 0) ] | into ['bullets (ilevel: ilevel + 10 blevel: blevel + 1) any bullets (blevel: blevel - 1 ilevel: ilevel - 10)] | into ['enum (blevel: blevel + 1 pre-enum/only) any enum-items (blevel: blevel - 1 post-enum/only)] | error ] enum-items: [ into [ 'item opts ( start-block start-block emit [ right padding 2 ] new-para/set-opts [alignment: [right align]] option? [number:] [emit value] emit "." end-para end-block start-block new-para/set-opts [width: width - 10] ) any inline-level (end-para loop 2 [end-block]) ] | into ['bullets ( start-block emit [[right padding 2]] start-block new-para [width: width - 10] ) any bullets (end-para loop 2 [end-block])] | into ['enum ( start-block emit [[right padding 2]] start-block new-para [width: width - 10] pre-enum/only ) any enum-items (post-enum/only end-para loop 2 [end-block])] | error ] checks: [ into [ 'check opts ( new-para/margins/set-opts [width: width - 10] [5 0 10 0] option? [checked:] [val: value] flush-space emit compose [check (val) (cur-para/cur-font/fnode/name) (cur-para/cur-font/size)] ) any inline-level (end-para emit-space 1 1 0) ] | error ] definitions: [ ; one or more terms followed by one or more descriptions into [ 'term opts ( loop 2 [start-block] emit [right padding 2] new-para/set-opts/font [alignment: [left align]] 'bold cur-para/cur-font/size ) any inline-level (end-para) ] any [ into [ 'term opts ( new-para/set-opts/font [alignment: [left align]] 'bold cur-para/cur-font/size ) any inline-level (end-para) ] ] into [ 'desc opts ( end-block start-block new-para/set-opts [ ] ) any inline-level (end-para) ] any [into ['desc opts (new-para/set-opts [ ]) any inline-level (end-para)]] (loop 2 [end-block]) | error ] toc-headers: [ into [ 'header1 opts ( flush-space new-para/set-opts [ ] option? [number:] [emit value] ) any inline-level (end-para) ] | into [ 'header2 opts ( flush-space new-para/set-opts/margins [ ] [10 0] option? [number:] [emit value] ) any inline-level (end-para) ] | into [ 'header3 opts ( flush-space new-para/set-opts/margins [ ] [20 0] option? [number:] [emit value] ) any inline-level (end-para) ] ] ---Inline level rules -inline-level-rules-: ;here: (print ["inline-level:" copy/part trim/lines mold here 80]) set val string! (emit val) | into [ 'bold (change-font 'bold cur-para/cur-font/size) any inline-level (reset-font) | 'italic (change-font 'italic cur-para/cur-font/size) any inline-level (reset-font) | 'strike any inline-level | 'link opts (set-font-options) any inline-level (reset-font) | 'alink opts (set-font-options) any inline-level (reset-font) | 'font opts (set-font-options) any inline-level (reset-font) | 'image opts ( option? [src:] [ if image? value: attempt [load value] [ emit compose/deep [ box (value/size/x / 5.334) (value/size/y / 5.334) 0 [ image xbl ybl xtr - xbl ytr - ybl (value) ] ] ] ] ) | 'anchor opts (set-font-options) any inline-level (reset-font) | 'command copy val [string! skip] ] | error ---Table rule -parse-rules-: make-table: func [table-options contents /local columns rows col rh ch w n cell] [ columns: make block! 16 rows: make block! 32 col: 1 rh: ch: no parse contents [ opt [ into [ 'columns any [ into [ 'column opts ( option? [width:] [ if col > length? columns [ insert/dup tail columns none col - length? columns ] poke columns col max any [pick columns col 0] value / 5.334 ] col: col + 1 ) ] ] ] ] any [ into [ 'row opts ( col: 1 append/only rows make block! 16 ) ['header (rh: yes) | (rh: no)] any [ into [ cell: 'cell opts opt ['span pair!] ['header (ch: yes) | (ch: no)] ( if col > length? columns [ insert/dup tail columns none col - length? columns ] option? [width:] [ poke columns col max any [pick columns col 0] value / 5.334 ] insert/only insert tail last rows ch or rh cell col: col + 1 ) to end ] | error ] ] | error ] ] w: 0 n: 0 foreach col columns [ either col [ w: w + col ] [ n: n + 1 ] ] if n > 0 [ w: max 10 cur-para/width - w / n forall columns [ if not columns/1 [columns/1: w] columns/1: columns/1 - 2 ] ] flush-space emit reduce ['table columns] start-block emit [ top padding 1 stretch 1 shrink 0.5 bottom padding 1 stretch 1 shrink 0.5 left padding 1 right padding 1 ] foreach row rows [ col: 1 start-block foreach [header? cell] row [ start-block parse cell [ 'cell opts opt ['span pair!] opt 'header ( emit-cell-decor header? new-para/set-opts/font [ width: pick columns col if header? [ alignment: [center] ] ] either header? ['bold] ['self] cur-para/cur-font/size para-indent?: no ) [ some block-level | end ( if find table-options [force-space:] [ emit reduce ['vspace (cur-para/cur-font/size)] ] ) ] ] end-para end-block col: col + 1 ] end-block ;if foreach cell last output/1 [if cell <> [p] [break/return false] true] [ ; remove back tail output/1 ;] ] end-block ] emit-cell-decor: func [header? /local bgcol olcol olstyle] [ either options [ if header? [bgcol: 157.182.255] foreach [word value] options [ switch word [ background: [bgcol: to-color value] outline-color: [olcol: to-color value] outline-style: [olstyle: value] ] ] if olcol [olstyle: any [olstyle 'solid]] if olstyle [olcol: any [olcol black]] either all [olstyle olstyle <> 'borderless] [ olstyle: switch olstyle [ solid [[edge width 0.2 edge dash solid]] dashed [[edge width 0.2 edge dash [3] 0]] dotted [[edge width 0.2 edge dash [0.5] 0]] ] emit compose/deep either bgcol [[ decor [ solid box edge (olcol) (olstyle) (bgcol) xbl ybl xtr - xbl ytr - ybl ] ]] [[ decor [ box (olcol) (replace/all copy olstyle 'edge 'line) xbl ybl xtr - xbl ytr - ybl ] ]] ] [ if bgcol [ emit compose/deep [ decor [ fill (bgcol) [box xbl ybl xtr - xbl ytr - ybl] ] ] ] ] ] [ emit either header? [[ decor [ solid box 157.182.255 edge width 0.2 edge dash solid edge color black xbl ybl xtr - xbl ytr - ybl ] ]] [[ decor [ box line width 0.2 line dash solid color black xbl ybl xtr - xbl ytr - ybl ] ]] ] ] ===The PDF template -pdf-template-: check-chars: "o3" template: [ define-func 'bullet [level size] [ box size * 0.4 size * 0.5 size * -0.1 compose [ fill (pick [127.76.0 120.120.0] level) [box xbl + 0.1 ybl - 0.1 xtr - xbl ytr - ybl] fill (pick [255.153.0 240.240.0] level) [box xbl ybl xtr - xbl ytr - ybl] ] space size * -0.4 + 5 ] define-func 'check [checked 'font size /local chinf1 chinf2] [ font ZapfDingbats size (chinf1: pdfm/get-char-whd 'ZapfDingbats size check-chars/1 none) check-chars/1 space negate chinf1/width if checked [ height 0 rise size / 7.05 space size / 21.15 (chinf2: pdfm/get-char-whd 'ZapfDingbats size check-chars/2 none) check-chars/2 space size / -21.15 - chinf2/width height none rise 0 ] space 5 font* font size ] define-func 'rounded-box-fill [xbl ybl xtr ytr] [ fill [ xtr - 3 ybl bezier xtr - 1.344 ybl xtr ybl + 1.344 xtr ybl + 3 xtr ytr - 3 bezier xtr ytr - 1.344 xtr - 1.344 ytr xtr - 3 ytr xbl + 3 ytr bezier xbl + 1.656 ytr xbl ytr - 1.344 xbl ytr - 3 xbl ybl + 3 bezier xbl ybl + 1.656 xbl + 1.656 ybl xbl + 3 ybl close ] ] text main out any [ textbox 30 30 150 247 from main ] ]