├── .gitignore ├── .travis.yml ├── Core14_AFMs.zip ├── Core14_AFMs ├── Courier-Bold.afm ├── Courier-BoldOblique.afm ├── Courier-Oblique.afm ├── Courier.afm ├── Helvetica-Bold.afm ├── Helvetica-BoldOblique.afm ├── Helvetica-Oblique.afm ├── Helvetica.afm ├── MustRead.html ├── Symbol.afm ├── Times-Bold.afm ├── Times-BoldItalic.afm ├── Times-Italic.afm ├── Times-Roman.afm └── ZapfDingbats.afm ├── Encodings ├── glyphlist.txt ├── pdfencodings.txt └── zapfdingbats.txt ├── Graphics ├── PDF.hs └── PDF │ ├── Action.hs │ ├── Annotation.hs │ ├── Colors.hs │ ├── Coordinates.hs │ ├── Data │ ├── PDFTree.hs │ └── Trie.hs │ ├── Document.hs │ ├── Documentation.hs │ ├── Draw.hs │ ├── Fonts │ ├── AFMParser.hs │ ├── Encoding.hs │ ├── Font.hs │ ├── FontTypes.hs │ ├── StandardFont.hs │ └── Type1.hs │ ├── Hyphenate.hs │ ├── Hyphenate │ ├── English.hs │ └── LowLevel.hs │ ├── Image.hs │ ├── LowLevel │ ├── Serializer.hs │ └── Types.hs │ ├── Navigation.hs │ ├── Pages.hs │ ├── Pattern.hs │ ├── Resources.hs │ ├── Shading.hs │ ├── Shapes.hs │ ├── Text.hs │ ├── Typesetting.hs │ └── Typesetting │ ├── Box.hs │ ├── Breaking.hs │ ├── Horizontal.hs │ ├── Layout.hs │ ├── StandardStyle.hs │ ├── Vertical.hs │ └── WritingSystem.hs ├── HPDF.cabal ├── LICENSE ├── NEWS.txt ├── README.md ├── Setup.hs ├── TODO.txt ├── Test ├── HPDF-tests.hs ├── Makefile ├── Penrose.hs ├── logo.jpg ├── onepage.hs └── test.hs ├── c ├── conversion.c └── conversion.h ├── changelog └── stack.yaml /.gitignore: -------------------------------------------------------------------------------- 1 | dist/ 2 | test/*.hi 3 | test/*.pdf 4 | test/test 5 | test/afm 6 | test/*.o 7 | .HTF 8 | .stack-work 9 | 10 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | sudo: false 2 | language: c 3 | addons: 4 | apt: 5 | packages: 6 | - libgmp-dev 7 | env: 8 | - ARGS="" 9 | - ARGS="--resolver lts-4" 10 | - ARGS="--resolver lts-3" 11 | - ARGS="--resolver lts" 12 | - ARGS="--resolver nightly" 13 | before_install: 14 | - mkdir -p ~/.local/bin 15 | - export PATH=$HOME/.local/bin:$PATH 16 | - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards 17 | --strip-components=1 -C ~/.local/bin '*/stack' 18 | script: stack $ARGS --no-terminal --install-ghc test --haddock 19 | cache: 20 | directories: 21 | - $HOME/.stack 22 | notifications: 23 | slack: 24 | rooms: 25 | secure: T08fQxhbK0dszfIFxjWKpwN24hORLZTEA0Ax+qAUdyIf0zKRNTLpofcZ9E5pIM6FvXTZjAGeKP9Qym55grFtbTiNm7fpr/LCCdACghaRIi+n0dbw32GpTaj3BNZG4mp5DWyFYpp5lpql6TeUHY/a32HlejQMu3YX7q6apRy26iLewgylBNuW9ixnMR5krwTws6CXy7oa50CCVdHpwf/ye5SCoE5AZ74sRVzGGKrW6xeem5L5HO/sZ5YGWpZ0bbOkBUSGERVCHad/1IBqnwI8RKMT1QwprScCpE8fiRfi6eoSQqsaZTRIKbrzB0w4lLMcIzFBid+jCpGn4gqcFva6qWHYT12v436krXcyuOtUOtQIar3WJnaE6Y4aPWr7gSlIyWHMaS0dvVm0psReWZa1CitfZN80ROEDkVPojn3SewEzGmaLostwtrg1oQ5IIT743brSWnuYL6dtx7i3bv1GYIZ+GP2loxIt2SoV8FIqwGxQ58WfoAnE+IZhvaPQFvO/C89y6Zs27/0WBVJOLan2JIE47nPjxHxFIlpSeZWGoBfZGSyg7z06Ee4+VfPDwl2GjrRCtCzJRm06cSzoX1XVCgFHD2y5XywE5Cxb1hFe7m/6oQG5oU/4a/ax0KTFNf7DBzw+04UnDXlVrgZOsdQOVy0q9e5wClcNF2rLX+eomwM= 26 | -------------------------------------------------------------------------------- /Core14_AFMs.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/alpheccar/HPDF/5a901376470b549b2354cdd8013e655f7ac19e0b/Core14_AFMs.zip -------------------------------------------------------------------------------- /Core14_AFMs/MustRead.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | Core 14 AFM Files - ReadMe 7 | 8 | 9 | 10 | or 11 | 12 | 13 | 14 | 15 | 16 |
This file and the 14 PostScript(R) AFM files it accompanies may be used, copied, and distributed for any purpose and without charge, with or without modification, provided that all copyright notices are retained; that the AFM files are not distributed without this file; that all modifications to this file or any of the AFM files are prominently noted in the modified file(s); and that this paragraph is not modified. Adobe Systems has no responsibility or obligation to support the use of the AFM files. Col
17 | 18 | 19 | 20 | -------------------------------------------------------------------------------- /Core14_AFMs/Symbol.afm: -------------------------------------------------------------------------------- 1 | StartFontMetrics 4.1 2 | Comment Copyright (c) 1985, 1987, 1989, 1990, 1997 Adobe Systems Incorporated. All rights reserved. 3 | Comment Creation Date: Thu May 1 15:12:25 1997 4 | Comment UniqueID 43064 5 | Comment VMusage 30820 39997 6 | FontName Symbol 7 | FullName Symbol 8 | FamilyName Symbol 9 | Weight Medium 10 | ItalicAngle 0 11 | IsFixedPitch false 12 | CharacterSet Special 13 | FontBBox -180 -293 1090 1010 14 | UnderlinePosition -100 15 | UnderlineThickness 50 16 | Version 001.008 17 | Notice Copyright (c) 1985, 1987, 1989, 1990, 1997 Adobe Systems Incorporated. All rights reserved. 18 | EncodingScheme FontSpecific 19 | StdHW 92 20 | StdVW 85 21 | StartCharMetrics 190 22 | C 32 ; WX 250 ; N space ; B 0 0 0 0 ; 23 | C 33 ; WX 333 ; N exclam ; B 128 -17 240 672 ; 24 | C 34 ; WX 713 ; N universal ; B 31 0 681 705 ; 25 | C 35 ; WX 500 ; N numbersign ; B 20 -16 481 673 ; 26 | C 36 ; WX 549 ; N existential ; B 25 0 478 707 ; 27 | C 37 ; WX 833 ; N percent ; B 63 -36 771 655 ; 28 | C 38 ; WX 778 ; N ampersand ; B 41 -18 750 661 ; 29 | C 39 ; WX 439 ; N suchthat ; B 48 -17 414 500 ; 30 | C 40 ; WX 333 ; N parenleft ; B 53 -191 300 673 ; 31 | C 41 ; WX 333 ; N parenright ; B 30 -191 277 673 ; 32 | C 42 ; WX 500 ; N asteriskmath ; B 65 134 427 551 ; 33 | C 43 ; WX 549 ; N plus ; B 10 0 539 533 ; 34 | C 44 ; WX 250 ; N comma ; B 56 -152 194 104 ; 35 | C 45 ; WX 549 ; N minus ; B 11 233 535 288 ; 36 | C 46 ; WX 250 ; N period ; B 69 -17 181 95 ; 37 | C 47 ; WX 278 ; N slash ; B 0 -18 254 646 ; 38 | C 48 ; WX 500 ; N zero ; B 24 -14 476 685 ; 39 | C 49 ; WX 500 ; N one ; B 117 0 390 673 ; 40 | C 50 ; WX 500 ; N two ; B 25 0 475 685 ; 41 | C 51 ; WX 500 ; N three ; B 43 -14 435 685 ; 42 | C 52 ; WX 500 ; N four ; B 15 0 469 685 ; 43 | C 53 ; WX 500 ; N five ; B 32 -14 445 690 ; 44 | C 54 ; WX 500 ; N six ; B 34 -14 468 685 ; 45 | C 55 ; WX 500 ; N seven ; B 24 -16 448 673 ; 46 | C 56 ; WX 500 ; N eight ; B 56 -14 445 685 ; 47 | C 57 ; WX 500 ; N nine ; B 30 -18 459 685 ; 48 | C 58 ; WX 278 ; N colon ; B 81 -17 193 460 ; 49 | C 59 ; WX 278 ; N semicolon ; B 83 -152 221 460 ; 50 | C 60 ; WX 549 ; N less ; B 26 0 523 522 ; 51 | C 61 ; WX 549 ; N equal ; B 11 141 537 390 ; 52 | C 62 ; WX 549 ; N greater ; B 26 0 523 522 ; 53 | C 63 ; WX 444 ; N question ; B 70 -17 412 686 ; 54 | C 64 ; WX 549 ; N congruent ; B 11 0 537 475 ; 55 | C 65 ; WX 722 ; N Alpha ; B 4 0 684 673 ; 56 | C 66 ; WX 667 ; N Beta ; B 29 0 592 673 ; 57 | C 67 ; WX 722 ; N Chi ; B -9 0 704 673 ; 58 | C 68 ; WX 612 ; N Delta ; B 6 0 608 688 ; 59 | C 69 ; WX 611 ; N Epsilon ; B 32 0 617 673 ; 60 | C 70 ; WX 763 ; N Phi ; B 26 0 741 673 ; 61 | C 71 ; WX 603 ; N Gamma ; B 24 0 609 673 ; 62 | C 72 ; WX 722 ; N Eta ; B 39 0 729 673 ; 63 | C 73 ; WX 333 ; N Iota ; B 32 0 316 673 ; 64 | C 74 ; WX 631 ; N theta1 ; B 18 -18 623 689 ; 65 | C 75 ; WX 722 ; N Kappa ; B 35 0 722 673 ; 66 | C 76 ; WX 686 ; N Lambda ; B 6 0 680 688 ; 67 | C 77 ; WX 889 ; N Mu ; B 28 0 887 673 ; 68 | C 78 ; WX 722 ; N Nu ; B 29 -8 720 673 ; 69 | C 79 ; WX 722 ; N Omicron ; B 41 -17 715 685 ; 70 | C 80 ; WX 768 ; N Pi ; B 25 0 745 673 ; 71 | C 81 ; WX 741 ; N Theta ; B 41 -17 715 685 ; 72 | C 82 ; WX 556 ; N Rho ; B 28 0 563 673 ; 73 | C 83 ; WX 592 ; N Sigma ; B 5 0 589 673 ; 74 | C 84 ; WX 611 ; N Tau ; B 33 0 607 673 ; 75 | C 85 ; WX 690 ; N Upsilon ; B -8 0 694 673 ; 76 | C 86 ; WX 439 ; N sigma1 ; B 40 -233 436 500 ; 77 | C 87 ; WX 768 ; N Omega ; B 34 0 736 688 ; 78 | C 88 ; WX 645 ; N Xi ; B 40 0 599 673 ; 79 | C 89 ; WX 795 ; N Psi ; B 15 0 781 684 ; 80 | C 90 ; WX 611 ; N Zeta ; B 44 0 636 673 ; 81 | C 91 ; WX 333 ; N bracketleft ; B 86 -155 299 674 ; 82 | C 92 ; WX 863 ; N therefore ; B 163 0 701 487 ; 83 | C 93 ; WX 333 ; N bracketright ; B 33 -155 246 674 ; 84 | C 94 ; WX 658 ; N perpendicular ; B 15 0 652 674 ; 85 | C 95 ; WX 500 ; N underscore ; B -2 -125 502 -75 ; 86 | C 96 ; WX 500 ; N radicalex ; B 480 881 1090 917 ; 87 | C 97 ; WX 631 ; N alpha ; B 41 -18 622 500 ; 88 | C 98 ; WX 549 ; N beta ; B 61 -223 515 741 ; 89 | C 99 ; WX 549 ; N chi ; B 12 -231 522 499 ; 90 | C 100 ; WX 494 ; N delta ; B 40 -19 481 740 ; 91 | C 101 ; WX 439 ; N epsilon ; B 22 -19 427 502 ; 92 | C 102 ; WX 521 ; N phi ; B 28 -224 492 673 ; 93 | C 103 ; WX 411 ; N gamma ; B 5 -225 484 499 ; 94 | C 104 ; WX 603 ; N eta ; B 0 -202 527 514 ; 95 | C 105 ; WX 329 ; N iota ; B 0 -17 301 503 ; 96 | C 106 ; WX 603 ; N phi1 ; B 36 -224 587 499 ; 97 | C 107 ; WX 549 ; N kappa ; B 33 0 558 501 ; 98 | C 108 ; WX 549 ; N lambda ; B 24 -17 548 739 ; 99 | C 109 ; WX 576 ; N mu ; B 33 -223 567 500 ; 100 | C 110 ; WX 521 ; N nu ; B -9 -16 475 507 ; 101 | C 111 ; WX 549 ; N omicron ; B 35 -19 501 499 ; 102 | C 112 ; WX 549 ; N pi ; B 10 -19 530 487 ; 103 | C 113 ; WX 521 ; N theta ; B 43 -17 485 690 ; 104 | C 114 ; WX 549 ; N rho ; B 50 -230 490 499 ; 105 | C 115 ; WX 603 ; N sigma ; B 30 -21 588 500 ; 106 | C 116 ; WX 439 ; N tau ; B 10 -19 418 500 ; 107 | C 117 ; WX 576 ; N upsilon ; B 7 -18 535 507 ; 108 | C 118 ; WX 713 ; N omega1 ; B 12 -18 671 583 ; 109 | C 119 ; WX 686 ; N omega ; B 42 -17 684 500 ; 110 | C 120 ; WX 493 ; N xi ; B 27 -224 469 766 ; 111 | C 121 ; WX 686 ; N psi ; B 12 -228 701 500 ; 112 | C 122 ; WX 494 ; N zeta ; B 60 -225 467 756 ; 113 | C 123 ; WX 480 ; N braceleft ; B 58 -183 397 673 ; 114 | C 124 ; WX 200 ; N bar ; B 65 -293 135 707 ; 115 | C 125 ; WX 480 ; N braceright ; B 79 -183 418 673 ; 116 | C 126 ; WX 549 ; N similar ; B 17 203 529 307 ; 117 | C 160 ; WX 750 ; N Euro ; B 20 -12 714 685 ; 118 | C 161 ; WX 620 ; N Upsilon1 ; B -2 0 610 685 ; 119 | C 162 ; WX 247 ; N minute ; B 27 459 228 735 ; 120 | C 163 ; WX 549 ; N lessequal ; B 29 0 526 639 ; 121 | C 164 ; WX 167 ; N fraction ; B -180 -12 340 677 ; 122 | C 165 ; WX 713 ; N infinity ; B 26 124 688 404 ; 123 | C 166 ; WX 500 ; N florin ; B 2 -193 494 686 ; 124 | C 167 ; WX 753 ; N club ; B 86 -26 660 533 ; 125 | C 168 ; WX 753 ; N diamond ; B 142 -36 600 550 ; 126 | C 169 ; WX 753 ; N heart ; B 117 -33 631 532 ; 127 | C 170 ; WX 753 ; N spade ; B 113 -36 629 548 ; 128 | C 171 ; WX 1042 ; N arrowboth ; B 24 -15 1024 511 ; 129 | C 172 ; WX 987 ; N arrowleft ; B 32 -15 942 511 ; 130 | C 173 ; WX 603 ; N arrowup ; B 45 0 571 910 ; 131 | C 174 ; WX 987 ; N arrowright ; B 49 -15 959 511 ; 132 | C 175 ; WX 603 ; N arrowdown ; B 45 -22 571 888 ; 133 | C 176 ; WX 400 ; N degree ; B 50 385 350 685 ; 134 | C 177 ; WX 549 ; N plusminus ; B 10 0 539 645 ; 135 | C 178 ; WX 411 ; N second ; B 20 459 413 737 ; 136 | C 179 ; WX 549 ; N greaterequal ; B 29 0 526 639 ; 137 | C 180 ; WX 549 ; N multiply ; B 17 8 533 524 ; 138 | C 181 ; WX 713 ; N proportional ; B 27 123 639 404 ; 139 | C 182 ; WX 494 ; N partialdiff ; B 26 -20 462 746 ; 140 | C 183 ; WX 460 ; N bullet ; B 50 113 410 473 ; 141 | C 184 ; WX 549 ; N divide ; B 10 71 536 456 ; 142 | C 185 ; WX 549 ; N notequal ; B 15 -25 540 549 ; 143 | C 186 ; WX 549 ; N equivalence ; B 14 82 538 443 ; 144 | C 187 ; WX 549 ; N approxequal ; B 14 135 527 394 ; 145 | C 188 ; WX 1000 ; N ellipsis ; B 111 -17 889 95 ; 146 | C 189 ; WX 603 ; N arrowvertex ; B 280 -120 336 1010 ; 147 | C 190 ; WX 1000 ; N arrowhorizex ; B -60 220 1050 276 ; 148 | C 191 ; WX 658 ; N carriagereturn ; B 15 -16 602 629 ; 149 | C 192 ; WX 823 ; N aleph ; B 175 -18 661 658 ; 150 | C 193 ; WX 686 ; N Ifraktur ; B 10 -53 578 740 ; 151 | C 194 ; WX 795 ; N Rfraktur ; B 26 -15 759 734 ; 152 | C 195 ; WX 987 ; N weierstrass ; B 159 -211 870 573 ; 153 | C 196 ; WX 768 ; N circlemultiply ; B 43 -17 733 673 ; 154 | C 197 ; WX 768 ; N circleplus ; B 43 -15 733 675 ; 155 | C 198 ; WX 823 ; N emptyset ; B 39 -24 781 719 ; 156 | C 199 ; WX 768 ; N intersection ; B 40 0 732 509 ; 157 | C 200 ; WX 768 ; N union ; B 40 -17 732 492 ; 158 | C 201 ; WX 713 ; N propersuperset ; B 20 0 673 470 ; 159 | C 202 ; WX 713 ; N reflexsuperset ; B 20 -125 673 470 ; 160 | C 203 ; WX 713 ; N notsubset ; B 36 -70 690 540 ; 161 | C 204 ; WX 713 ; N propersubset ; B 37 0 690 470 ; 162 | C 205 ; WX 713 ; N reflexsubset ; B 37 -125 690 470 ; 163 | C 206 ; WX 713 ; N element ; B 45 0 505 468 ; 164 | C 207 ; WX 713 ; N notelement ; B 45 -58 505 555 ; 165 | C 208 ; WX 768 ; N angle ; B 26 0 738 673 ; 166 | C 209 ; WX 713 ; N gradient ; B 36 -19 681 718 ; 167 | C 210 ; WX 790 ; N registerserif ; B 50 -17 740 673 ; 168 | C 211 ; WX 790 ; N copyrightserif ; B 51 -15 741 675 ; 169 | C 212 ; WX 890 ; N trademarkserif ; B 18 293 855 673 ; 170 | C 213 ; WX 823 ; N product ; B 25 -101 803 751 ; 171 | C 214 ; WX 549 ; N radical ; B 10 -38 515 917 ; 172 | C 215 ; WX 250 ; N dotmath ; B 69 210 169 310 ; 173 | C 216 ; WX 713 ; N logicalnot ; B 15 0 680 288 ; 174 | C 217 ; WX 603 ; N logicaland ; B 23 0 583 454 ; 175 | C 218 ; WX 603 ; N logicalor ; B 30 0 578 477 ; 176 | C 219 ; WX 1042 ; N arrowdblboth ; B 27 -20 1023 510 ; 177 | C 220 ; WX 987 ; N arrowdblleft ; B 30 -15 939 513 ; 178 | C 221 ; WX 603 ; N arrowdblup ; B 39 2 567 911 ; 179 | C 222 ; WX 987 ; N arrowdblright ; B 45 -20 954 508 ; 180 | C 223 ; WX 603 ; N arrowdbldown ; B 44 -19 572 890 ; 181 | C 224 ; WX 494 ; N lozenge ; B 18 0 466 745 ; 182 | C 225 ; WX 329 ; N angleleft ; B 25 -198 306 746 ; 183 | C 226 ; WX 790 ; N registersans ; B 50 -20 740 670 ; 184 | C 227 ; WX 790 ; N copyrightsans ; B 49 -15 739 675 ; 185 | C 228 ; WX 786 ; N trademarksans ; B 5 293 725 673 ; 186 | C 229 ; WX 713 ; N summation ; B 14 -108 695 752 ; 187 | C 230 ; WX 384 ; N parenlefttp ; B 24 -293 436 926 ; 188 | C 231 ; WX 384 ; N parenleftex ; B 24 -85 108 925 ; 189 | C 232 ; WX 384 ; N parenleftbt ; B 24 -293 436 926 ; 190 | C 233 ; WX 384 ; N bracketlefttp ; B 0 -80 349 926 ; 191 | C 234 ; WX 384 ; N bracketleftex ; B 0 -79 77 925 ; 192 | C 235 ; WX 384 ; N bracketleftbt ; B 0 -80 349 926 ; 193 | C 236 ; WX 494 ; N bracelefttp ; B 209 -85 445 925 ; 194 | C 237 ; WX 494 ; N braceleftmid ; B 20 -85 284 935 ; 195 | C 238 ; WX 494 ; N braceleftbt ; B 209 -75 445 935 ; 196 | C 239 ; WX 494 ; N braceex ; B 209 -85 284 935 ; 197 | C 241 ; WX 329 ; N angleright ; B 21 -198 302 746 ; 198 | C 242 ; WX 274 ; N integral ; B 2 -107 291 916 ; 199 | C 243 ; WX 686 ; N integraltp ; B 308 -88 675 920 ; 200 | C 244 ; WX 686 ; N integralex ; B 308 -88 378 975 ; 201 | C 245 ; WX 686 ; N integralbt ; B 11 -87 378 921 ; 202 | C 246 ; WX 384 ; N parenrighttp ; B 54 -293 466 926 ; 203 | C 247 ; WX 384 ; N parenrightex ; B 382 -85 466 925 ; 204 | C 248 ; WX 384 ; N parenrightbt ; B 54 -293 466 926 ; 205 | C 249 ; WX 384 ; N bracketrighttp ; B 22 -80 371 926 ; 206 | C 250 ; WX 384 ; N bracketrightex ; B 294 -79 371 925 ; 207 | C 251 ; WX 384 ; N bracketrightbt ; B 22 -80 371 926 ; 208 | C 252 ; WX 494 ; N bracerighttp ; B 48 -85 284 925 ; 209 | C 253 ; WX 494 ; N bracerightmid ; B 209 -85 473 935 ; 210 | C 254 ; WX 494 ; N bracerightbt ; B 48 -75 284 935 ; 211 | C -1 ; WX 790 ; N apple ; B 56 -3 733 808 ; 212 | EndCharMetrics 213 | EndFontMetrics 214 | -------------------------------------------------------------------------------- /Core14_AFMs/ZapfDingbats.afm: -------------------------------------------------------------------------------- 1 | StartFontMetrics 4.1 2 | Comment Copyright (c) 1985, 1987, 1988, 1989, 1997 Adobe Systems Incorporated. All Rights Reserved. 3 | Comment Creation Date: Thu May 1 15:14:13 1997 4 | Comment UniqueID 43082 5 | Comment VMusage 45775 55535 6 | FontName ZapfDingbats 7 | FullName ITC Zapf Dingbats 8 | FamilyName ZapfDingbats 9 | Weight Medium 10 | ItalicAngle 0 11 | IsFixedPitch false 12 | CharacterSet Special 13 | FontBBox -1 -143 981 820 14 | UnderlinePosition -100 15 | UnderlineThickness 50 16 | Version 002.000 17 | Notice Copyright (c) 1985, 1987, 1988, 1989, 1997 Adobe Systems Incorporated. All Rights Reserved.ITC Zapf Dingbats is a registered trademark of International Typeface Corporation. 18 | EncodingScheme FontSpecific 19 | StdHW 28 20 | StdVW 90 21 | StartCharMetrics 202 22 | C 32 ; WX 278 ; N space ; B 0 0 0 0 ; 23 | C 33 ; WX 974 ; N a1 ; B 35 72 939 621 ; 24 | C 34 ; WX 961 ; N a2 ; B 35 81 927 611 ; 25 | C 35 ; WX 974 ; N a202 ; B 35 72 939 621 ; 26 | C 36 ; WX 980 ; N a3 ; B 35 0 945 692 ; 27 | C 37 ; WX 719 ; N a4 ; B 34 139 685 566 ; 28 | C 38 ; WX 789 ; N a5 ; B 35 -14 755 705 ; 29 | C 39 ; WX 790 ; N a119 ; B 35 -14 755 705 ; 30 | C 40 ; WX 791 ; N a118 ; B 35 -13 761 705 ; 31 | C 41 ; WX 690 ; N a117 ; B 34 138 655 553 ; 32 | C 42 ; WX 960 ; N a11 ; B 35 123 925 568 ; 33 | C 43 ; WX 939 ; N a12 ; B 35 134 904 559 ; 34 | C 44 ; WX 549 ; N a13 ; B 29 -11 516 705 ; 35 | C 45 ; WX 855 ; N a14 ; B 34 59 820 632 ; 36 | C 46 ; WX 911 ; N a15 ; B 35 50 876 642 ; 37 | C 47 ; WX 933 ; N a16 ; B 35 139 899 550 ; 38 | C 48 ; WX 911 ; N a105 ; B 35 50 876 642 ; 39 | C 49 ; WX 945 ; N a17 ; B 35 139 909 553 ; 40 | C 50 ; WX 974 ; N a18 ; B 35 104 938 587 ; 41 | C 51 ; WX 755 ; N a19 ; B 34 -13 721 705 ; 42 | C 52 ; WX 846 ; N a20 ; B 36 -14 811 705 ; 43 | C 53 ; WX 762 ; N a21 ; B 35 0 727 692 ; 44 | C 54 ; WX 761 ; N a22 ; B 35 0 727 692 ; 45 | C 55 ; WX 571 ; N a23 ; B -1 -68 571 661 ; 46 | C 56 ; WX 677 ; N a24 ; B 36 -13 642 705 ; 47 | C 57 ; WX 763 ; N a25 ; B 35 0 728 692 ; 48 | C 58 ; WX 760 ; N a26 ; B 35 0 726 692 ; 49 | C 59 ; WX 759 ; N a27 ; B 35 0 725 692 ; 50 | C 60 ; WX 754 ; N a28 ; B 35 0 720 692 ; 51 | C 61 ; WX 494 ; N a6 ; B 35 0 460 692 ; 52 | C 62 ; WX 552 ; N a7 ; B 35 0 517 692 ; 53 | C 63 ; WX 537 ; N a8 ; B 35 0 503 692 ; 54 | C 64 ; WX 577 ; N a9 ; B 35 96 542 596 ; 55 | C 65 ; WX 692 ; N a10 ; B 35 -14 657 705 ; 56 | C 66 ; WX 786 ; N a29 ; B 35 -14 751 705 ; 57 | C 67 ; WX 788 ; N a30 ; B 35 -14 752 705 ; 58 | C 68 ; WX 788 ; N a31 ; B 35 -14 753 705 ; 59 | C 69 ; WX 790 ; N a32 ; B 35 -14 756 705 ; 60 | C 70 ; WX 793 ; N a33 ; B 35 -13 759 705 ; 61 | C 71 ; WX 794 ; N a34 ; B 35 -13 759 705 ; 62 | C 72 ; WX 816 ; N a35 ; B 35 -14 782 705 ; 63 | C 73 ; WX 823 ; N a36 ; B 35 -14 787 705 ; 64 | C 74 ; WX 789 ; N a37 ; B 35 -14 754 705 ; 65 | C 75 ; WX 841 ; N a38 ; B 35 -14 807 705 ; 66 | C 76 ; WX 823 ; N a39 ; B 35 -14 789 705 ; 67 | C 77 ; WX 833 ; N a40 ; B 35 -14 798 705 ; 68 | C 78 ; WX 816 ; N a41 ; B 35 -13 782 705 ; 69 | C 79 ; WX 831 ; N a42 ; B 35 -14 796 705 ; 70 | C 80 ; WX 923 ; N a43 ; B 35 -14 888 705 ; 71 | C 81 ; WX 744 ; N a44 ; B 35 0 710 692 ; 72 | C 82 ; WX 723 ; N a45 ; B 35 0 688 692 ; 73 | C 83 ; WX 749 ; N a46 ; B 35 0 714 692 ; 74 | C 84 ; WX 790 ; N a47 ; B 34 -14 756 705 ; 75 | C 85 ; WX 792 ; N a48 ; B 35 -14 758 705 ; 76 | C 86 ; WX 695 ; N a49 ; B 35 -14 661 706 ; 77 | C 87 ; WX 776 ; N a50 ; B 35 -6 741 699 ; 78 | C 88 ; WX 768 ; N a51 ; B 35 -7 734 699 ; 79 | C 89 ; WX 792 ; N a52 ; B 35 -14 757 705 ; 80 | C 90 ; WX 759 ; N a53 ; B 35 0 725 692 ; 81 | C 91 ; WX 707 ; N a54 ; B 35 -13 672 704 ; 82 | C 92 ; WX 708 ; N a55 ; B 35 -14 672 705 ; 83 | C 93 ; WX 682 ; N a56 ; B 35 -14 647 705 ; 84 | C 94 ; WX 701 ; N a57 ; B 35 -14 666 705 ; 85 | C 95 ; WX 826 ; N a58 ; B 35 -14 791 705 ; 86 | C 96 ; WX 815 ; N a59 ; B 35 -14 780 705 ; 87 | C 97 ; WX 789 ; N a60 ; B 35 -14 754 705 ; 88 | C 98 ; WX 789 ; N a61 ; B 35 -14 754 705 ; 89 | C 99 ; WX 707 ; N a62 ; B 34 -14 673 705 ; 90 | C 100 ; WX 687 ; N a63 ; B 36 0 651 692 ; 91 | C 101 ; WX 696 ; N a64 ; B 35 0 661 691 ; 92 | C 102 ; WX 689 ; N a65 ; B 35 0 655 692 ; 93 | C 103 ; WX 786 ; N a66 ; B 34 -14 751 705 ; 94 | C 104 ; WX 787 ; N a67 ; B 35 -14 752 705 ; 95 | C 105 ; WX 713 ; N a68 ; B 35 -14 678 705 ; 96 | C 106 ; WX 791 ; N a69 ; B 35 -14 756 705 ; 97 | C 107 ; WX 785 ; N a70 ; B 36 -14 751 705 ; 98 | C 108 ; WX 791 ; N a71 ; B 35 -14 757 705 ; 99 | C 109 ; WX 873 ; N a72 ; B 35 -14 838 705 ; 100 | C 110 ; WX 761 ; N a73 ; B 35 0 726 692 ; 101 | C 111 ; WX 762 ; N a74 ; B 35 0 727 692 ; 102 | C 112 ; WX 762 ; N a203 ; B 35 0 727 692 ; 103 | C 113 ; WX 759 ; N a75 ; B 35 0 725 692 ; 104 | C 114 ; WX 759 ; N a204 ; B 35 0 725 692 ; 105 | C 115 ; WX 892 ; N a76 ; B 35 0 858 705 ; 106 | C 116 ; WX 892 ; N a77 ; B 35 -14 858 692 ; 107 | C 117 ; WX 788 ; N a78 ; B 35 -14 754 705 ; 108 | C 118 ; WX 784 ; N a79 ; B 35 -14 749 705 ; 109 | C 119 ; WX 438 ; N a81 ; B 35 -14 403 705 ; 110 | C 120 ; WX 138 ; N a82 ; B 35 0 104 692 ; 111 | C 121 ; WX 277 ; N a83 ; B 35 0 242 692 ; 112 | C 122 ; WX 415 ; N a84 ; B 35 0 380 692 ; 113 | C 123 ; WX 392 ; N a97 ; B 35 263 357 705 ; 114 | C 124 ; WX 392 ; N a98 ; B 34 263 357 705 ; 115 | C 125 ; WX 668 ; N a99 ; B 35 263 633 705 ; 116 | C 126 ; WX 668 ; N a100 ; B 36 263 634 705 ; 117 | C 128 ; WX 390 ; N a89 ; B 35 -14 356 705 ; 118 | C 129 ; WX 390 ; N a90 ; B 35 -14 355 705 ; 119 | C 130 ; WX 317 ; N a93 ; B 35 0 283 692 ; 120 | C 131 ; WX 317 ; N a94 ; B 35 0 283 692 ; 121 | C 132 ; WX 276 ; N a91 ; B 35 0 242 692 ; 122 | C 133 ; WX 276 ; N a92 ; B 35 0 242 692 ; 123 | C 134 ; WX 509 ; N a205 ; B 35 0 475 692 ; 124 | C 135 ; WX 509 ; N a85 ; B 35 0 475 692 ; 125 | C 136 ; WX 410 ; N a206 ; B 35 0 375 692 ; 126 | C 137 ; WX 410 ; N a86 ; B 35 0 375 692 ; 127 | C 138 ; WX 234 ; N a87 ; B 35 -14 199 705 ; 128 | C 139 ; WX 234 ; N a88 ; B 35 -14 199 705 ; 129 | C 140 ; WX 334 ; N a95 ; B 35 0 299 692 ; 130 | C 141 ; WX 334 ; N a96 ; B 35 0 299 692 ; 131 | C 161 ; WX 732 ; N a101 ; B 35 -143 697 806 ; 132 | C 162 ; WX 544 ; N a102 ; B 56 -14 488 706 ; 133 | C 163 ; WX 544 ; N a103 ; B 34 -14 508 705 ; 134 | C 164 ; WX 910 ; N a104 ; B 35 40 875 651 ; 135 | C 165 ; WX 667 ; N a106 ; B 35 -14 633 705 ; 136 | C 166 ; WX 760 ; N a107 ; B 35 -14 726 705 ; 137 | C 167 ; WX 760 ; N a108 ; B 0 121 758 569 ; 138 | C 168 ; WX 776 ; N a112 ; B 35 0 741 705 ; 139 | C 169 ; WX 595 ; N a111 ; B 34 -14 560 705 ; 140 | C 170 ; WX 694 ; N a110 ; B 35 -14 659 705 ; 141 | C 171 ; WX 626 ; N a109 ; B 34 0 591 705 ; 142 | C 172 ; WX 788 ; N a120 ; B 35 -14 754 705 ; 143 | C 173 ; WX 788 ; N a121 ; B 35 -14 754 705 ; 144 | C 174 ; WX 788 ; N a122 ; B 35 -14 754 705 ; 145 | C 175 ; WX 788 ; N a123 ; B 35 -14 754 705 ; 146 | C 176 ; WX 788 ; N a124 ; B 35 -14 754 705 ; 147 | C 177 ; WX 788 ; N a125 ; B 35 -14 754 705 ; 148 | C 178 ; WX 788 ; N a126 ; B 35 -14 754 705 ; 149 | C 179 ; WX 788 ; N a127 ; B 35 -14 754 705 ; 150 | C 180 ; WX 788 ; N a128 ; B 35 -14 754 705 ; 151 | C 181 ; WX 788 ; N a129 ; B 35 -14 754 705 ; 152 | C 182 ; WX 788 ; N a130 ; B 35 -14 754 705 ; 153 | C 183 ; WX 788 ; N a131 ; B 35 -14 754 705 ; 154 | C 184 ; WX 788 ; N a132 ; B 35 -14 754 705 ; 155 | C 185 ; WX 788 ; N a133 ; B 35 -14 754 705 ; 156 | C 186 ; WX 788 ; N a134 ; B 35 -14 754 705 ; 157 | C 187 ; WX 788 ; N a135 ; B 35 -14 754 705 ; 158 | C 188 ; WX 788 ; N a136 ; B 35 -14 754 705 ; 159 | C 189 ; WX 788 ; N a137 ; B 35 -14 754 705 ; 160 | C 190 ; WX 788 ; N a138 ; B 35 -14 754 705 ; 161 | C 191 ; WX 788 ; N a139 ; B 35 -14 754 705 ; 162 | C 192 ; WX 788 ; N a140 ; B 35 -14 754 705 ; 163 | C 193 ; WX 788 ; N a141 ; B 35 -14 754 705 ; 164 | C 194 ; WX 788 ; N a142 ; B 35 -14 754 705 ; 165 | C 195 ; WX 788 ; N a143 ; B 35 -14 754 705 ; 166 | C 196 ; WX 788 ; N a144 ; B 35 -14 754 705 ; 167 | C 197 ; WX 788 ; N a145 ; B 35 -14 754 705 ; 168 | C 198 ; WX 788 ; N a146 ; B 35 -14 754 705 ; 169 | C 199 ; WX 788 ; N a147 ; B 35 -14 754 705 ; 170 | C 200 ; WX 788 ; N a148 ; B 35 -14 754 705 ; 171 | C 201 ; WX 788 ; N a149 ; B 35 -14 754 705 ; 172 | C 202 ; WX 788 ; N a150 ; B 35 -14 754 705 ; 173 | C 203 ; WX 788 ; N a151 ; B 35 -14 754 705 ; 174 | C 204 ; WX 788 ; N a152 ; B 35 -14 754 705 ; 175 | C 205 ; WX 788 ; N a153 ; B 35 -14 754 705 ; 176 | C 206 ; WX 788 ; N a154 ; B 35 -14 754 705 ; 177 | C 207 ; WX 788 ; N a155 ; B 35 -14 754 705 ; 178 | C 208 ; WX 788 ; N a156 ; B 35 -14 754 705 ; 179 | C 209 ; WX 788 ; N a157 ; B 35 -14 754 705 ; 180 | C 210 ; WX 788 ; N a158 ; B 35 -14 754 705 ; 181 | C 211 ; WX 788 ; N a159 ; B 35 -14 754 705 ; 182 | C 212 ; WX 894 ; N a160 ; B 35 58 860 634 ; 183 | C 213 ; WX 838 ; N a161 ; B 35 152 803 540 ; 184 | C 214 ; WX 1016 ; N a163 ; B 34 152 981 540 ; 185 | C 215 ; WX 458 ; N a164 ; B 35 -127 422 820 ; 186 | C 216 ; WX 748 ; N a196 ; B 35 94 698 597 ; 187 | C 217 ; WX 924 ; N a165 ; B 35 140 890 552 ; 188 | C 218 ; WX 748 ; N a192 ; B 35 94 698 597 ; 189 | C 219 ; WX 918 ; N a166 ; B 35 166 884 526 ; 190 | C 220 ; WX 927 ; N a167 ; B 35 32 892 660 ; 191 | C 221 ; WX 928 ; N a168 ; B 35 129 891 562 ; 192 | C 222 ; WX 928 ; N a169 ; B 35 128 893 563 ; 193 | C 223 ; WX 834 ; N a170 ; B 35 155 799 537 ; 194 | C 224 ; WX 873 ; N a171 ; B 35 93 838 599 ; 195 | C 225 ; WX 828 ; N a172 ; B 35 104 791 588 ; 196 | C 226 ; WX 924 ; N a173 ; B 35 98 889 594 ; 197 | C 227 ; WX 924 ; N a162 ; B 35 98 889 594 ; 198 | C 228 ; WX 917 ; N a174 ; B 35 0 882 692 ; 199 | C 229 ; WX 930 ; N a175 ; B 35 84 896 608 ; 200 | C 230 ; WX 931 ; N a176 ; B 35 84 896 608 ; 201 | C 231 ; WX 463 ; N a177 ; B 35 -99 429 791 ; 202 | C 232 ; WX 883 ; N a178 ; B 35 71 848 623 ; 203 | C 233 ; WX 836 ; N a179 ; B 35 44 802 648 ; 204 | C 234 ; WX 836 ; N a193 ; B 35 44 802 648 ; 205 | C 235 ; WX 867 ; N a180 ; B 35 101 832 591 ; 206 | C 236 ; WX 867 ; N a199 ; B 35 101 832 591 ; 207 | C 237 ; WX 696 ; N a181 ; B 35 44 661 648 ; 208 | C 238 ; WX 696 ; N a200 ; B 35 44 661 648 ; 209 | C 239 ; WX 874 ; N a182 ; B 35 77 840 619 ; 210 | C 241 ; WX 874 ; N a201 ; B 35 73 840 615 ; 211 | C 242 ; WX 760 ; N a183 ; B 35 0 725 692 ; 212 | C 243 ; WX 946 ; N a184 ; B 35 160 911 533 ; 213 | C 244 ; WX 771 ; N a197 ; B 34 37 736 655 ; 214 | C 245 ; WX 865 ; N a185 ; B 35 207 830 481 ; 215 | C 246 ; WX 771 ; N a194 ; B 34 37 736 655 ; 216 | C 247 ; WX 888 ; N a198 ; B 34 -19 853 712 ; 217 | C 248 ; WX 967 ; N a186 ; B 35 124 932 568 ; 218 | C 249 ; WX 888 ; N a195 ; B 34 -19 853 712 ; 219 | C 250 ; WX 831 ; N a187 ; B 35 113 796 579 ; 220 | C 251 ; WX 873 ; N a188 ; B 36 118 838 578 ; 221 | C 252 ; WX 927 ; N a189 ; B 35 150 891 542 ; 222 | C 253 ; WX 970 ; N a190 ; B 35 76 931 616 ; 223 | C 254 ; WX 918 ; N a191 ; B 34 99 884 593 ; 224 | EndCharMetrics 225 | EndFontMetrics 226 | -------------------------------------------------------------------------------- /Encodings/pdfencodings.txt: -------------------------------------------------------------------------------- 1 | NAME STD MAC WIN PDF 2 | A 101 101 101 101 3 | AE 341 256 306 306 4 | Aacute - 347 301 301 5 | Acircumflex - 345 302 302 6 | Adieresis - 200 304 304 7 | Agrave - 313 300 300 8 | Aring - 201 305 305 9 | Atilde - 314 303 303 10 | B 102 102 102 102 11 | C 103 103 103 103 12 | Ccedilla - 202 307 307 13 | D 104 104 104 104 14 | E 105 105 105 105 15 | Eacute - 203 311 311 16 | Ecircumflex - 346 312 312 17 | Edieresis - 350 313 313 18 | Egrave - 351 310 310 19 | Eth - - 320 320 20 | Euro - - 200 240 21 | F 106 106 106 106 22 | G 107 107 107 107 23 | H 110 110 110 110 24 | I 111 111 111 111 25 | Iacute - 352 315 315 26 | Icircumflex - 353 316 316 27 | Idieresis - 354 317 317 28 | Igrave - 355 314 314 29 | J 112 112 112 112 30 | K 113 113 113 113 31 | L 114 114 114 114 32 | Lslash 350 - - 225 33 | M 115 115 115 115 34 | N 116 116 116 116 35 | Ntilde - 204 321 321 36 | O 117 117 117 117 37 | OE 352 316 214 226 38 | Oacute - 356 323 323 39 | Ocircumflex - 357 324 324 40 | Odieresis - 205 326 326 41 | Ograve - 361 322 322 42 | Oslash 351 257 330 330 43 | Otilde - 315 325 325 44 | P 120 120 120 120 45 | Q 121 121 121 121 46 | R 122 122 122 122 47 | S 123 123 123 123 48 | Scaron - - 212 227 49 | T 124 124 124 124 50 | Thorn - - 336 336 51 | U 125 125 125 125 52 | Uacute - 362 332 332 53 | Ucircumflex - 363 333 333 54 | Udieresis - 206 334 334 55 | Ugrave - 364 331 331 56 | V 126 126 126 126 57 | W 127 127 127 127 58 | X 130 130 130 130 59 | Y 131 131 131 131 60 | Yacute - - 335 335 61 | Ydieresis - 331 237 230 62 | Z 132 132 132 132 63 | Zcaron - - 216 231 64 | a 141 141 141 141 65 | aacute - 207 341 341 66 | acircumflex - 211 342 342 67 | acute 302 253 264 264 68 | adieresis - 212 344 344 69 | ae 361 276 346 346 70 | agrave - 210 340 340 71 | ampersand 046 046 046 046 72 | aring - 214 345 345 73 | asciicircum 136 136 136 136 74 | asciitilde 176 176 176 176 75 | asterisk 052 052 052 052 76 | at 100 100 100 100 77 | atilde - 213 343 343 78 | b 142 142 142 142 79 | backslash 134 134 134 134 80 | bar 174 174 174 174 81 | braceleft 173 173 173 173 82 | braceright 175 175 175 175 83 | bracketleft 133 133 133 133 84 | bracketright 135 135 135 135 85 | breve 306 371 - 030 86 | brokenbar - - 246 246 87 | bullet 267 245 225 200 88 | c 143 143 143 143 89 | caron 317 377 - 031 90 | ccedilla - 215 347 347 91 | cedilla 313 374 270 270 92 | cent 242 242 242 242 93 | circumflex 303 366 210 032 94 | colon 072 072 072 072 95 | comma 054 054 054 054 96 | copyright - 251 251 251 97 | currency1 250 333 244 244 98 | d 144 144 144 144 99 | dagger 262 240 206 201 100 | daggerdbl 263 340 207 202 101 | degree - 241 260 260 102 | dieresis 310 254 250 250 103 | divide - 326 367 367 104 | dollar 044 044 044 044 105 | dotaccent 307 372 - 033 106 | dotlessi 365 365 - 232 107 | e 145 145 145 145 108 | eacute - 216 351 351 109 | ecircumflex - 220 352 352 110 | edieresis - 221 353 353 111 | egrave - 217 350 350 112 | eight 070 070 070 070 113 | ellipsis 274 311 205 203 114 | emdash 320 321 227 204 115 | endash 261 320 226 205 116 | equal 075 075 075 075 117 | eth - - 360 360 118 | exclam 041 041 041 041 119 | exclamdown 241 301 241 241 120 | f 146 146 146 146 121 | fi 256 336 - 223 122 | five 065 065 065 065 123 | fl 257 337 - 224 124 | florin 246 304 203 206 125 | four 064 064 064 064 126 | fraction 244 332 - 207 127 | g 147 147 147 147 128 | germandbls 373 247 337 337 129 | grave 301 140 140 140 130 | greater 076 076 076 076 131 | guillemotleft 253 307 253 253 132 | guillemotright 273 310 273 273 133 | guilsinglleft 254 334 213 210 134 | guilsinglright 255 335 233 211 135 | h 150 150 150 150 136 | hungarumlaut 315 375 - 034 137 | hyphen 055 055 055 055 138 | i 151 151 151 151 139 | iacute - 222 355 355 140 | icircumflex - 224 356 356 141 | idieresis - 225 357 357 142 | igrave - 223 354 354 143 | j 152 152 152 152 144 | k 153 153 153 153 145 | l 154 154 154 154 146 | less 074 074 074 074 147 | logicalnot - 302 254 254 148 | lslash 370 - - 233 149 | m 155 155 155 155 150 | macron 305 370 257 257 151 | minus - - - 212 152 | mu - 265 265 265 153 | multiply - - 327 327 154 | n 156 156 156 156 155 | nine 071 071 071 071 156 | ntilde - 226 361 361 157 | numbersign 043 043 043 043 158 | o 157 157 157 157 159 | oacute - 227 363 363 160 | ocircumflex - 231 364 364 161 | odieresis - 232 366 366 162 | oe 372 317 234 234 163 | ogonek 316 376 - 035 164 | ograve - 230 362 362 165 | one 061 061 061 061 166 | onehalf - - 275 275 167 | onequarter - - 274 274 168 | onesuperior - - 271 271 169 | ordfeminine 343 273 252 252 170 | ordmasculine 353 274 272 272 171 | oslash 371 277 370 370 172 | otilde - 233 365 365 173 | p 160 160 160 160 174 | paragraph 266 246 266 266 175 | parenleft 050 050 050 050 176 | parenright 051 051 051 051 177 | percent 045 045 045 045 178 | period 056 056 056 056 179 | periodcentered 264 341 267 267 180 | perthousand 275 344 211 213 181 | plus 053 053 053 053 182 | plusminus - 261 261 261 183 | q 161 161 161 161 184 | question 077 077 077 077 185 | questiondown 277 300 277 277 186 | quotedbl 042 042 042 042 187 | quotedblbase 271 343 204 214 188 | quotedblleft 252 322 223 215 189 | quotedblright 272 323 224 216 190 | quoteleft 140 324 221 217 191 | quoteright 047 325 222 220 192 | quotesinglbase 270 342 202 221 193 | quotesingle 251 047 047 047 194 | r 162 162 162 162 195 | registered - 250 256 256 196 | ring 312 373 - 036 197 | s 163 163 163 163 198 | scaron - - 232 235 199 | section 247 244 247 247 200 | semicolon 073 073 073 073 201 | seven 067 067 067 067 202 | six 066 066 066 066 203 | slash 057 057 057 057 204 | space 040 040 040 040 205 | sterling 243 243 243 243 206 | t 164 164 164 164 207 | thorn - - 376 376 208 | three 063 063 063 063 209 | threequarters - - 276 276 210 | threesuperior - - 263 263 211 | tilde 304 367 230 037 212 | trademark - 252 231 222 213 | two 062 062 062 062 214 | twosuperior - - 262 262 215 | u 165 165 165 165 216 | uacute - 234 372 372 217 | ucircumflex - 236 373 373 218 | udieresis - 237 374 374 219 | ugrave - 235 371 371 220 | underscore 137 137 137 137 221 | v 166 166 166 166 222 | w 167 167 167 167 223 | x 170 170 170 170 224 | y 171 171 171 171 225 | yacute - - 375 375 226 | ydieresis - 330 377 377 227 | yen 245 264 245 245 228 | z 172 172 172 172 229 | zcaron - - 236 236 230 | zero 060 060 060 060 -------------------------------------------------------------------------------- /Encodings/zapfdingbats.txt: -------------------------------------------------------------------------------- 1 | # ----------------------------------------------------------- 2 | # Copyright 2002, 2010, 2015 Adobe Systems Incorporated. 3 | # All rights reserved. 4 | # 5 | # Redistribution and use in source and binary forms, with or 6 | # without modification, are permitted provided that the 7 | # following conditions are met: 8 | # 9 | # Redistributions of source code must retain the above 10 | # copyright notice, this list of conditions and the following 11 | # disclaimer. 12 | # 13 | # Redistributions in binary form must reproduce the above 14 | # copyright notice, this list of conditions and the following 15 | # disclaimer in the documentation and/or other materials 16 | # provided with the distribution. 17 | # 18 | # Neither the name of Adobe Systems Incorporated nor the names 19 | # of its contributors may be used to endorse or promote 20 | # products derived from this software without specific prior 21 | # written permission. 22 | # 23 | # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND 24 | # CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, 25 | # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 26 | # MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 27 | # DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR 28 | # CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 29 | # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 30 | # NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 31 | # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 32 | # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 33 | # CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR 34 | # OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 35 | # SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 36 | # ----------------------------------------------------------- 37 | # Name: ITC Zapf Dingbats Glyph List 38 | # Table version: 2.0 39 | # Date: September 20, 2002 40 | # URL: https://github.com/adobe-type-tools/agl-aglfn 41 | # 42 | # Format: two semicolon-delimited fields: 43 | # (1) glyph name--upper/lowercase letters and digits 44 | # (2) Unicode scalar value--four uppercase hexadecimal digits 45 | # 46 | a100;275E 47 | a101;2761 48 | a102;2762 49 | a103;2763 50 | a104;2764 51 | a105;2710 52 | a106;2765 53 | a107;2766 54 | a108;2767 55 | a109;2660 56 | a10;2721 57 | a110;2665 58 | a111;2666 59 | a112;2663 60 | a117;2709 61 | a118;2708 62 | a119;2707 63 | a11;261B 64 | a120;2460 65 | a121;2461 66 | a122;2462 67 | a123;2463 68 | a124;2464 69 | a125;2465 70 | a126;2466 71 | a127;2467 72 | a128;2468 73 | a129;2469 74 | a12;261E 75 | a130;2776 76 | a131;2777 77 | a132;2778 78 | a133;2779 79 | a134;277A 80 | a135;277B 81 | a136;277C 82 | a137;277D 83 | a138;277E 84 | a139;277F 85 | a13;270C 86 | a140;2780 87 | a141;2781 88 | a142;2782 89 | a143;2783 90 | a144;2784 91 | a145;2785 92 | a146;2786 93 | a147;2787 94 | a148;2788 95 | a149;2789 96 | a14;270D 97 | a150;278A 98 | a151;278B 99 | a152;278C 100 | a153;278D 101 | a154;278E 102 | a155;278F 103 | a156;2790 104 | a157;2791 105 | a158;2792 106 | a159;2793 107 | a15;270E 108 | a160;2794 109 | a161;2192 110 | a162;27A3 111 | a163;2194 112 | a164;2195 113 | a165;2799 114 | a166;279B 115 | a167;279C 116 | a168;279D 117 | a169;279E 118 | a16;270F 119 | a170;279F 120 | a171;27A0 121 | a172;27A1 122 | a173;27A2 123 | a174;27A4 124 | a175;27A5 125 | a176;27A6 126 | a177;27A7 127 | a178;27A8 128 | a179;27A9 129 | a17;2711 130 | a180;27AB 131 | a181;27AD 132 | a182;27AF 133 | a183;27B2 134 | a184;27B3 135 | a185;27B5 136 | a186;27B8 137 | a187;27BA 138 | a188;27BB 139 | a189;27BC 140 | a18;2712 141 | a190;27BD 142 | a191;27BE 143 | a192;279A 144 | a193;27AA 145 | a194;27B6 146 | a195;27B9 147 | a196;2798 148 | a197;27B4 149 | a198;27B7 150 | a199;27AC 151 | a19;2713 152 | a1;2701 153 | a200;27AE 154 | a201;27B1 155 | a202;2703 156 | a203;2750 157 | a204;2752 158 | a205;276E 159 | a206;2770 160 | a20;2714 161 | a21;2715 162 | a22;2716 163 | a23;2717 164 | a24;2718 165 | a25;2719 166 | a26;271A 167 | a27;271B 168 | a28;271C 169 | a29;2722 170 | a2;2702 171 | a30;2723 172 | a31;2724 173 | a32;2725 174 | a33;2726 175 | a34;2727 176 | a35;2605 177 | a36;2729 178 | a37;272A 179 | a38;272B 180 | a39;272C 181 | a3;2704 182 | a40;272D 183 | a41;272E 184 | a42;272F 185 | a43;2730 186 | a44;2731 187 | a45;2732 188 | a46;2733 189 | a47;2734 190 | a48;2735 191 | a49;2736 192 | a4;260E 193 | a50;2737 194 | a51;2738 195 | a52;2739 196 | a53;273A 197 | a54;273B 198 | a55;273C 199 | a56;273D 200 | a57;273E 201 | a58;273F 202 | a59;2740 203 | a5;2706 204 | a60;2741 205 | a61;2742 206 | a62;2743 207 | a63;2744 208 | a64;2745 209 | a65;2746 210 | a66;2747 211 | a67;2748 212 | a68;2749 213 | a69;274A 214 | a6;271D 215 | a70;274B 216 | a71;25CF 217 | a72;274D 218 | a73;25A0 219 | a74;274F 220 | a75;2751 221 | a76;25B2 222 | a77;25BC 223 | a78;25C6 224 | a79;2756 225 | a7;271E 226 | a81;25D7 227 | a82;2758 228 | a83;2759 229 | a84;275A 230 | a85;276F 231 | a86;2771 232 | a87;2772 233 | a88;2773 234 | a89;2768 235 | a8;271F 236 | a90;2769 237 | a91;276C 238 | a92;276D 239 | a93;276A 240 | a94;276B 241 | a95;2774 242 | a96;2775 243 | a97;275B 244 | a98;275C 245 | a99;275D 246 | a9;2720 247 | #END 248 | -------------------------------------------------------------------------------- /Graphics/PDF/Action.hs: -------------------------------------------------------------------------------- 1 | --------------------------------------------------------- 2 | -- | 3 | -- Copyright : (c) 2006-2016, alpheccar.org 4 | -- License : BSD-style 5 | -- 6 | -- Maintainer : misc@NOSPAMalpheccar.org 7 | -- Stability : experimental 8 | -- Portability : portable 9 | -- 10 | -- PDF Actions 11 | --------------------------------------------------------- 12 | 13 | module Graphics.PDF.Action( 14 | -- * Actions 15 | -- ** Types 16 | Action 17 | , GoToURL(..) 18 | -- ** Functions 19 | ) where 20 | 21 | import Graphics.PDF.LowLevel.Types 22 | import qualified Data.Map.Strict as M 23 | import Network.URI 24 | 25 | 26 | -- Media action 27 | --data MediaAction = Play 28 | -- | Stop 29 | -- | Pause 30 | -- | Resume 31 | -- deriving(Enum) 32 | 33 | class PdfObject a => Action a 34 | 35 | -- | Action of going to an URL 36 | newtype GoToURL = GoToURL URI 37 | 38 | --data Rendition = Rendition 39 | --instance PdfObject Rendition where 40 | -- toPDF a = toPDF . PDFDictionary . M.fromList $ 41 | -- [ (PDFName "Type",AnyPdfObject . PDFName $ "Rendition") 42 | -- , (PDFName "S",AnyPdfObject . PDFName $ "MR") 43 | -- , (PDFName "C",AnyPdfObject movie) 44 | -- ] 45 | -- where 46 | -- movie = PDFDictionary . M.fromList $ 47 | -- [ (PDFName "Type",AnyPdfObject . PDFName $ "MediaClip") 48 | -- , (PDFName "S",AnyPdfObject . PDFName $ "MCD") 49 | -- , (PDFName "CT",AnyPdfObject . toPDFString $ "video/3gpp") 50 | -- , (PDFName "D",AnyPdfObject (toPDFString "17.3gp")) 51 | -- ] 52 | 53 | -- Action to control a media 54 | --data ControlMedia = ControlMedia MediaAction Int (PDFReference Rendition) 55 | 56 | urlToPdfString :: URI -> AsciiString 57 | urlToPdfString uri = 58 | let s = uriToString id uri "" 59 | in 60 | toAsciiString s 61 | 62 | 63 | instance PdfObject GoToURL where 64 | toPDF (GoToURL s) = toPDF . PDFDictionary . M.fromList $ 65 | [ (PDFName "Type",AnyPdfObject . PDFName $ "Action") 66 | , (PDFName "S",AnyPdfObject (PDFName "URI")) 67 | , (PDFName "URI",AnyPdfObject (urlToPdfString s)) 68 | ] 69 | instance Action GoToURL 70 | 71 | instance PdfLengthInfo GoToURL where 72 | 73 | 74 | --instance PdfObject ControlMedia where 75 | -- toPDF (ControlMedia operation relatedScreenAnnotation rendition) = toPDF . PDFDictionary . M.fromList $ 76 | -- [ (PDFName "Type",AnyPdfObject . PDFName $ "Action") 77 | -- , (PDFName "S",AnyPdfObject (PDFName "Rendition")) 78 | -- , (PDFName "R",AnyPdfObject rendition) 79 | -- , (PDFName "OP",AnyPdfObject . PDFInteger $ (fromEnum operation)) 80 | -- , (PDFName "AN",AnyPdfObject $ (PDFReference relatedScreenAnnotation :: PDFReference AnyPdfObject)) 81 | -- ] 82 | -- 83 | --instance Action ControlMedia 84 | -------------------------------------------------------------------------------- /Graphics/PDF/Annotation.hs: -------------------------------------------------------------------------------- 1 | --------------------------------------------------------- 2 | -- | 3 | -- Copyright : (c) 2006-2016, alpheccar.org 4 | -- License : BSD-style 5 | -- 6 | -- Maintainer : misc@NOSPAMalpheccar.org 7 | -- Stability : experimental 8 | -- Portability : portable 9 | -- 10 | -- PDF Annotations 11 | --------------------------------------------------------- 12 | 13 | module Graphics.PDF.Annotation( 14 | -- * Annotations 15 | -- ** Types 16 | TextAnnotation(..) 17 | , URLLink(..) 18 | , PDFLink(..) 19 | , TextIcon(..) 20 | -- ** Functions 21 | , newAnnotation 22 | , toAsciiString 23 | ) where 24 | 25 | import Graphics.PDF.LowLevel.Types 26 | import Graphics.PDF.Draw 27 | import qualified Data.Map.Strict as M 28 | import Graphics.PDF.Action 29 | import Graphics.PDF.Pages 30 | import Control.Monad.State(gets) 31 | import qualified Data.Text as T 32 | import Network.URI 33 | 34 | --import Debug.Trace 35 | 36 | data TextIcon = Note 37 | | Paragraph 38 | | NewParagraph 39 | | Key 40 | | Comment 41 | | Help 42 | | Insert 43 | deriving(Eq,Show) 44 | 45 | 46 | data TextAnnotation = TextAnnotation 47 | T.Text -- Content 48 | [PDFFloat] -- Rect 49 | TextIcon 50 | data URLLink = URLLink 51 | T.Text -- Content 52 | [PDFFloat] -- Rect 53 | URI -- URL 54 | Bool -- Border 55 | data PDFLink = PDFLink 56 | T.Text -- Content 57 | [PDFFloat] -- Rect 58 | (PDFReference PDFPage) -- Page 59 | PDFFloat -- x 60 | PDFFloat -- y 61 | Bool -- Border 62 | --data Screen = Screen (PDFReference Rendition) PDFString [PDFFloat] (PDFReference PDFPage) (Maybe (PDFReference ControlMedia)) (Maybe (PDFReference ControlMedia)) 63 | 64 | --det :: Matrix -> PDFFloat 65 | --det (Matrix a b c d _ _) = a*d - b*c 66 | -- 67 | --inverse :: Matrix -> Matrix 68 | --inverse m@(Matrix a b c d e f) = (Matrix (d/de) (-b/de) (-c/de) (a/de) 0 0) * (Matrix 1 0 0 1 (-e) (-f)) 69 | -- where 70 | -- de = det m 71 | 72 | applyMatrixToRectangle :: Matrix -> [PDFFloat] -> [PDFFloat] 73 | applyMatrixToRectangle m [xa,ya,xb,yb] = 74 | let (xa',ya') = m `applyTo` (xa,ya) 75 | (xa'',yb') = m `applyTo` (xa,yb) 76 | (xb',ya'') = m `applyTo` (xb,ya) 77 | (xb'',yb'') = m `applyTo` (xb,yb) 78 | x1 = minimum [xa',xa'',xb',xb''] 79 | x2 = maximum [xa',xa'',xb',xb''] 80 | y1 = minimum [ya',ya'',yb',yb''] 81 | y2 = maximum [ya',ya'',yb',yb''] 82 | in 83 | [x1,y1,x2,y2] 84 | where 85 | applyTo (Matrix a b c d e f) (x,y) = (a*x+c*y+e,b*x+d*y+f) 86 | 87 | applyMatrixToRectangle _ a = a 88 | 89 | 90 | 91 | -- | Get the border shqpe depending on the style 92 | getBorder :: Bool -> [PDFInteger] 93 | getBorder False = [0,0,0] 94 | getBorder True = [0,0,1] 95 | 96 | standardAnnotationDict :: AnnotationObject a => a -> [(PDFName,AnyPdfObject)] 97 | standardAnnotationDict a = [(PDFName "Type",AnyPdfObject . PDFName $ "Annot") 98 | , (PDFName "Subtype",AnyPdfObject $ annotationType a) 99 | , (PDFName "Rect",AnyPdfObject . map AnyPdfObject $ annotationRect a) 100 | , (PDFName "Contents",AnyPdfObject $ annotationContent a) 101 | ] 102 | 103 | --instance PdfObject Screen where 104 | -- toPDF a@(Screen _ _ _ p play stop) = toPDF . PDFDictionary . M.fromList $ 105 | -- standardAnnotationDict a ++ [(PDFName "P",AnyPdfObject p)] 106 | -- ++ (maybe [] (\x -> [(PDFName "A",AnyPdfObject x)]) play) 107 | -- ++ (maybe [] (\x -> [(PDFName "AA",AnyPdfObject $ otherActions x)]) stop) 108 | -- where 109 | -- otherActions x = PDFDictionary . M.fromList $ [(PDFName "D",AnyPdfObject x)] 110 | -- 111 | --instance AnnotationObject Screen where 112 | -- addAnnotation (Screen video s rect p _ _) = do 113 | -- r <- supply 114 | -- playAction <- addObject $ ControlMedia Play r video 115 | -- stopAction <- addObject $ ControlMedia Stop r video 116 | -- updateObject (PDFReference r) $ Screen video s rect p (Just playAction) (Just playAction) 117 | -- return $ PDFReference r 118 | -- annotationType _ = PDFName "Screen" 119 | -- annotationContent (Screen _ s _ _ _ _) = s 120 | -- annotationRect (Screen _ _ r _ _ _) = r 121 | 122 | instance PdfObject TextAnnotation where 123 | toPDF a@(TextAnnotation _ _ i) = toPDF . PDFDictionary . M.fromList $ 124 | standardAnnotationDict a ++ [(PDFName "Name",AnyPdfObject . PDFName $ show i)] 125 | 126 | instance PdfLengthInfo TextAnnotation where 127 | 128 | instance AnnotationObject TextAnnotation where 129 | addAnnotation = addObject 130 | annotationType _ = PDFName "Text" 131 | annotationContent (TextAnnotation s _ _) = AnyPdfObject (toPDFString s) 132 | annotationRect (TextAnnotation _ r _) = r 133 | annotationToGlobalCoordinates (TextAnnotation a r b) = do 134 | gr <- transformAnnotRect r 135 | return $ TextAnnotation a gr b 136 | 137 | instance PdfObject URLLink where 138 | toPDF a@(URLLink _ _ url border) = toPDF . PDFDictionary . M.fromList $ 139 | standardAnnotationDict a ++ 140 | [ (PDFName "A",AnyPdfObject (GoToURL url)) 141 | , (PDFName "Border",AnyPdfObject . map AnyPdfObject $ (getBorder border)) 142 | ] 143 | 144 | instance PdfLengthInfo URLLink where 145 | 146 | instance AnnotationObject URLLink where 147 | addAnnotation = addObject 148 | annotationType _ = PDFName "Link" 149 | annotationContent (URLLink s _ _ _) = AnyPdfObject (toPDFString s) 150 | annotationRect (URLLink _ r _ _) = r 151 | annotationToGlobalCoordinates (URLLink a r b c) = do 152 | gr <- transformAnnotRect r 153 | return $ URLLink a gr b c 154 | 155 | instance PdfObject PDFLink where 156 | toPDF a@(PDFLink _ _ page x y border) = toPDF . PDFDictionary . M.fromList $ 157 | standardAnnotationDict a ++ 158 | [(PDFName "Dest",AnyPdfObject dest) 159 | ,(PDFName "Border",AnyPdfObject . map AnyPdfObject $ (getBorder border))] 160 | where 161 | dest = [ AnyPdfObject page 162 | , AnyPdfObject (PDFName "XYZ") 163 | , AnyPdfObject x 164 | , AnyPdfObject y 165 | , AnyPdfObject (PDFInteger 0)] 166 | 167 | instance PdfLengthInfo PDFLink where 168 | 169 | instance AnnotationObject PDFLink where 170 | addAnnotation = addObject 171 | annotationType _ = PDFName "Link" 172 | annotationContent (PDFLink s _ _ _ _ _) = AnyPdfObject (toPDFString s) 173 | annotationRect (PDFLink _ r _ _ _ _) = r 174 | annotationToGlobalCoordinates (PDFLink a r b c d e) = do 175 | gr <- transformAnnotRect r 176 | return $ PDFLink a gr b c d e 177 | 178 | transformAnnotRect :: [PDFFloat] -> Draw [PDFFloat] 179 | transformAnnotRect r = do 180 | l <- gets matrix 181 | let m = foldr (*) identity l 182 | return $ m `applyMatrixToRectangle` r 183 | 184 | -- | Create a new annotation object 185 | newAnnotation :: (PdfObject a, AnnotationObject a) => a -> Draw () 186 | newAnnotation annot = do 187 | annot' <- annotationToGlobalCoordinates annot 188 | modifyStrict $ \s -> s {annots = (AnyAnnotation annot'):(annots s)} 189 | return () 190 | -------------------------------------------------------------------------------- /Graphics/PDF/Colors.hs: -------------------------------------------------------------------------------- 1 | --------------------------------------------------------- 2 | -- | 3 | -- Copyright : (c) 2006-2016, alpheccar.org 4 | -- License : BSD-style 5 | -- 6 | -- Maintainer : misc@NOSPAMalpheccar.org 7 | -- Stability : experimental 8 | -- Portability : portable 9 | -- 10 | -- Colors for a PDF document 11 | --------------------------------------------------------- 12 | module Graphics.PDF.Colors( 13 | -- * Colors 14 | -- ** Types 15 | Color(..) 16 | -- ** Functions 17 | , setRGBColorSpace 18 | , fillColor 19 | , strokeColor 20 | , setStrokeAlpha 21 | , setFillAlpha 22 | , hsvToRgb 23 | -- ** Some colors 24 | , black 25 | , white 26 | , red 27 | , blue 28 | , green 29 | ) where 30 | 31 | import Graphics.PDF.Draw 32 | import Graphics.PDF.LowLevel.Types 33 | import Control.Monad.State(gets) 34 | import Graphics.PDF.Resources 35 | import Control.Monad.Writer 36 | import Graphics.PDF.LowLevel.Serializer 37 | 38 | black :: Color 39 | black = Rgb 0 0 0 40 | 41 | white :: Color 42 | white = Rgb 1 1 1 43 | 44 | red :: Color 45 | red = Rgb 1 0 0 46 | 47 | green :: Color 48 | green = Rgb 0 1 0 49 | 50 | blue :: Color 51 | blue = Rgb 0 0 1 52 | 53 | 54 | 55 | -- | Set alpha value for transparency 56 | setStrokeAlpha :: Double -> Draw () 57 | setStrokeAlpha alpha = do 58 | alphaMap <- gets strokeAlphas 59 | (newName,newMap) <- setResource "ExtGState" (StrokeAlpha alpha) alphaMap 60 | modifyStrict $ \s -> s { strokeAlphas = newMap } 61 | tell . mconcat $[ serialize "\n/" 62 | , serialize newName 63 | , serialize " gs" 64 | ] 65 | 66 | -- | Set alpha value for transparency 67 | setFillAlpha :: Double -> Draw () 68 | setFillAlpha alpha = do 69 | alphaMap <- gets fillAlphas 70 | (newName,newMap) <- setResource "ExtGState" (FillAlpha alpha) alphaMap 71 | modifyStrict $ \s -> s { fillAlphas = newMap } 72 | tell . mconcat $[ serialize "\n/" 73 | , serialize newName 74 | , serialize " gs" 75 | ] 76 | 77 | -- | Init the PDF color space to RGB. 78 | setRGBColorSpace :: Draw () 79 | setRGBColorSpace = tell . serialize $ "\n/DeviceRGB CS\n/DeviceRGB cs\n" 80 | 81 | 82 | 83 | -- | Select the filling color 84 | fillColor :: MonadPath m => Color -- ^ Filling color 85 | -> m () 86 | fillColor (Rgb r g b) = do 87 | tell . mconcat $[ serialize "\n" 88 | , toPDF r 89 | , serialize ' ' 90 | , toPDF g 91 | , serialize ' ' 92 | , toPDF b 93 | , serialize " rg" 94 | ] 95 | 96 | fillColor (Hsv h s v) = do 97 | let (r,g,b) = hsvToRgb (h,s,v) 98 | tell . mconcat $[ serialize "\n" 99 | , toPDF r 100 | , serialize ' ' 101 | , toPDF g 102 | , serialize ' ' 103 | , toPDF b 104 | , serialize " rg" 105 | ] 106 | 107 | -- | Select the drawing color 108 | strokeColor :: MonadPath m => Color -- ^ Drawing color 109 | -> m () 110 | strokeColor (Rgb r g b) = do 111 | tell . mconcat $[ serialize "\n" 112 | , toPDF r 113 | , serialize ' ' 114 | , toPDF g 115 | , serialize ' ' 116 | , toPDF b 117 | , serialize " RG" 118 | ] 119 | strokeColor (Hsv h s v) = do 120 | let (r,g,b) = hsvToRgb (h,s,v) 121 | tell . mconcat $[ serialize "\n" 122 | , toPDF r 123 | , serialize ' ' 124 | , toPDF g 125 | , serialize ' ' 126 | , toPDF b 127 | , serialize " RG" 128 | ] 129 | 130 | -------------------------------------------------------------------------------- /Graphics/PDF/Coordinates.hs: -------------------------------------------------------------------------------- 1 | --------------------------------------------------------- 2 | -- | 3 | -- Copyright : (c) 2006-2016, alpheccar.org 4 | -- License : BSD-style 5 | -- 6 | -- Maintainer : misc@NOSPAMalpheccar.org 7 | -- Stability : experimental 8 | -- Portability : portable 9 | -- 10 | -- Coordinates for a PDF document 11 | --------------------------------------------------------- 12 | 13 | module Graphics.PDF.Coordinates 14 | ( module Data.Complex 15 | -- * Geometry 16 | -- ** Types 17 | , Angle(..) 18 | , Point 19 | , Matrix(..) 20 | -- ** Transformations 21 | , toRadian 22 | , dot, scalePt 23 | , project, projectX, projectY 24 | , pointMatrix 25 | , transform 26 | , identity, rotate, translate, scale, spiral 27 | ) 28 | where 29 | 30 | import Data.Complex 31 | import Graphics.PDF.LowLevel.Types(PDFFloat) 32 | 33 | -- | Angle 34 | data Angle = Degree !PDFFloat -- ^ Angle in degrees 35 | | Radian !PDFFloat -- ^ Angle in radians 36 | 37 | toRadian :: Angle -> PDFFloat 38 | toRadian (Degree x) = (pi / 180) * x 39 | toRadian (Radian x) = x 40 | 41 | type Point = Complex PDFFloat 42 | 43 | -- | Dot product of two points 44 | -- 'dot (x :+ y) (a :+ b) == x * a + y * b' 45 | -- 'dot z w == magnitude z * magnitude w * cos (phase z - phase w)' 46 | dot :: (RealFloat t) => Complex t -> Complex t -> t 47 | dot (x0 :+ y0) (x1 :+ y1) = x0 * x1 + y0 * y1 48 | 49 | scalePt :: (RealFloat t) => t -> Complex t -> Complex t 50 | scalePt a (x :+ y) = a*x :+ a*y 51 | 52 | -- | projects the first point onto the second 53 | project :: (RealFloat t) => Complex t -> Complex t -> Complex t 54 | project z w = scalePt (dot z w / dot w w) w 55 | 56 | -- | projects a point onto the x-axis 57 | projectX :: (RealFloat t) => Complex t -> Complex t 58 | projectX (x :+ _) = (x :+ 0) 59 | 60 | -- | projects a point onto the y-axis 61 | projectY :: (RealFloat t) => Complex t -> Complex t 62 | projectY (_ :+ y) = (0 :+ y) 63 | 64 | -- | A transformation matrix. An affine transformation a b c d e f 65 | -- 66 | -- @ 67 | -- a b 0 68 | -- c d 0 69 | -- e f 1 70 | -- @ 71 | 72 | data Matrix = Matrix !PDFFloat !PDFFloat !PDFFloat !PDFFloat !PDFFloat !PDFFloat deriving (Eq, Show) 73 | 74 | instance Num Matrix where 75 | -- Matrix addition 76 | (+) (Matrix ma mb mc md me mf ) (Matrix na nb nc nd ne nf) = 77 | Matrix (ma+na) (mb+nb) (mc+nc) (md+nd) (me+ne) (mf+nf) 78 | (*) (Matrix ma mb mc md me mf) (Matrix na nb nc nd ne nf) = 79 | Matrix (ma*na+mb*nc) (ma*nb+mb*nd) (mc*na+md*nc) (mc*nb +md*nd) (me*na+mf*nc+ne) (me*nb+mf*nd+nf) 80 | negate (Matrix ma mb mc md me mf ) = 81 | Matrix (-ma) (-mb) (-mc) (-md) (-me) (-mf) 82 | abs m = m 83 | signum _ = identity 84 | fromInteger i = Matrix r 0 0 r 0 0 85 | where 86 | r = fromInteger i 87 | 88 | -- | Identity matrix 89 | identity :: Matrix 90 | identity = Matrix 1 0 0 1 0 0 91 | 92 | -- | Specifies a matrix as three points 93 | pointMatrix :: Point -- ^ X component 94 | -> Point -- ^ Y component 95 | -> Point -- ^ translation component 96 | -> Matrix 97 | pointMatrix (x0 :+ y0) (x1 :+ y1) (x2 :+ y2) = Matrix x0 y0 x1 y1 x2 y2 98 | 99 | -- | Applies a matrix to a point 100 | transform :: Matrix -> Point -> Point 101 | transform (Matrix x0 y0 x1 y1 x2 y2) (x :+ y) = (x*x0 + y*x1 + x2) :+ (x*y0 + y*y1 + y2) 102 | 103 | 104 | -- | Rotation matrix 105 | rotate :: Angle -- ^ Rotation angle 106 | -> Matrix 107 | rotate r = spiral (cis (toRadian r)) 108 | 109 | -- | Translation matrix 110 | -- 'transform (translate z) w == z + w' 111 | translate :: Point 112 | -> Matrix 113 | translate (tx :+ ty) = Matrix 1 0 0 1 tx ty 114 | 115 | -- | 'Spiral z' rotates by 'phase z' and scales by 'magnitude z' 116 | -- 'transform (spiral z) w == z * w' 117 | spiral :: Point 118 | -> Matrix 119 | spiral (x :+ y) = Matrix x y (-y) x 0 0 120 | 121 | 122 | -- | Scaling matrix 123 | scale :: PDFFloat -- ^ Horizontal scaling 124 | -> PDFFloat -- ^ Horizontal scaling 125 | -> Matrix 126 | scale sx sy = Matrix sx 0 0 sy 0 0 -------------------------------------------------------------------------------- /Graphics/PDF/Data/PDFTree.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE MagicHash #-} 3 | {-# LANGUAGE NoBangPatterns #-} 4 | ----------------------------------------------------------------------------- 5 | -- | 6 | -- Module : PDFTree.hs 7 | -- Copyright : (c) Daan Leijen 2002 8 | -- License : BSD-style 9 | -- Maintainer : misc@NOSPAMalpheccar.org 10 | -- Stability : provisional 11 | -- Portability : portable 12 | -- 13 | -- An efficient implementation of maps from integer keys to values. 14 | -- 15 | -- Customized by alpheccar for the need of the PDF library. The original is IntMap from 16 | -- the ghc standard libraries 17 | ----------------------------------------------------------------------------- 18 | -- #hide 19 | module Graphics.PDF.Data.PDFTree( 20 | PDFTree 21 | , Key 22 | , empty 23 | , lookup 24 | , insert 25 | , fromList 26 | , fold2 27 | , isLeaf 28 | , size 29 | , keyOf 30 | ) where 31 | 32 | import Prelude hiding (lookup,map,filter,foldr,foldl,null) 33 | import Data.Bits 34 | #if __GLASGOW_HASKELL__ >= 503 35 | import GHC.Exts ( Word(..), Int(..), shiftRL# ) 36 | #elif __GLASGOW_HASKELL__ 37 | import Word 38 | import GlaExts ( Word(..), Int(..), shiftRL# ) 39 | #else 40 | import Data.Word 41 | #endif 42 | 43 | import Graphics.PDF.LowLevel.Types 44 | 45 | type Nat = Word 46 | 47 | natFromInt :: Key a -> Nat 48 | natFromInt (PDFReference i) = fromIntegral i 49 | 50 | intFromNat :: Nat -> Key a 51 | intFromNat w = PDFReference (fromIntegral w) 52 | 53 | type Prefix a = PDFReference a 54 | type Mask a = PDFReference a 55 | type Key a = PDFReference a 56 | 57 | -- | A map of integers to values @a@. 58 | -- The total size of subtrees is tracked by each node. It is needed for the PDF Tree 59 | data PDFTree a = Nil 60 | | Tip {-# UNPACK #-} !(Key a) a 61 | | Bin {-# UNPACK #-} !(Prefix a) {-# UNPACK #-} !(Mask a) !(PDFTree a) !(PDFTree a) 62 | deriving(Eq,Show) 63 | 64 | -- | The key function needed to export a Tree of PDF objects into the format defined 65 | -- by the PDF spec 66 | fold2 :: Monad m => Maybe b -- ^ Parent ref 67 | -> (Maybe b -> PDFTree a -> PDFTree a -> m (Int,b)) -- ^ Node action 68 | -> (Maybe b -> Key a -> a -> m (Int,b)) -- ^ Leaf action 69 | -> PDFTree a -- ^ PDFTree 70 | -> m (Int,b) -- ^ Final action and reference of the root node 71 | fold2 _ _ _ Nil = error "Page tree is empty" 72 | fold2 p _ leaf (Tip k a) = leaf p k a 73 | fold2 p node _ (Bin _ _ l r) = node p l r 74 | 75 | 76 | 77 | isLeaf :: PDFTree a -> Bool 78 | isLeaf (Tip _ _) = True 79 | isLeaf _ = False 80 | 81 | keyOf :: PDFTree a -> Key a 82 | keyOf (Tip k _) = k 83 | keyOf _ = error "No key for a node" 84 | 85 | {-------------------------------------------------------------------- 86 | Query 87 | --------------------------------------------------------------------} 88 | 89 | -- | /O(n)/. Number of elements in the map. 90 | size :: PDFTree a -> Int 91 | size t 92 | = case t of 93 | Bin _ _ l r -> (size l) + (size r) 94 | Tip _ _ -> 1 95 | Nil -> 0 96 | 97 | -- | /O(min(n,W))/. Lookup the value at a key in the map. 98 | lookup :: (Monad m) => Key a -> PDFTree a -> m a 99 | lookup k t = case lookup' k t of 100 | Just x -> return x 101 | Nothing -> fail "Data.PDFTree.lookup: Key not found" 102 | 103 | lookup' :: Key a -> PDFTree a -> Maybe a 104 | lookup' k t 105 | = let nk = natFromInt k in seq nk (lookupN nk t) 106 | 107 | lookupN :: Nat -> PDFTree a -> Maybe a 108 | lookupN k t 109 | = case t of 110 | Bin _ m l r 111 | | zeroN k (natFromInt m) -> lookupN k l 112 | | otherwise -> lookupN k r 113 | Tip kx x 114 | | (k == natFromInt kx) -> Just x 115 | | otherwise -> Nothing 116 | Nil -> Nothing 117 | 118 | zeroN :: Nat -> Nat -> Bool 119 | zeroN i m = (i .&. m) == 0 120 | 121 | insert :: Key a -> a -> PDFTree a -> PDFTree a 122 | insert k x t 123 | = case t of 124 | Bin p m l r 125 | | nomatch k p m -> join k (Tip k x) p t 126 | | zero k m -> Bin p m (insert k x l) r 127 | | otherwise -> Bin p m l (insert k x r) 128 | Tip ky _ 129 | | k==ky -> Tip k x 130 | | otherwise -> join k (Tip k x) ky t 131 | Nil -> Tip k x 132 | 133 | join :: Prefix a -> PDFTree a -> Prefix a -> PDFTree a -> PDFTree a 134 | join p1 t1 p2 t2 135 | | zero p1 m = Bin p m t1 t2 136 | | otherwise = Bin p m t2 t1 137 | where 138 | m = branchMask p1 p2 139 | p = mask p1 m 140 | 141 | zero :: Key a -> Mask a -> Bool 142 | zero i m 143 | = (natFromInt i) .&. (natFromInt m) == 0 144 | 145 | nomatch :: Key a -> Prefix a -> Mask a -> Bool 146 | nomatch i p m 147 | = (mask i m) /= p 148 | 149 | mask :: Key a -> Mask a -> Prefix a 150 | mask i m 151 | = maskW (natFromInt i) (natFromInt m) 152 | 153 | {-------------------------------------------------------------------- 154 | Big endian operations 155 | --------------------------------------------------------------------} 156 | maskW :: Nat -> Nat -> Prefix a 157 | maskW i m 158 | = intFromNat (i .&. (complement (m-1) `xor` m)) 159 | 160 | branchMask :: Prefix a -> Prefix a -> Mask a 161 | branchMask p1 p2 162 | = intFromNat (highestBitMask (natFromInt p1 `xor` natFromInt p2)) 163 | 164 | highestBitMask :: Nat -> Nat 165 | highestBitMask x 166 | = case (x .|. shiftRL x 1) of 167 | x1 -> case (x1 .|. shiftRL x1 2) of 168 | x2 -> case (x2 .|. shiftRL x2 4) of 169 | x3 -> case (x3 .|. shiftRL x3 8) of 170 | x4 -> case (x4 .|. shiftRL x4 16) of 171 | x5 -> case (x5 .|. shiftRL x5 32) of -- for 64 bit platforms 172 | x6 -> (x6 `xor` (shiftRL x6 1)) 173 | 174 | shiftRL :: Nat -> Int -> Nat 175 | #if __GLASGOW_HASKELL__ 176 | {-------------------------------------------------------------------- 177 | GHC: use unboxing to get @shiftRL@ inlined. 178 | --------------------------------------------------------------------} 179 | shiftRL (W# x) (I# i) 180 | = W# (shiftRL# x i) 181 | #else 182 | shiftRL x i = shiftR x i 183 | #endif 184 | 185 | empty :: PDFTree a 186 | empty 187 | = Nil 188 | 189 | {-------------------------------------------------------------------- 190 | Utilities 191 | --------------------------------------------------------------------} 192 | foldlStrict :: (a -> t -> a) -> a -> [t] -> a 193 | foldlStrict f z xs 194 | = case xs of 195 | [] -> z 196 | (x:xx) -> let z' = f z x in seq z' (foldlStrict f z' xx) 197 | 198 | -- | /O(n*min(n,W))/. Create a map from a list of key\/value pairs. 199 | fromList :: [(Key a,a)] -> PDFTree a 200 | fromList xs 201 | = foldlStrict ins empty xs 202 | where 203 | ins t (k,x) = insert k x t 204 | 205 | 206 | -------------------------------------------------------------------------------- /Graphics/PDF/Data/Trie.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | --------------------------------------------------------- 3 | -- | 4 | -- Copyright : (c) 2006-2016, alpheccar.org 5 | -- License : BSD-style 6 | -- 7 | -- Maintainer : misc@NOSPAMalpheccar.org 8 | -- Stability : experimental 9 | -- Portability : portable 10 | -- 11 | -- Trie data structure 12 | --------------------------------------------------------- 13 | -- #hide 14 | module Graphics.PDF.Data.Trie( 15 | MapString(..) 16 | , lookup 17 | , insert 18 | , fromList 19 | ) 20 | where 21 | 22 | import Prelude hiding(lookup) 23 | import qualified Data.Map.Strict as M 24 | import qualified Data.Text as T 25 | 26 | data MapString v = EmptyTrie 27 | | Trie (Maybe v) (M.Map Char (MapString v)) 28 | deriving(Eq,Show) 29 | 30 | myLookup :: Ord k => k -> M.Map k a ->[a] 31 | myLookup k d = case M.lookup k d of 32 | Just r -> [r] 33 | _ -> [] 34 | 35 | fromList :: [(T.Text,v)] -> MapString v 36 | fromList = foldr addElem EmptyTrie 37 | where 38 | addElem (key,v) a = insert key v a 39 | 40 | lookup :: T.Text 41 | -> MapString v 42 | -> [v] 43 | lookup _ EmptyTrie = [] 44 | lookup t (Trie (Just tn) tc) | T.null t = [tn] 45 | | otherwise = 46 | let c = T.head t 47 | s = T.tail t 48 | in 49 | tn:(myLookup c tc >>= lookup s) 50 | 51 | lookup t (Trie Nothing tc) | T.null t = [] 52 | | otherwise = 53 | let c = T.head t 54 | s = T.tail t 55 | in 56 | myLookup c tc >>= lookup s 57 | 58 | 59 | insert :: T.Text 60 | -> v 61 | -> MapString v 62 | -> MapString v 63 | insert t v EmptyTrie | T.null t = Trie (Just v) M.empty 64 | | otherwise = 65 | let k = T.head t 66 | l = T.tail t 67 | in 68 | Trie Nothing (M.singleton k (insert l v EmptyTrie)) 69 | 70 | insert t v (Trie tn tc) | T.null t = Trie (Just v) tc 71 | | otherwise = 72 | let k = T.head t 73 | s = T.tail t 74 | in 75 | case M.lookup k tc of 76 | Nothing -> Trie tn (M.insert k (insert s v EmptyTrie) tc) 77 | Just f -> Trie tn (M.insert k (insert s v f) tc) 78 | -------------------------------------------------------------------------------- /Graphics/PDF/Document.hs: -------------------------------------------------------------------------------- 1 | --------------------------------------------------------- 2 | -- | 3 | -- Copyright : (c) 2006-2016, alpheccar.org 4 | -- License : BSD-style 5 | -- 6 | -- Maintainer : misc@NOSPAMalpheccar.org 7 | -- Stability : experimental 8 | -- Portability : portable 9 | -- 10 | -- Management of the PDF structure 11 | --------------------------------------------------------- 12 | {-# LANGUAGE CPP #-} 13 | module Graphics.PDF.Document( 14 | -- * Document actions 15 | -- ** Special document objects 16 | PDFXForm 17 | -- ** Page management 18 | , addPage 19 | , addPageWithTransition 20 | , drawWithPage 21 | , createPDFXForm 22 | -- ** Page transitions 23 | , PDFTransition(..) 24 | , PDFTransStyle(..) 25 | , PDFTransDirection(..) 26 | , PDFTransDimension(..) 27 | , PDFTransDirection2(..) 28 | -- ** Document information 29 | , PDFDocumentInfo(..) 30 | , PDFDocumentPageMode(..) 31 | , PDFDocumentPageLayout(..) 32 | , PDFViewerPreferences(..) 33 | , standardDocInfo 34 | , standardViewerPrefs 35 | -- * Draw monad and drawing functions 36 | -- ** Types 37 | , Draw 38 | , PDFXObject(drawXObject) 39 | , PDFGlobals(..) 40 | -- ** General drawing functions 41 | , withNewContext 42 | , emptyDrawing 43 | ) where 44 | 45 | #if !MIN_VERSION_base(4,8,0) 46 | import Data.Monoid 47 | #endif 48 | 49 | import Graphics.PDF.LowLevel.Types 50 | import Graphics.PDF.Draw 51 | import Graphics.PDF.Pages 52 | import Control.Monad.State 53 | import qualified Data.IntMap as IM 54 | import qualified Data.Map.Strict as M 55 | import qualified Data.Text as T 56 | 57 | -- | No information for the document 58 | standardDocInfo :: PDFDocumentInfo 59 | standardDocInfo = PDFDocumentInfo T.empty T.empty UseNone SinglePage standardViewerPrefs True 60 | 61 | -- | Create a PDF XObject 62 | createPDFXForm :: PDFFloat -- ^ Left 63 | -> PDFFloat -- ^ Bottom 64 | -> PDFFloat -- ^ Right 65 | -> PDFFloat -- ^ Top 66 | -> Draw a -- ^ Drawing commands 67 | -> PDF (PDFReference PDFXForm) 68 | createPDFXForm xa ya xb yb d = let a' = do modifyStrict $ \s -> s {otherRsrcs = PDFDictionary. M.fromList $ 69 | [ (PDFName "Type",AnyPdfObject . PDFName $ "XObject") 70 | , (PDFName "Subtype",AnyPdfObject . PDFName $ "Form") 71 | , (PDFName "FormType",AnyPdfObject . PDFInteger $ 1) 72 | , (PDFName "Matrix",AnyPdfObject . (map (AnyPdfObject . PDFInteger)) $ [1,0,0,1,0,0]) 73 | , (PDFName "BBox",AnyPdfObject . (map AnyPdfObject) $ [xa,ya,xb,yb]) 74 | ] 75 | } 76 | d 77 | in do 78 | PDFReference s <- createContent a' Nothing 79 | recordBound s (xb-xa) (yb-ya) 80 | return (PDFReference s) 81 | 82 | 83 | -- Create a new empty page 84 | createANewPage :: Maybe PDFRect -- ^ Page size or default document's one 85 | -> PDF (Int,PDFPage) -- ^ Reference to the new page 86 | createANewPage rect' = do 87 | rect <- maybe (gets defaultRect) return rect' 88 | -- Get the root page reference 89 | -- Create a new page reference 90 | pageref <- supply 91 | -- Create a new empty content for the page 92 | pageContent <- createContent (return ()) (Just (PDFReference pageref :: PDFReference PDFPage)) 93 | -- Create a new page having as parent the root page 94 | let page = PDFPage Nothing rect pageContent Nothing Nothing Nothing [] 95 | return (pageref , page) 96 | 97 | -- | Add a new page to a PDF document 98 | addPage :: Maybe PDFRect -- ^ Page size or default document's one 99 | -> PDF (PDFReference PDFPage) -- ^ Reference to the new page 100 | addPage rect' = do 101 | (pf,page) <- createANewPage rect' 102 | let pageref = PDFReference pf 103 | modifyStrict $ \s -> s {pages = recordPage pageref page (pages s), currentPage = Just pageref} 104 | return pageref 105 | 106 | addPageWithTransition :: Maybe PDFRect -- ^ Page size or default document's one 107 | -> Maybe PDFFloat -- ^ Optional duration 108 | -> Maybe PDFTransition -- ^ Optional transition 109 | -> PDF (PDFReference PDFPage) -- ^ Reference to the new page 110 | addPageWithTransition rect' dur t = do 111 | (pf,PDFPage a b c d _ _ pageAnnots) <- createANewPage rect' 112 | let pageref = PDFReference pf 113 | modifyStrict $ \s -> s {pages = recordPage pageref (PDFPage a b c d dur t pageAnnots) (pages s), currentPage = Just pageref} 114 | return pageref 115 | 116 | 117 | -- | Draw on a given page 118 | drawWithPage :: PDFReference PDFPage -- ^ Page 119 | -> Draw a -- ^ Drawing commands 120 | -> PDF a 121 | drawWithPage page draw = do 122 | -- Get the page dictionary 123 | lPages <- gets pages 124 | -- Get the stream dictionary 125 | lStreams <- gets streams 126 | -- Look for the page 127 | let thePage = findPage page lPages 128 | case thePage of 129 | Nothing -> error "Can't find the page to draw on it" 130 | -- If the page is found, get its stream reference and look for the stream 131 | Just(PDFPage _ _ (PDFReference streamRef) _ _ _ _) -> do 132 | let theContent = IM.lookup streamRef lStreams 133 | case theContent of 134 | Nothing -> error "Can't find a content for the page to draw on it" 135 | -- If the stream is found 136 | Just (_,(oldState,oldW)) -> do 137 | -- Create a new cntent and update the stream 138 | myBounds <- gets xobjectBound 139 | let (a,state',w') = runDrawing draw (emptyEnvironment {streamId = streamRef, xobjectBoundD = myBounds}) oldState 140 | modifyStrict $ \s -> s {streams = IM.insert streamRef (Just page,(state',mappend oldW w')) lStreams} 141 | return a 142 | -------------------------------------------------------------------------------- /Graphics/PDF/Documentation.hs: -------------------------------------------------------------------------------- 1 | {- | Quick documentation for the PDF library. 2 | 3 | For detailed examples, download the tar.gz package from Hackage and look at the 4 | test.hs in folder Test. 5 | 6 | -} 7 | module Graphics.PDF.Documentation( 8 | -- * Creating a document 9 | -- $creating 10 | 11 | -- * Adding pages 12 | -- $pages 13 | 14 | -- * Creating the page content 15 | -- $content 16 | 17 | -- * Text 18 | -- $text 19 | 20 | -- ** MonadStyle 21 | -- $monadstyle 22 | 23 | -- * Geometry 24 | -- $geometry 25 | 26 | -- * X Form 27 | -- $xform 28 | 29 | -- * Image 30 | -- $image 31 | 32 | -- * Annotations 33 | -- $annotations 34 | 35 | -- * Warning 36 | -- $warning 37 | ) where 38 | 39 | {- $creating 40 | 41 | When you create a document, you must give some information for the PDF file like the author, 42 | the default size (the pages can use different sizes if specified) and if the document is compressed. 43 | 44 | So, a standard way to start a PDF document is with: 45 | 46 | @ 47 | main :: IO() 48 | main = do 49 | let rect = 'PDFRect' 0 0 600 400 50 | 'runPdf' \"demo.pdf\" ('standardDocInfo' { author='toPDFString' \"alpheccar\", compressed = False}) rect $ do 51 | myDocument 52 | @ 53 | 54 | where myDocument is generating the pages and is a value of the PDF monad. 55 | -} 56 | 57 | 58 | {- $pages 59 | 60 | You can add pages and specify a hierarchical structure for the pages. This hierarchy is optional. Here is an example 61 | of how you could add some pages and specify the table of contents: 62 | 63 | @ 64 | myDocument :: 'PDF' () 65 | myDocument = do 66 | page1 <- 'addPage' Nothing 67 | 'newSection' ('toPDFString' \"Section\") Nothing Nothing $ do 68 | 'newSection' ('toPDFString' \"Subsection\") Nothing Nothing $ do 69 | createPageContent page1 70 | @ 71 | 72 | when you use 'addPage' you can specify a different size for the page or use the document's default one. 73 | In 'newSection', the two Maybe options are used to style the entry in the PDF table of contents. 74 | 75 | There are other functions to add pages with transitions. 76 | -} 77 | 78 | {- $content 79 | 80 | To create content for a page, you have to use a page reference with 'drawWithPage'. 81 | 82 | 'drawWithPage' is using a 'Draw' monad value. 83 | 84 | Element of the 'Draw' monad are built with geometry, text and color primitives. 85 | 86 | @ 87 | createPageContent :: 'PDFReference' 'PDFPage' -> Draw () 88 | createPageContent page = 'drawWithPage' page $ do 89 | 'strokeColor' 'red' 90 | 'setWidth' 0.5 91 | 'stroke' $ 'Rectangle' 10 0 200 300 92 | @ 93 | 94 | -} 95 | 96 | {- $text 97 | 98 | Text is complex. You can use the low level 'PDFText' to create a text in the 'Draw' monad. For instance: 99 | 100 | @ 101 | textText :: 'PDFFont' -> 'PDFString' -> 'Draw' () 102 | textText f t = do 103 | 'drawText' $ do 104 | 'setFont' f 105 | 'textStart' 10 200.0 106 | 'leading' $ 'getHeight' f 107 | 'renderMode' 'FillText' 108 | 'displayText' t 109 | 'startNewLine' 110 | 'displayText' $ 'toPDFString' \"Another little test\" 111 | @ 112 | 113 | It gives a detailed control on the position of characters and lines but it is too much work. 114 | 115 | The library is thus supporting a higher level typesetting system with paragraph styles. 116 | 117 | Displaying a formatted text is done with 'displayFormattedText' and using a typesetting monad value: 118 | 119 | @ 120 | 'displayFormattedText' ('Rectangle' (10 :+ 0) (110 :+ 300)) 'NormalPara' 'Normal' $ do 121 | 'paragraph' $ do 122 | 'txt' $ \"Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor \" 123 | 'txt' $ \"incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud \" 124 | 'txt' $ \"exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute \" 125 | 'txt' $ \"irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla \" 126 | 'txt' $ \"pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia \" 127 | 'txt' $ \"deserunt mollit anim id est laborum.\" 128 | @ 129 | 130 | The text will be formatted using the NormalPara paragraph style and the Normal style for sentences. 131 | 132 | NormalPara is part of an algebraic data type defining some vertical styles (from file test.hs): 133 | 134 | @ 135 | data MyVertStyles = NormalPara 136 | | CirclePara 137 | | BluePara !PDFFloat 138 | @ 139 | 140 | and Normal is part of another algebraic data typec (from file test.hs): 141 | 142 | @ 143 | data MyParaStyles = Normal 144 | | Bold 145 | | Crazy 146 | | SuperCrazy [Int] [PDFFloat] 147 | | DebugStyle 148 | | RedRectStyle 149 | | BlueStyle 150 | @ 151 | 152 | The library is coming with standard styles 'StandardParagraphStyle' and 'StandardStyle'. 153 | 154 | Custom styles must be instances of some classes. A 'ComparableStyle' to allow the typesetting algorithm to decide when to group 155 | different characters in a span of the same style. 156 | 157 | A 'Style' class used for sentence style. And a 'ParagraphStyle' to group together the paragraph style and the sentence 158 | style that can be used in this paragraph. 159 | 160 | Why the 'ComparableStyle' is used instead of the class Eq ? A style is containing information 161 | used for the font (size etc ...) but it can also contain additional information used by styling function (a styling 162 | function may draw a decoration). In that latter case, the additional information is changing the look of the sentence 163 | but not its layout : the font size is not changed. So, from a text point of view, the PDF text is drawn using the same 164 | attributes. But the additional decoration on top of it is changing. 165 | 166 | So, 'ComparableStyle' is used to compare the font settings of a style. 167 | 168 | The 'ParagraphStyle' is used to change the geometry of the paragraph (the paragraph can be typeset using 169 | a circle as shape for instance). This style is also used to style the bounding box. 170 | 171 | The other attributes like distance between two lines etc ... are controlled in the typesetting monad. 172 | 173 | @ 174 | 'setParaStyle' (BluePara 0) 175 | 'setFirstPassTolerance' 500 176 | 'unstyledGlue' 6 0.33 0 177 | 'paragraph' $ do 178 | 'txt' $ \"Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. \" 179 | @ 180 | 181 | Inside a paragraph, it is possible to change the line style and create new paragraphs: 182 | 183 | @ 184 | 'paragraph' $ do 185 | 'txt' $ \"Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor\" 186 | 'setStyle' Bold 187 | 'txt' $ \" incididunt ut labore et dolore magna aliqua. \" 188 | 'forceNewLine' 189 | @ 190 | 191 | When charts are created, it is often useful to be able to display captions, labels etc ... The position 192 | of the box containing the text is relative to some specific points in the drawing. To ease with this use-case, an 193 | additional function is provided : 'drawTextBox' 194 | -} 195 | 196 | {- $monadstyle 197 | 198 | The typesetting is similar to the TeX one with kern, glues and boxes. So, it means that any drawing 199 | can be used as a letter since any drawing can be contained in a box. The operators to draw boxes, glues are 200 | part of the 'MonadStyle' monad. The 'Draw' value can be transformed into a box with 'mkDrawBox'. 201 | 202 | The paragraph and the typesetting monad are instances of this class. So, boxes, glues, kerns can be used in horizontal 203 | mode (paragraph) or vertical mode (typesetting monad). 204 | 205 | -} 206 | 207 | {- $geometry 208 | 209 | Building shapes inside the draw monad is easy. For instance: 210 | 211 | @ 212 | 'strokeColor' red 213 | 'stroke' $ 'Rectangle' 0 (200 :+ 100) 214 | 'fillColor' 'blue' 215 | 'fill' $ 'Ellipse' 100 100 300 200 216 | 'fillAndStroke' $ 'RoundRectangle' 32 32 200 200 600 400 217 | @ 218 | 219 | you can also create paths. 220 | 221 | In addition to color, other attributes can be changed: 222 | 223 | @ 224 | 'withNewContext' $ do 225 | 'setWidth' 2 226 | 'setDash' $ 'DashPattern' [3] 0 227 | 'stroke' $ 'Rectangle' 0 (200 :+ 100) 228 | @ 229 | 230 | 'withNewContext' is saving and restoring the settings. 231 | 232 | Shapes can be filled with shading patterns: 233 | 234 | @ 235 | 'paintWithShading' ('RadialShading' 0 0 50 0 0 600 ('Rgb' 1 0 0) ('Rgb' 0 0 1)) ('addShape' $ 'Rectangle' 0 (300 :+ 300)) 236 | 'paintWithShading' ('AxialShading' 300 300 600 400 ('Rgb' 1 0 0) ('Rgb' 0 0 1)) ('addShape' $ 'Ellipse' 300 300 600 400) 237 | @ 238 | 239 | Note that in above example, 'addShape' is used. You can't use 'stroke' or 'fill'. You are just adding a shape to a path. 240 | 241 | More complex patterns can also be used to fill the shapes. In below example we are filling shapes with a complex 242 | drawing defined with a 'Draw' monad value. 243 | 244 | @ 245 | patternTest :: 'PDFReference' 'PDFPage' -> 'PDF' () 246 | patternTest page = do 247 | p <- 'createUncoloredTiling' 0 0 100 50 100 50 'ConstantSpacing' pattern 248 | cp <- 'createColoredTiling' 0 0 100 50 100 50 'ConstantSpacing' cpattern 249 | 'drawWithPage' page $ do 250 | 'strokeColor' 'green' 251 | 'setUncoloredFillPattern' p ('Rgb' 1 0 0) 252 | 'fillAndStroke' $ 'Ellipse' 0 0 300 300 253 | 'setColoredFillPattern' cp 254 | 'fillAndStroke' $ 'Ellipse' 300 300 600 400 255 | 256 | where 257 | pattern = do 258 | 'stroke' ('Ellipse' 0 0 100 50) 259 | 'cpattern' = do 260 | 'strokeColor' ('Rgb' 0 0 1) 261 | 'stroke' ('Ellipse' 0 0 100 50) 262 | @ 263 | -} 264 | 265 | {- $xform 266 | 267 | You can share an object between different pages of a document. It helps reducing the size of the 268 | document is the shared drawing is big. An object can be a 'Draw' monad value. But it can be a JPEG picture too. 269 | 270 | @ 271 | r <- 'createPDFXForm' 0 0 200 200 lineStyle 272 | 'drawWithPage' page6 $ do 273 | 'drawXObject' r 274 | @ 275 | 276 | in the above example, lineStyle is a @Draw()@ value. 277 | 278 | -} 279 | 280 | {- $image 281 | 282 | It is possible to embed JPEG images in the document. 283 | 284 | @ 285 | testImage :: 'JpegFile' -> 'PDFReference' 'PDFPage' -> 'PDF' () 286 | testImage jpgf page = do 287 | jpg <- 'createPDFJpeg' jpgf 288 | 'drawWithPage' page $ do 289 | 'withNewContext' $ do 290 | 'setFillAlpha' 0.4 291 | 'drawXObject' jpg 292 | 'withNewContext' $ do 293 | 'applyMatrix' $ 'rotate' (Degree 20) 294 | 'applyMatrix' $ 'translate' (200 :+ 200) 295 | 'applyMatrix' $ 'scale' 2 2 296 | 'drawXObject' jpg 297 | @ 298 | 299 | The 'JpegFile' value must be created in the 'IO' monad with: 300 | 301 | @ 302 | Right jpg <- 'readJpegFile' \"logo.jpg\" 303 | @ 304 | 305 | Alternatively, jpegs can be compiled into your code. After converting a jpeg to a data URL, a 'JpegFile' can be created with: 306 | 307 | @ 308 | let Right jpg = readJpegDataURL "data:image/jpeg;base64,........." 309 | @ 310 | 311 | The haskell code is just extracting the size of the image from the file. The image is not decoded. 312 | 313 | -} 314 | 315 | {- $annotations 316 | 317 | A pdf page can contain several kind of annotations like links, notes etc ... For instance, to define and 318 | display a link: 319 | 320 | @ 321 | 'newAnnotation' ('URLLink' ('toPDFString' \"Go to my blog\") [0,0,200,100] \"http:\/\/www.alpheccar.org\" True) 322 | @ 323 | 324 | 325 | -} 326 | 327 | {- $warning 328 | 329 | The PDF format is full of extensions. Depending on the viewer that you use some extensions may not be supported. 330 | It is always a good thing to test on a few viewers if you use complex features. 331 | 332 | Mobile viewers (tablets and phones) are generally focusing on a more portable and more restricted set of features. 333 | So, you may not be able to display you document on a mobile device if you use complex features. 334 | 335 | So, I repeat : test. 336 | -} -------------------------------------------------------------------------------- /Graphics/PDF/Fonts/Encoding.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | {-# LANGUAGE DeriveFunctor #-} 3 | {-# LANGUAGE ExistentialQuantification #-} 4 | --------------------------------------------------------- 5 | -- | 6 | -- Copyright : (c) 2006-2016, alpheccar.org 7 | -- License : BSD-style 8 | -- 9 | -- Maintainer : misc@NOSPAMalpheccar.org 10 | -- Stability : experimental 11 | -- Portability : portable 12 | -- 13 | -- AFM Parser 14 | --------------------------------------------------------- 15 | module Graphics.PDF.Fonts.Encoding( 16 | getEncoding 17 | , Encodings(..) 18 | , PostscriptName 19 | , parseMacEncoding 20 | ) where 21 | 22 | import Graphics.PDF.LowLevel.Types 23 | import Data.Char 24 | import qualified Data.Map.Strict as M 25 | import Graphics.PDF.Fonts.Font 26 | import System.FilePath 27 | import Paths_HPDF 28 | import qualified Data.ByteString.Char8 as C 29 | import Data.Char(digitToInt) 30 | import Data.Maybe(mapMaybe) 31 | import qualified Data.Text as T 32 | import qualified Data.Text.IO as T 33 | 34 | type PostscriptName = String 35 | 36 | data Encodings = AdobeStandardEncoding 37 | | ZapfDingbatsEncoding 38 | deriving(Eq) 39 | 40 | isLine :: C.ByteString -> Bool 41 | isLine c | not (C.null c) = C.head c /= '#' 42 | | otherwise = False 43 | 44 | from4Hexa :: C.ByteString -> Int 45 | from4Hexa a = sum . map (\(x,y) -> x * y) $ zip (map digitToInt . C.unpack $ a) (map (\x -> 16^x) [3,2,1,0]) 46 | 47 | from3Octal:: C.ByteString -> Int 48 | from3Octal a = sum . map (\(x,y) -> x * y) $ zip (map digitToInt . C.unpack $ a) (map (\x -> 8^x) [2,1,0]) 49 | 50 | 51 | toData :: [C.ByteString] -> Maybe (PostscriptName,Char) 52 | toData (a:b:_) = Just (C.unpack a,toEnum . from4Hexa $ b) 53 | toData _ = Nothing 54 | 55 | toMacData :: [C.ByteString] -> Maybe (PostscriptName,GlyphCode) 56 | toMacData (name:_:mac:_) | C.unpack mac == "-" = Nothing 57 | | otherwise = Just (C.unpack name,fromIntegral (from3Octal mac)) 58 | toMacData _ = Nothing 59 | 60 | parseGlyphListEncoding :: String -> IO (M.Map PostscriptName Char) 61 | parseGlyphListEncoding name = do 62 | path <- getDataFileName name 63 | l <- C.readFile path 64 | return (M.fromList . mapMaybe (toData . C.split ';') . filter isLine . C.lines $ l) 65 | 66 | parseMacEncoding :: IO (M.Map PostscriptName GlyphCode) 67 | parseMacEncoding = do 68 | path <- getDataFileName "Encodings/pdfencodings.txt" 69 | l <- C.readFile path 70 | return . M.fromList . mapMaybe (toMacData . C.split '\t') . tail . C.lines $ l 71 | 72 | 73 | getEncoding :: Encodings -> IO (M.Map PostscriptName Char) 74 | getEncoding AdobeStandardEncoding = parseGlyphListEncoding $ "Encodings" "glyphlist" <.> "txt" 75 | getEncoding ZapfDingbatsEncoding= parseGlyphListEncoding $ "Encodings" "zapfdingbats" <.> "txt" 76 | -------------------------------------------------------------------------------- /Graphics/PDF/Fonts/Font.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | {-# LANGUAGE DeriveFunctor #-} 3 | {-# LANGUAGE ExistentialQuantification #-} 4 | --------------------------------------------------------- 5 | -- | 6 | -- Copyright : (c) 2006-2016, alpheccar.org 7 | -- License : BSD-style 8 | -- 9 | -- Maintainer : misc@NOSPAMalpheccar.org 10 | -- Stability : experimental 11 | -- Portability : portable 12 | -- 13 | -- PDF Font 14 | --------------------------------------------------------- 15 | {-# LANGUAGE FlexibleContexts #-} 16 | module Graphics.PDF.Fonts.Font( 17 | IsFont(..) 18 | , GlyphSize 19 | , FontSize 20 | , PDFFont(..) 21 | , AnyFont(..) 22 | , FontStructure 23 | , EmbeddedFont 24 | , FontData 25 | , emptyFontStructure 26 | , fontSize 27 | , trueSize 28 | , readFontData 29 | ) where 30 | 31 | import Graphics.PDF.LowLevel.Types 32 | import Graphics.PDF.Resources 33 | import qualified Data.Map.Strict as M 34 | import qualified Data.ByteString as B 35 | import Graphics.PDF.Fonts.FontTypes 36 | 37 | emptyFontStructure :: FontStructure 38 | emptyFontStructure = FS { baseFont = "" 39 | , descent = 0 40 | , ascent = 0 41 | , height = 0 42 | , widthData = M.empty 43 | , kernMetrics = M.empty 44 | , hyphen = Nothing 45 | , space = 0 46 | , encoding = M.empty 47 | , fontBBox = [] 48 | , italicAngle = 0 49 | , capHeight = 0 50 | , fixedPitch = False 51 | , serif = False 52 | , symbolic = False 53 | , script = False 54 | , nonSymbolic = False 55 | , italic = False 56 | , allCap = False 57 | , smallCap = False 58 | , forceBold = False 59 | } 60 | 61 | class IsFont f where 62 | {- 63 | Font descriptions 64 | -} 65 | name :: f -> String 66 | {- 67 | Font metrics 68 | -} 69 | getDescent :: f -> FontSize -> PDFFloat 70 | getHeight :: f -> FontSize -> PDFFloat 71 | {- 72 | Glyph metrics 73 | -} 74 | getKern :: f -> FontSize -> GlyphCode -> GlyphCode -> PDFFloat 75 | glyphWidth :: f -> FontSize -> GlyphCode -> PDFFloat 76 | {- 77 | Font convertions 78 | -} 79 | hyphenGlyph :: f -> Maybe GlyphCode 80 | spaceGlyph :: f -> GlyphCode 81 | charGlyph :: f -> Char -> GlyphCode 82 | 83 | data AnyFont = forall f. (IsFont f,PdfResourceObject f) => AnyFont f 84 | 85 | instance PdfResourceObject AnyFont where 86 | toRsrc (AnyFont f) = toRsrc f 87 | 88 | instance IsFont AnyFont where 89 | name (AnyFont f) = name f 90 | getDescent (AnyFont f) = getDescent f 91 | getHeight (AnyFont f) = getHeight f 92 | {- 93 | Font metrics 94 | -} 95 | getKern (AnyFont f) = getKern f 96 | glyphWidth (AnyFont f) = glyphWidth f 97 | {- 98 | Font convertions 99 | -} 100 | hyphenGlyph (AnyFont f) = hyphenGlyph f 101 | spaceGlyph (AnyFont f) = spaceGlyph f 102 | charGlyph (AnyFont f) = charGlyph f 103 | 104 | instance Eq AnyFont where 105 | a == b = name a == name b 106 | 107 | instance Ord AnyFont where 108 | compare a b = compare (name a) (name b) 109 | 110 | data PDFFont = PDFFont AnyFont FontSize deriving(Eq) 111 | 112 | fontSize :: PDFFont -> FontSize 113 | fontSize (PDFFont _ s) = s 114 | 115 | instance Ord PDFFont where 116 | compare (PDFFont na sa) (PDFFont nb sb) = if sa == sb then compare na nb else compare sa sb 117 | 118 | -- pixel size / 2048 gives factor 119 | 120 | trueSize :: Int -> GlyphSize -> PDFFloat 121 | trueSize fs glyphSize = (fromIntegral glyphSize * fromIntegral fs) / 1000.0 122 | 123 | 124 | 125 | 126 | 127 | readFontData :: FilePath -> IO FontData 128 | readFontData f = do 129 | r <- B.readFile f 130 | return (Type1Data r) 131 | 132 | 133 | 134 | -------------------------------------------------------------------------------- /Graphics/PDF/Fonts/FontTypes.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | --------------------------------------------------------- 3 | -- | 4 | -- Copyright : (c) 2006-2016, alpheccar.org 5 | -- License : BSD-style 6 | -- 7 | -- Maintainer : misc@NOSPAMalpheccar.org 8 | -- Stability : experimental 9 | -- Portability : portable 10 | -- 11 | -- Private types for the fonts 12 | --------------------------------------------------------- 13 | -- #hide 14 | module Graphics.PDF.Fonts.FontTypes( 15 | GlyphSize 16 | , FontSize 17 | , FontStructure(..) 18 | , GlyphPair(..) 19 | , FontData(..) 20 | , StdFont(..) 21 | , Type1Font(..) 22 | , mkFlags 23 | ) where 24 | 25 | import Graphics.PDF.LowLevel.Types 26 | import qualified Data.Map.Strict as M 27 | import qualified Data.ByteString as B 28 | import Data.Word 29 | import Data.Bits hiding(bit) 30 | 31 | --Fonts 32 | type FontSize = Int 33 | 34 | 35 | newtype GlyphSize = GlyphSize Int deriving(Eq,Ord,Num,Integral,Enum,Real) 36 | 37 | data GlyphPair = GlyphPair !GlyphCode !GlyphCode deriving(Eq,Ord) 38 | 39 | data FontStructure = FS { baseFont :: String 40 | , descent :: !GlyphSize 41 | , ascent :: !GlyphSize 42 | , height :: !GlyphSize 43 | , widthData :: M.Map GlyphCode GlyphSize 44 | , kernMetrics :: M.Map GlyphPair GlyphSize 45 | , hyphen :: Maybe GlyphCode 46 | , space :: !GlyphCode 47 | , encoding :: M.Map Char GlyphCode 48 | , fontBBox :: [PDFFloat] 49 | , italicAngle :: !PDFFloat 50 | , capHeight :: !GlyphSize 51 | , fixedPitch :: !Bool 52 | , serif :: !Bool 53 | , symbolic :: !Bool 54 | , script :: !Bool 55 | , nonSymbolic :: !Bool 56 | , italic :: !Bool 57 | , allCap :: !Bool 58 | , smallCap :: !Bool 59 | , forceBold :: !Bool 60 | } 61 | 62 | mkFlags :: FontStructure -> Word32 63 | mkFlags fs = bit (fixedPitch fs) 1 .|. 64 | bit (serif fs) 2 .|. 65 | bit (symbolic fs) 3 .|. 66 | bit (script fs) 4 .|. 67 | bit (nonSymbolic fs) 6 .|. 68 | bit (italic fs) 7 .|. 69 | bit (allCap fs) 17 .|. 70 | bit (smallCap fs) 18 .|. 71 | bit (forceBold fs) 19 72 | where 73 | bit True n = (1 `shiftL` (n-1)) 74 | bit False _ = 0 75 | 76 | data StdFont = StdFont FontStructure 77 | 78 | 79 | data Type1Font = Type1Font FontStructure (PDFReference EmbeddedFont) 80 | 81 | 82 | data FontData = Type1Data B.ByteString 83 | 84 | -------------------------------------------------------------------------------- /Graphics/PDF/Fonts/StandardFont.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | {-# LANGUAGE DeriveFunctor #-} 3 | --------------------------------------------------------- 4 | -- | 5 | -- Copyright : (c) 2006-2016, alpheccar.org 6 | -- License : BSD-style 7 | -- 8 | -- Maintainer : misc@NOSPAMalpheccar.org 9 | -- Stability : experimental 10 | -- Portability : portable 11 | -- 12 | -- PDF Font 13 | --------------------------------------------------------- 14 | {-# LANGUAGE FlexibleContexts #-} 15 | module Graphics.PDF.Fonts.StandardFont( 16 | IsFont 17 | , GlyphSize 18 | , FontName(..) 19 | , StdFont 20 | , mkStdFont 21 | ) where 22 | 23 | 24 | import Graphics.PDF.LowLevel.Types 25 | import Graphics.PDF.Resources 26 | import Data.Char 27 | import qualified Data.Map.Strict as M 28 | import Graphics.PDF.Fonts.Font 29 | import Graphics.PDF.Fonts.AFMParser(getFont,parseFont,AFMFont(..)) 30 | import System.FilePath 31 | import Graphics.PDF.Fonts.Encoding 32 | import Graphics.PDF.Fonts.FontTypes 33 | 34 | 35 | data FontName = Helvetica 36 | | Helvetica_Bold 37 | | Helvetica_Oblique 38 | | Helvetica_BoldOblique 39 | | Times_Roman 40 | | Times_Bold 41 | | Times_Italic 42 | | Times_BoldItalic 43 | | Courier 44 | | Courier_Bold 45 | | Courier_Oblique 46 | | Courier_BoldOblique 47 | | Symbol 48 | | ZapfDingbats 49 | deriving(Eq,Ord,Enum) 50 | 51 | 52 | instance Show FontName where 53 | show Helvetica = "Helvetica" 54 | show Helvetica_Bold = "Helvetica-Bold" 55 | show Helvetica_Oblique = "Helvetica-Oblique" 56 | show Helvetica_BoldOblique = "Helvetica-BoldOblique" 57 | show Times_Roman = "Times-Roman" 58 | show Times_Bold = "Times-Bold" 59 | show Times_Italic = "Times-Italic" 60 | show Times_BoldItalic = "Times-BoldItalic" 61 | show Courier = "Courier" 62 | show Courier_Bold = "Courier-Bold" 63 | show Courier_Oblique = "Courier-Oblique" 64 | show Courier_BoldOblique = "Courier-BoldOblique" 65 | show Symbol = "Symbol" 66 | show ZapfDingbats = "ZapfDingbats" 67 | 68 | 69 | instance PdfResourceObject StdFont where 70 | toRsrc (StdFont f) = AnyPdfObject . PDFDictionary . M.fromList $ 71 | [(PDFName "Type",AnyPdfObject . PDFName $ "Font") 72 | , (PDFName "Subtype",AnyPdfObject . PDFName $ "Type1") 73 | , (PDFName "BaseFont",AnyPdfObject . PDFName $ baseFont f) 74 | ] ++ encoding 75 | where encoding | baseFont f == show Symbol = [] 76 | | baseFont f == show ZapfDingbats = [] 77 | | otherwise = [(PDFName "Encoding",AnyPdfObject . PDFName $ "MacRomanEncoding")] 78 | 79 | instance IsFont StdFont where 80 | getDescent (StdFont fs) s = trueSize s $ descent fs 81 | getHeight (StdFont fs) s = trueSize s $ height fs 82 | getKern (StdFont fs) s a b = trueSize s $ M.findWithDefault 0 (GlyphPair a b) (kernMetrics fs) 83 | glyphWidth (StdFont fs) s a = trueSize s $ M.findWithDefault 0 a (widthData fs) 84 | charGlyph (StdFont fs) c = M.findWithDefault 0 c (encoding fs) 85 | name (StdFont fs) = baseFont fs 86 | hyphenGlyph (StdFont fs) = hyphen fs 87 | spaceGlyph (StdFont fs) = space fs 88 | 89 | mkStdFont :: FontName -> IO (Maybe AnyFont) 90 | mkStdFont f = do 91 | let path = "Core14_AFMs" show f <.> "afm" 92 | theEncoding <- case f of 93 | ZapfDingbats -> getEncoding ZapfDingbatsEncoding 94 | _ -> getEncoding AdobeStandardEncoding 95 | theMacEncoding <- case f of 96 | ZapfDingbats -> return Nothing 97 | Symbol -> return Nothing 98 | _ -> parseMacEncoding >>= return . Just 99 | maybeFs <- getFont (Left path) theEncoding theMacEncoding 100 | case maybeFs of 101 | Just theFont -> do 102 | let f' = theFont { baseFont = show f 103 | } 104 | return . Just . AnyFont . StdFont $ f' 105 | Nothing -> return Nothing 106 | 107 | -------------------------------------------------------------------------------- /Graphics/PDF/Fonts/Type1.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | {-# LANGUAGE DeriveFunctor #-} 3 | --------------------------------------------------------- 4 | -- | 5 | -- Copyright : (c) 2006-2016, alpheccar.org 6 | -- License : BSD-style 7 | -- 8 | -- Maintainer : misc@NOSPAMalpheccar.org 9 | -- Stability : experimental 10 | -- Portability : portable 11 | -- 12 | -- PDF Font 13 | --------------------------------------------------------- 14 | {-# LANGUAGE FlexibleContexts #-} 15 | module Graphics.PDF.Fonts.Type1( 16 | IsFont 17 | , GlyphSize 18 | , Type1Font 19 | , AFMData 20 | , Type1FontStructure(..) 21 | , getAfmData 22 | , mkType1FontStructure 23 | ) where 24 | 25 | import Graphics.PDF.LowLevel.Types 26 | import Graphics.PDF.Resources 27 | import Data.Char 28 | import qualified Data.Map.Strict as M 29 | import Graphics.PDF.Fonts.Font 30 | import Graphics.PDF.Fonts.AFMParser 31 | import System.FilePath 32 | import Graphics.PDF.Fonts.Encoding 33 | import Graphics.PDF.Fonts.FontTypes 34 | import Graphics.PDF.Fonts.AFMParser (AFMFont, parseFont) 35 | import Data.List 36 | import Data.Function(on) 37 | 38 | instance IsFont Type1Font where 39 | getDescent (Type1Font fs _) s = trueSize s $ descent fs 40 | getHeight (Type1Font fs _) s = trueSize s $ height fs 41 | getKern (Type1Font fs _) s a b = trueSize s $ M.findWithDefault 0 (GlyphPair a b) (kernMetrics fs) 42 | glyphWidth (Type1Font fs _) s a = trueSize s $ M.findWithDefault 0 a (widthData fs) 43 | charGlyph (Type1Font fs _) c = M.findWithDefault 0 c (encoding fs) 44 | name (Type1Font fs _) = baseFont fs 45 | hyphenGlyph (Type1Font fs _) = hyphen fs 46 | spaceGlyph (Type1Font fs _) = space fs 47 | 48 | data AFMData = AFMData AFMFont 49 | data Type1FontStructure = Type1FontStructure FontData FontStructure 50 | 51 | getAfmData :: FilePath -> IO AFMData 52 | getAfmData path = do 53 | Just r <- parseFont (Right path) 54 | return (AFMData r) 55 | 56 | mkType1FontStructure :: FontData -> AFMData -> IO (Maybe Type1FontStructure) 57 | mkType1FontStructure pdfRef (AFMData f) = do 58 | theEncoding <- getEncoding AdobeStandardEncoding 59 | maybeFs <- getFont (Right f) theEncoding Nothing 60 | case maybeFs of 61 | Just theFont -> 62 | return . Just $ Type1FontStructure pdfRef theFont 63 | Nothing -> return Nothing 64 | 65 | 66 | 67 | instance PdfResourceObject Type1Font where 68 | toRsrc (Type1Font f ref) = 69 | AnyPdfObject . PDFDictionary . M.fromList $ 70 | [(PDFName "Type",AnyPdfObject . PDFName $ "Font") 71 | , (PDFName "Subtype",AnyPdfObject . PDFName $ "Type1") 72 | , (PDFName "BaseFont",AnyPdfObject . PDFName $ baseFont f) 73 | , (PDFName "FirstChar",AnyPdfObject . PDFInteger $ (fromIntegral firstChar)) 74 | , (PDFName "LastChar",AnyPdfObject . PDFInteger $ (fromIntegral lastChar)) 75 | , (PDFName "Widths",AnyPdfObject $ widths) 76 | , (PDFName "FontDescriptor", AnyPdfObject descriptor) 77 | ] 78 | where 79 | codes = map fst . M.toList $ widthData f 80 | firstChar = head . sort $ codes 81 | lastChar = head . reverse . sort $ codes 82 | findWidth c = PDFInteger . fromIntegral $ M.findWithDefault 0 c (widthData f) 83 | widths = map findWidth [firstChar .. lastChar] 84 | bbox = map AnyPdfObject .fontBBox $ f 85 | descriptor = PDFDictionary . M.fromList $ 86 | [ (PDFName "Type",AnyPdfObject . PDFName $ "Font") 87 | , (PDFName "Subtype",AnyPdfObject . PDFName $ "Type1") 88 | , (PDFName "BaseFont",AnyPdfObject . PDFName $ baseFont f) 89 | , (PDFName "FontFile", AnyPdfObject ref) 90 | , (PDFName "Flags",AnyPdfObject . PDFInteger . fromIntegral . mkFlags $ f) 91 | , (PDFName "FontBBox",AnyPdfObject $ bbox) 92 | , (PDFName "ItalicAngle",AnyPdfObject $ italicAngle f) 93 | , (PDFName "Ascent",AnyPdfObject . PDFInteger . fromIntegral $ ascent f) 94 | , (PDFName "Descent",AnyPdfObject . PDFInteger . fromIntegral $ descent f) 95 | , (PDFName "CapHeight",AnyPdfObject . PDFInteger . fromIntegral $ capHeight f) 96 | ] 97 | -------------------------------------------------------------------------------- /Graphics/PDF/Hyphenate.hs: -------------------------------------------------------------------------------- 1 | --------------------------------------------------------- 2 | -- | 3 | -- Copyright : (c) 2006-2016, alpheccar.org 4 | -- License : BSD-style 5 | -- 6 | -- Maintainer : misc@NOSPAMalpheccar.org 7 | -- Stability : experimental 8 | -- Portability : portable 9 | -- 10 | -- Hyphenate a string 11 | --------------------------------------------------------- 12 | module Graphics.PDF.Hyphenate( 13 | -- * Type 14 | HyphenationDatabase(..) 15 | , MapString 16 | -- * Hyphenation databases 17 | , mkCustomLanguage 18 | , mkExceptions 19 | -- * Hyphenation 20 | , hyphenate 21 | ) where 22 | 23 | import qualified Graphics.PDF.Data.Trie as T 24 | import qualified Graphics.PDF.Hyphenate.English as E 25 | import Graphics.PDF.Data.Trie(MapString) 26 | import Graphics.PDF.Hyphenate.LowLevel 27 | import qualified Data.Text as TE 28 | 29 | exceptions :: HyphenationDatabase -> T.MapString [Int] 30 | exceptions (English _) = E.exceptions 31 | exceptions (CustomLanguage e _) = e 32 | 33 | addedExceptions :: HyphenationDatabase -> T.MapString [Int] 34 | addedExceptions (English (Just e)) = e 35 | addedExceptions _ = T.EmptyTrie 36 | 37 | patterns :: HyphenationDatabase -> T.MapString [Int] 38 | patterns (English _) = E.patterns 39 | patterns (CustomLanguage _ p) = p 40 | 41 | -- | Get the hyphen positions for a word 42 | getWordPoints :: HyphenationDatabase -> TE.Text -> [Int] 43 | getWordPoints db s = 44 | case (T.lookup (TE.toLower s) (exceptions db)) ++ (T.lookup (TE.toLower s) (addedExceptions db)) of 45 | [] -> let s' = TE.append (TE.cons '.' s) (TE.singleton '.') in 46 | getFromPattern db s' 47 | l -> head l 48 | 49 | -- | Get the hyphen positions from the patterns 50 | getFromPattern :: HyphenationDatabase -> TE.Text -> [Int] 51 | getFromPattern db s = 52 | let startPoints = map (const 0) $ (TE.unpack s) 53 | lookP c x | TE.null x = [] 54 | | otherwise = 55 | let r = T.lookup x (patterns db) 56 | in 57 | (map ((++) c) r) ++ lookP (0:c) (TE.tail x) 58 | 59 | foundPoints = reverse . lookP [] $ s 60 | onlyMax a b = zipWith max (a ++ repeat 0) b 61 | in 62 | foldr onlyMax startPoints foundPoints 63 | 64 | -- | Hyphenate a string 65 | hyphenate :: HyphenationDatabase -- ^ Hyphenation database to use to hyphenate the word 66 | -> TE.Text -- ^ Word to hyphenate 67 | -> [TE.Text] 68 | hyphenate db s = 69 | let p = 0:0:(drop 2. drop 1 . lastPointIsNull . getWordPoints db $ s) 70 | lastPointIsNull l = let (_,t) = splitAt 2 (reverse l) in reverse (0:0:t) 71 | cutFromList c [] = [TE.reverse c] 72 | cutFromList c ((ch,pnb):l) = 73 | if pnb `mod` 2 == 1 74 | then if TE.null c 75 | then cutFromList (TE.singleton ch) l 76 | else TE.reverse c : cutFromList (TE.singleton ch) l 77 | else cutFromList (TE.cons ch c) l 78 | in 79 | if TE.length s <= 4 then [s] else cutFromList (TE.empty) (zip (TE.unpack s) p) 80 | 81 | -------------------------------------------------------------------------------- /Graphics/PDF/Hyphenate/LowLevel.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | --------------------------------------------------------- 4 | -- | 5 | -- Copyright : (c) 2006-2016, alpheccar.org 6 | -- License : BSD-style 7 | -- 8 | -- Maintainer : misc@NOSPAMalpheccar.org 9 | -- Stability : experimental 10 | -- Portability : portable 11 | -- 12 | -- Low level functions for hyphenation 13 | --------------------------------------------------------- 14 | -- #hide 15 | module Graphics.PDF.Hyphenate.LowLevel ( 16 | HyphenationDatabase(..) 17 | , mkExceptions 18 | , mkPatterns 19 | , mkCustomLanguage 20 | ) 21 | where 22 | 23 | import qualified Graphics.PDF.Data.Trie as T 24 | import Graphics.PDF.Data.Trie(MapString) 25 | import Data.Char(isDigit) 26 | import Data.List(unfoldr) 27 | import qualified Data.Text as TE 28 | 29 | -- | Hyphenation databases 30 | data HyphenationDatabase = English (Maybe (MapString [Int])) 31 | | CustomLanguage (MapString [Int]) (MapString [Int]) 32 | 33 | 34 | 35 | mkExceptions :: [TE.Text] -> T.MapString [Int] 36 | mkExceptions = T.fromList . map createException 37 | where 38 | createException x = (removeHyphen x,exceptionPoints x) 39 | 40 | mkPatterns :: [TE.Text] -> T.MapString [Int] 41 | mkPatterns = T.fromList . map convertPattern 42 | 43 | -- | Create a custom language for hyphenation 44 | mkCustomLanguage :: [TE.Text] -- ^ Exceptions 45 | -> [TE.Text] -- ^ Patterns 46 | -> HyphenationDatabase 47 | mkCustomLanguage e p = CustomLanguage (mkExceptions e) (mkPatterns p) 48 | 49 | -- | Is it a char used in hyphenation pattern 50 | isChar :: Char -> Bool 51 | isChar = not . isDigit 52 | 53 | -- | Get numerical value for a char 54 | fromDigit :: Char -> Int 55 | fromDigit c = fromEnum c - fromEnum '0' 56 | 57 | -- | Convert a char from an hyphenation pattern to a number 58 | toNumber :: Char -> Int 59 | toNumber x = if isChar x then 0 else fromDigit x 60 | 61 | -- | Remove 0 contained between numbers 62 | simplify :: [Int] -> [Int] 63 | simplify (a:b:c:l) | a /= 0 && b == 0 && c /= 0 = a:simplify (c:l) 64 | | otherwise = a:simplify (b:c:l) 65 | simplify a = a 66 | 67 | -- | Split a patterns into a list of numbers 68 | split :: (Char -> Bool) -> TE.Text -> [Int] 69 | split f = simplify . map toNumber . unfoldr (split' f) 70 | 71 | split' :: (Char -> Bool) -> TE.Text -> Maybe (Char, TE.Text) 72 | split' f l | TE.null l = Nothing 73 | | otherwise = if TE.null h then Just (' ', TE.tail t) else Just (TE.head h, t) 74 | where (h, t) = TE.span f l 75 | 76 | -- | Convert a pattern into a list of number and a normal word 77 | convertPattern :: TE.Text -> (TE.Text,[Int]) 78 | convertPattern s = 79 | let s' = TE.filter isChar s 80 | p = split isDigit s 81 | in 82 | (s',p) 83 | 84 | -- | Remove hyphens from an excepyion word 85 | removeHyphen :: TE.Text -> TE.Text 86 | removeHyphen = TE.filter ((/=) '-') 87 | 88 | -- | Get exception points 89 | exceptionPoints :: TE.Text -> [Int] 90 | exceptionPoints s = 0 : (map onlyHyphen . TE.unpack $ s) 91 | where 92 | onlyHyphen '-' = 1 93 | onlyHyphen _ = 0 -------------------------------------------------------------------------------- /Graphics/PDF/LowLevel/Serializer.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fno-cse #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE FlexibleInstances #-} 5 | --------------------------------------------------------- 6 | -- | 7 | -- Copyright : (c) 2006-2016, alpheccar.org 8 | -- License : BSD-style 9 | -- 10 | -- Maintainer : misc@NOSPAMalpheccar.org 11 | -- Stability : experimental 12 | -- Portability : portable 13 | -- 14 | -- Serializer 15 | --------------------------------------------------------- 16 | -- #hide 17 | module Graphics.PDF.LowLevel.Serializer( 18 | SerializeValue(..) 19 | ) where 20 | 21 | 22 | import Data.Monoid 23 | 24 | import Data.Word 25 | import qualified Data.ByteString.Lazy as B 26 | import qualified Data.Binary.Builder as BU 27 | import qualified Data.ByteString.Lazy.Char8 as C 28 | import Foreign.Ptr(Ptr) 29 | import Data.ByteString.Internal 30 | import qualified Data.ByteString.Lazy.Internal as L(ByteString(..)) 31 | 32 | import System.IO.Unsafe 33 | 34 | foreign import ccall "conversion.h c_floatToString" cfloatToString :: Double -> Ptr Word8 -> IO Int 35 | foreign import ccall "conversion.h c_shortToString" cshortToString :: Int -> Ptr Word8 -> IO Int 36 | 37 | 38 | 39 | class (Monoid s) => SerializeValue s a where 40 | serialize :: a -> s 41 | cons :: a -> s -> s 42 | cons a b = (serialize a) `mappend` b 43 | 44 | instance SerializeValue B.ByteString Word8 where 45 | serialize = B.singleton 46 | cons = B.cons 47 | 48 | instance SerializeValue B.ByteString Char where 49 | serialize = C.singleton 50 | cons = C.cons 51 | 52 | instance SerializeValue B.ByteString [Char] where 53 | serialize = C.pack 54 | 55 | instance SerializeValue B.ByteString B.ByteString where 56 | serialize = id 57 | 58 | convertShort :: Int -> ByteString 59 | convertShort a = unsafePerformIO (createAndTrim 12 (cshortToString a)) 60 | {-# NOINLINE convertShort #-} 61 | 62 | convertFloat :: Double -> ByteString 63 | convertFloat a = unsafePerformIO (createAndTrim 12 (cfloatToString a)) 64 | {-# NOINLINE convertFloat #-} 65 | 66 | instance SerializeValue B.ByteString Int where 67 | serialize a = L.Chunk (convertShort a) L.Empty 68 | 69 | instance SerializeValue B.ByteString Double where 70 | serialize a = L.Chunk (convertFloat a) L.Empty 71 | 72 | 73 | instance SerializeValue BU.Builder Word8 where 74 | serialize = BU.singleton 75 | 76 | instance SerializeValue BU.Builder Char where 77 | serialize = BU.singleton . c2w 78 | 79 | instance SerializeValue BU.Builder [Char] where 80 | serialize = BU.fromLazyByteString . serialize 81 | 82 | instance SerializeValue BU.Builder B.ByteString where 83 | serialize = BU.fromLazyByteString 84 | 85 | instance SerializeValue BU.Builder Int where 86 | serialize = BU.fromLazyByteString . serialize 87 | 88 | instance SerializeValue BU.Builder Double where 89 | serialize = BU.fromLazyByteString . serialize 90 | 91 | 92 | -------------------------------------------------------------------------------- /Graphics/PDF/LowLevel/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ExistentialQuantification #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | {-# LANGUAGE FlexibleInstances #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 7 | {-# LANGUAGE OverloadedStrings #-} 8 | --------------------------------------------------------- 9 | -- | 10 | -- Copyright : (c) 2006-2016, alpheccar.org 11 | -- License : BSD-style 12 | -- 13 | -- Maintainer : misc@NOSPAMalpheccar.org 14 | -- Stability : experimental 15 | -- Portability : portable 16 | -- 17 | -- Low level stuff 18 | --------------------------------------------------------- 19 | -- #hide 20 | module Graphics.PDF.LowLevel.Types where 21 | 22 | import qualified Data.Map.Strict as M 23 | import Data.List(intersperse) 24 | import Data.Int 25 | import Control.Monad.State 26 | import Control.Monad.Writer 27 | import Data.Binary.Builder(Builder,fromByteString) 28 | import Graphics.PDF.LowLevel.Serializer 29 | import Data.Complex 30 | import qualified Data.ByteString as S 31 | import qualified Data.ByteString.Lazy.Internal as L(ByteString(..)) 32 | import Data.Text.Encoding 33 | import qualified Data.Text as T 34 | import qualified Data.ByteString.Char8 as C 35 | import Data.Word 36 | import Data.Char(ord) 37 | import Text.Printf(printf) 38 | 39 | {- 40 | 41 | Low level typesetting types 42 | 43 | -} 44 | data SpecialChar = NormalChar !Char 45 | | BreakingHyphen 46 | | BiggerSpace 47 | | NormalSpace 48 | 49 | {- 50 | 51 | PDF Specific low level types 52 | 53 | -} 54 | 55 | -- | PDF Objects 56 | class PdfObject a where 57 | toPDF :: a -> Builder 58 | 59 | class PdfLengthInfo a where 60 | pdfLengthInfo :: a -> Maybe (Int64 , PDFReference MaybeLength) 61 | pdfLengthInfo _ = Nothing 62 | 63 | -- | Anonymous PDF object 64 | data AnyPdfObject = forall a . (PdfObject a, PdfLengthInfo a) => AnyPdfObject !a 65 | 66 | instance PdfObject AnyPdfObject where 67 | toPDF (AnyPdfObject a) = toPDF a 68 | 69 | instance PdfLengthInfo AnyPdfObject where 70 | pdfLengthInfo (AnyPdfObject a) = pdfLengthInfo a 71 | 72 | -- | An integer in a PDF document 73 | newtype PDFInteger = PDFInteger Int deriving(Eq,Show,Ord,Num) 74 | 75 | -- | A length in a PDF document 76 | newtype PDFLength = PDFLength Int64 deriving(Eq,Show,Ord,Num) 77 | 78 | data MaybeLength = UnknownLength 79 | | KnownLength !PDFLength 80 | 81 | instance PdfObject MaybeLength where 82 | toPDF (KnownLength a) = toPDF a 83 | toPDF (UnknownLength) = error "Trying to process an unknown length during PDF generation" 84 | 85 | instance PdfLengthInfo MaybeLength where 86 | 87 | -- | A real number in a PDF document 88 | type PDFFloat = Double 89 | 90 | instance PdfObject PDFInteger where 91 | toPDF (PDFInteger a) = serialize a 92 | 93 | instance PdfLengthInfo PDFInteger where 94 | 95 | instance PdfObject Int where 96 | toPDF a = serialize a 97 | 98 | instance PdfLengthInfo Int where 99 | 100 | 101 | instance PdfObject PDFLength where 102 | toPDF (PDFLength a) = serialize (show a) 103 | 104 | instance PdfLengthInfo PDFLength where 105 | 106 | 107 | instance PdfObject PDFFloat where 108 | toPDF a = serialize a 109 | 110 | instance PdfLengthInfo PDFFloat where 111 | 112 | 113 | instance PdfObject (Complex PDFFloat) where 114 | toPDF (x :+ y) = mconcat [ serialize x 115 | , serialize ' ' 116 | , serialize y 117 | ] 118 | 119 | instance PdfLengthInfo (Complex PDFFloat) where 120 | 121 | 122 | instance PdfObject Bool where 123 | toPDF (True) = serialize ("true" :: String) 124 | toPDF (False) = serialize ("false" :: String) 125 | 126 | instance PdfLengthInfo Bool where 127 | 128 | 129 | -- | A PDFString containing a strict bytestring (serialied as UTF16BE) 130 | newtype PDFString = PDFString S.ByteString deriving(Eq,Ord,Show) 131 | 132 | -- | A list of glyph to be used in text operators 133 | newtype PDFGlyph = PDFGlyph S.ByteString deriving(Eq,Ord,Show) 134 | 135 | -- | A list of glyph to be used in text operators 136 | newtype EscapedPDFGlyph = EscapedPDFGlyph S.ByteString deriving(Eq,Ord,Show) 137 | 138 | -- | 7 bit encoded ASCII string 139 | newtype AsciiString = AsciiString S.ByteString deriving(Eq,Ord,Show) 140 | 141 | -- | 7 bit encoded ASCII string 142 | newtype EscapedAsciiString = EscapedAsciiString S.ByteString deriving(Eq,Ord,Show) 143 | 144 | escapeText :: Char -> T.Text 145 | escapeText '(' = "\\(" 146 | escapeText ')' = "\\)" 147 | escapeText '\\' = "\\\\" 148 | escapeText a = T.singleton a 149 | 150 | escapeByteString :: Char -> S.ByteString 151 | escapeByteString '(' = C.pack "\\(" 152 | escapeByteString ')' = C.pack "\\)" 153 | escapeByteString '\\' = C.pack "\\\\" 154 | escapeByteString a = C.singleton a 155 | 156 | -- | Create a PDF string from an Haskell one 157 | toPDFString :: T.Text -> PDFString 158 | toPDFString = PDFString . encodeUtf16BE 159 | 160 | toPDFGlyph :: S.ByteString -> PDFGlyph 161 | toPDFGlyph = PDFGlyph 162 | 163 | toAsciiString :: String -> AsciiString 164 | toAsciiString s = AsciiString (C.pack s) 165 | 166 | class HasHexaStream a where 167 | toHexaStream :: a -> S.ByteString 168 | 169 | instance HasHexaStream S.ByteString where 170 | toHexaStream x = 171 | let hexChar c = C.pack (printf "%02X" (ord c) :: String) 172 | in 173 | C.cons 'F' . C.cons 'E' . C.cons 'F' . C.cons 'F' . C.concatMap hexChar $ x 174 | 175 | instance HasHexaStream PDFString where 176 | toHexaStream (PDFString x) = toHexaStream x 177 | 178 | instance HasHexaStream PDFGlyph where 179 | toHexaStream (PDFGlyph x) = 180 | let hexChar c = C.pack (printf "%02X" (ord c) :: String) 181 | in 182 | C.concatMap hexChar $ x 183 | 184 | 185 | newtype GlyphCode = GlyphCode Word8 deriving(Eq,Ord,Show,Integral,Bounded,Enum,Real,Num) 186 | 187 | 188 | instance SerializeValue L.ByteString PDFString where 189 | serialize (PDFString t) = L.Chunk t L.Empty 190 | 191 | instance SerializeValue Builder PDFString where 192 | serialize (PDFString t) = fromByteString t 193 | 194 | instance SerializeValue L.ByteString PDFGlyph where 195 | serialize (PDFGlyph t) = L.Chunk t L.Empty 196 | 197 | 198 | instance SerializeValue Builder EscapedPDFGlyph where 199 | serialize (EscapedPDFGlyph t) = fromByteString t 200 | 201 | instance SerializeValue L.ByteString AsciiString where 202 | serialize (AsciiString t) = L.Chunk t L.Empty 203 | 204 | instance SerializeValue Builder EscapedAsciiString where 205 | serialize (EscapedAsciiString t) = fromByteString t 206 | 207 | -- Misc strings useful to build bytestrings 208 | 209 | lparen :: SerializeValue s Char => s 210 | lparen = serialize '(' 211 | 212 | rparen :: SerializeValue s Char => s 213 | rparen = serialize ')' 214 | 215 | lbracket :: SerializeValue s Char => s 216 | lbracket = serialize '[' 217 | 218 | rbracket :: SerializeValue s Char => s 219 | rbracket = serialize ']' 220 | 221 | bspace :: SerializeValue s Char => s 222 | bspace = serialize ' ' 223 | 224 | blt :: SerializeValue s Char => s 225 | blt = serialize '<' 226 | 227 | bgt :: SerializeValue s Char => s 228 | bgt = serialize '>' 229 | 230 | newline :: SerializeValue s Char => s 231 | newline = serialize '\n' 232 | 233 | noPdfObject :: Monoid s => s 234 | noPdfObject = mempty 235 | 236 | espacePDFGlyph :: PDFGlyph -> EscapedPDFGlyph 237 | espacePDFGlyph (PDFGlyph t) = EscapedPDFGlyph . C.concatMap escapeByteString $ t 238 | 239 | espaceAsciiString :: AsciiString -> EscapedAsciiString 240 | espaceAsciiString (AsciiString t) = EscapedAsciiString . C.concatMap escapeByteString $ t 241 | 242 | instance PdfObject PDFString where 243 | toPDF a = mconcat [ blt 244 | , fromByteString $ toHexaStream a 245 | , bgt 246 | ] 247 | 248 | instance PdfLengthInfo PDFString where 249 | 250 | instance PdfObject PDFGlyph where 251 | toPDF a = mconcat [ blt 252 | --, serialize . espacePDFGlyph $ a 253 | , fromByteString $ toHexaStream a 254 | , bgt 255 | ] 256 | 257 | instance PdfLengthInfo PDFGlyph where 258 | 259 | 260 | instance PdfLengthInfo AsciiString where 261 | 262 | instance PdfObject AsciiString where 263 | toPDF a = mconcat [ lparen 264 | , serialize . espaceAsciiString $ a 265 | , rparen 266 | ] 267 | 268 | -- | A PDFName object 269 | newtype PDFName = PDFName String deriving(Eq,Ord) 270 | 271 | instance PdfObject PDFName where 272 | toPDF (PDFName a) = serialize ("/" ++ a) 273 | 274 | instance PdfLengthInfo PDFName where 275 | 276 | 277 | -- | A PDFArray 278 | type PDFArray = [AnyPdfObject] 279 | 280 | instance PdfObject a => PdfObject [a] where 281 | toPDF l = mconcat $ (lbracket:intersperse bspace (map toPDF l)) ++ [bspace] ++ [rbracket] 282 | 283 | instance PdfObject a => PdfLengthInfo [a] where 284 | 285 | -- | A PDFDictionary 286 | 287 | newtype PDFDictionary = PDFDictionary (M.Map PDFName AnyPdfObject) 288 | 289 | instance PdfObject PDFDictionary where 290 | toPDF (PDFDictionary a) = mconcat $ [blt,blt,newline] 291 | ++ [convertLevel a] 292 | ++ [bgt,bgt] 293 | where 294 | convertLevel _ = let convertItem key value current = mconcat $ [ toPDF key 295 | , bspace 296 | , toPDF value 297 | , newline 298 | , current 299 | ] 300 | 301 | in 302 | M.foldrWithKey convertItem mempty a 303 | 304 | instance PdfLengthInfo PDFDictionary where 305 | 306 | -- | Am empty dictionary 307 | emptyDictionary :: PDFDictionary 308 | emptyDictionary = PDFDictionary M.empty 309 | 310 | isEmptyDictionary :: PDFDictionary -> Bool 311 | isEmptyDictionary (PDFDictionary d) = M.null d 312 | 313 | insertInPdfDict :: PDFName -> AnyPdfObject -> PDFDictionary -> PDFDictionary 314 | insertInPdfDict key obj (PDFDictionary d) = PDFDictionary $ M.insert key obj d 315 | 316 | pdfDictUnion :: PDFDictionary -> PDFDictionary -> PDFDictionary 317 | pdfDictUnion (PDFDictionary a) (PDFDictionary b) = PDFDictionary $ M.union a b 318 | 319 | 320 | -- | A PDF rectangle 321 | data PDFRect = PDFRect !Double !Double !Double !Double 322 | 323 | instance PdfObject PDFRect where 324 | toPDF (PDFRect a b c d) = toPDF . map AnyPdfObject $ [a,b,c,d] 325 | 326 | instance PdfLengthInfo PDFRect where 327 | 328 | 329 | -- | A Referenced objects 330 | data PDFReferencedObject a = PDFReferencedObject !Int !a 331 | 332 | instance PdfObject a => PdfObject (PDFReferencedObject a) where 333 | toPDF (PDFReferencedObject referenceId obj) = 334 | mconcat $ [ serialize . show $ referenceId 335 | , serialize (" 0 obj" :: String) 336 | , newline 337 | , toPDF obj 338 | , newline 339 | , serialize ("endobj" :: String) 340 | , newline , newline 341 | ] 342 | 343 | instance PdfObject a => PdfLengthInfo (PDFReferencedObject a) where 344 | 345 | 346 | -- | A reference to a PDF object 347 | data PDFReference s = PDFReference !Int deriving(Eq,Ord,Show) 348 | 349 | -- | Get the reference value 350 | referenceValue :: PDFReference s -> Int 351 | referenceValue (PDFReference i) = i 352 | 353 | instance PdfObject s => Num (PDFReference s) where 354 | (+) (PDFReference a) (PDFReference b) = PDFReference (a+b) 355 | (*) (PDFReference a) (PDFReference b) = PDFReference (a*b) 356 | negate (PDFReference a) = PDFReference (negate a) 357 | abs (PDFReference a) = PDFReference (abs a) 358 | signum (PDFReference a) = PDFReference (signum a) 359 | fromInteger a = PDFReference (fromInteger a) 360 | 361 | instance PdfObject s => PdfObject (PDFReference s) where 362 | toPDF (PDFReference i) = mconcat $ [ serialize . show $ i 363 | , serialize (" 0 R" :: String)] 364 | 365 | 366 | instance PdfObject s => PdfLengthInfo (PDFReference s) where 367 | 368 | instance (PdfObject a,PdfObject b) => PdfObject (Either a b) where 369 | toPDF (Left a) = toPDF a 370 | toPDF (Right a) = toPDF a 371 | 372 | instance (PdfObject a, PdfObject b) => PdfLengthInfo (Either a b) where 373 | 374 | modifyStrict :: (MonadState s m) => (s -> s) -> m () 375 | modifyStrict f = do 376 | s <- get 377 | put $! (f s) 378 | 379 | -- | A monad where paths can be created 380 | class MonadWriter Builder m => MonadPath m 381 | 382 | {- 383 | 384 | Font types 385 | 386 | -} 387 | 388 | data EmbeddedFont 389 | 390 | 391 | instance PdfObject EmbeddedFont where 392 | toPDF _ = noPdfObject 393 | 394 | instance PdfLengthInfo EmbeddedFont where 395 | -------------------------------------------------------------------------------- /Graphics/PDF/Navigation.hs: -------------------------------------------------------------------------------- 1 | --------------------------------------------------------- 2 | -- | 3 | -- Copyright : (c) 2006-2016, alpheccar.org 4 | -- License : BSD-style 5 | -- 6 | -- Maintainer : misc@NOSPAMalpheccar.org 7 | -- Stability : experimental 8 | -- Portability : portable 9 | -- 10 | -- PDF Navigation 11 | --------------------------------------------------------- 12 | 13 | module Graphics.PDF.Navigation( 14 | -- * Navigation 15 | -- ** Types 16 | OutlineStyle(..) 17 | -- ** Functions 18 | , newSection 19 | , newSectionWithPage 20 | ) where 21 | 22 | import Graphics.PDF.Pages 23 | import Graphics.PDF.Draw 24 | import Graphics.PDF.LowLevel.Types 25 | import Control.Monad.State(gets) 26 | import Control.Monad(when) 27 | import Data.Maybe(isNothing) 28 | import qualified Data.Text as T 29 | 30 | -- | True if we are adding the first outline to this level 31 | isFirst :: [Bool] -> Bool 32 | isFirst r = head r 33 | 34 | -- | Start a new outline level 35 | startNew :: PDF () 36 | startNew = modifyStrict $ \s -> s{firstOutline = True:(firstOutline s)} 37 | 38 | -- | We remember there are outlines at this level 39 | addedOutline :: PDF () 40 | addedOutline = modifyStrict $ \s -> s{firstOutline = False:tail (firstOutline s)} 41 | 42 | -- | Close an outline level 43 | closeNew :: PDF() 44 | closeNew = do 45 | r <- gets firstOutline 46 | when (not (isFirst r)) $ moveToParent 47 | modifyStrict $ \s -> s{firstOutline = tail (firstOutline s)} 48 | 49 | -- | Create a new outline section pointing to the last created page 50 | newSection :: T.Text -- ^ Outline title 51 | -> Maybe Color -- ^ Outline color 52 | -> Maybe OutlineStyle -- ^Outline style 53 | -> PDF () 54 | -> PDF () 55 | newSection myS col style p = newSectionPrivate (toPDFString myS) col style Nothing p 56 | 57 | -- | Create a new outline section pointing to a given page 58 | newSectionWithPage :: T.Text -- ^ Outline title 59 | -> Maybe Color -- ^ Outline color 60 | -> Maybe OutlineStyle -- ^ Outline style 61 | -> PDFReference PDFPage -- ^ Page reference 62 | -> PDF () 63 | -> PDF () 64 | newSectionWithPage myS col style page p = newSectionPrivate (toPDFString myS) col style (Just page) p 65 | 66 | newSectionPrivate :: PDFString -- ^ Outline title 67 | -> Maybe Color -- ^ Outline color 68 | -> Maybe OutlineStyle -- ^Outline style 69 | -> Maybe (PDFReference PDFPage) 70 | -> PDF () 71 | -> PDF () 72 | newSectionPrivate myS col style page p = do 73 | let newlevel = do 74 | startNew 75 | p 76 | closeNew 77 | r <- gets firstOutline 78 | if isFirst r 79 | then do 80 | if length r > 1 81 | then do 82 | newChild myS col style page 83 | addedOutline 84 | newlevel 85 | else do 86 | newSibling myS col style page 87 | newlevel 88 | else do 89 | newSibling myS col style page 90 | newlevel 91 | 92 | newSibling :: PDFString -- ^ Outline title 93 | -> Maybe Color -- ^ Outline color 94 | -> Maybe OutlineStyle -- ^Outline style 95 | -> Maybe (PDFReference PDFPage) 96 | -> PDF () 97 | newSibling myS col style page = do 98 | p <- if isNothing page then gets currentPage else return page 99 | case p of 100 | Nothing -> return () 101 | Just aPage -> do 102 | ot <- gets outline 103 | let myValue = (myS,col,style,Destination aPage) 104 | case ot of 105 | Nothing -> modifyStrict $ \s -> s {outline = Just $ insertDown myValue (OutlineLoc (Node myValue []) Top)} 106 | Just r -> modifyStrict $ \s -> s {outline = Just $ insertRight myValue r} 107 | 108 | newChild :: PDFString -- ^ Outline title 109 | -> Maybe Color -- ^ Outline color 110 | -> Maybe OutlineStyle -- ^Outline style 111 | -> Maybe (PDFReference PDFPage) 112 | -> PDF () 113 | newChild myS col style page = do 114 | p <- if isNothing page then gets currentPage else return page 115 | case p of 116 | Nothing -> return () 117 | Just aPage -> do 118 | ot <- gets outline 119 | let myValue = (myS,col,style,Destination aPage) 120 | case ot of 121 | Nothing -> modifyStrict $ \s -> s {outline = Just $ insertDown myValue (OutlineLoc (Node myValue []) Top)} 122 | Just r -> modifyStrict $ \s -> s {outline = Just $ insertDown myValue r} 123 | 124 | moveToParent :: PDF () 125 | moveToParent = do 126 | ot <- gets outline 127 | case ot of 128 | Nothing -> return () 129 | Just r -> modifyStrict $ \s -> s {outline = Just $ up r} 130 | -------------------------------------------------------------------------------- /Graphics/PDF/Pages.hs: -------------------------------------------------------------------------------- 1 | --------------------------------------------------------- 2 | -- | 3 | -- Copyright : (c) 2006-2016, alpheccar.org 4 | -- License : BSD-style 5 | -- 6 | -- Maintainer : misc@NOSPAMalpheccar.org 7 | -- Stability : experimental 8 | -- Portability : portable 9 | -- 10 | -- Low level page management 11 | --------------------------------------------------------- 12 | -- #hide 13 | module Graphics.PDF.Pages( 14 | -- * Low level stuff 15 | -- ** Document management 16 | standardViewerPrefs 17 | -- ** Page management 18 | , findPage 19 | , recordPage 20 | , noPages 21 | , addPages 22 | , getCurrentPage 23 | -- ** PDF Object management 24 | , addObject 25 | , supply 26 | , updateObject 27 | , addOutlines 28 | , insertDown 29 | , insertRight 30 | , up 31 | , createContent 32 | , recordBound 33 | , setPageResource 34 | , setPageAnnotations 35 | , readType1Font 36 | , mkType1Font 37 | ) where 38 | 39 | import qualified Data.IntMap as IM 40 | import Control.Monad.State 41 | import Graphics.PDF.LowLevel.Types 42 | import Graphics.PDF.Draw 43 | import qualified Graphics.PDF.Data.PDFTree as PT hiding(PDFTree,Key) 44 | import Graphics.PDF.Resources 45 | import Data.List(zip4) 46 | import Graphics.PDF.Fonts.Font 47 | import Graphics.PDF.Data.PDFTree(PDFTree,Key) 48 | import Control.Monad.Writer 49 | import Data.Binary.Builder(Builder,fromLazyByteString,fromByteString) 50 | import Graphics.PDF.Fonts.FontTypes(FontData(..),Type1Font(..)) 51 | import Graphics.PDF.Fonts.Type1 52 | 53 | -- | Set page annotations 54 | setPageAnnotations :: [AnyAnnotation] -> PDFReference PDFPage -> PDF () 55 | setPageAnnotations an page = do 56 | -- Get the page dictionary 57 | lPages <- gets pages 58 | -- Look for the page 59 | let thePage = findPage page lPages 60 | case thePage of 61 | Nothing -> return () 62 | -- If the page is found, get its stream reference and look for the stream 63 | Just (PDFPage a b c d e f _) -> do 64 | refs <- mapM (\x -> addAnnotation x >>= return . AnyPdfObject) an 65 | modifyStrict $ \s -> s {pages = recordPage page (PDFPage a b c d e f refs) lPages} 66 | 67 | -- | Set page resource 68 | setPageResource :: PDFReference PDFResource -> PDFReference PDFPage -> PDF () 69 | setPageResource newr page = do 70 | -- Get the page dictionary 71 | lPages <- gets pages 72 | -- Look for the page 73 | let thePage = findPage page lPages 74 | case thePage of 75 | Nothing -> return () 76 | -- If the page is found, get its stream reference and look for the stream 77 | Just (PDFPage a b c _ e f g) -> modifyStrict $ \s -> s {pages = recordPage page (PDFPage a b c (Just newr) e f g) lPages} 78 | 79 | 80 | -- | Create a new empty content for a page 81 | createContent :: Draw a -- ^ List of drawing commands 82 | -> Maybe (PDFReference PDFPage) 83 | -> PDF (PDFReference PDFStream) -- ^ Reference to the drawing 84 | createContent d page = do 85 | -- Create a new stream referenbce 86 | streamref <- supply 87 | myBounds <- gets xobjectBound 88 | let (_,state',w') = runDrawing d (emptyEnvironment {streamId = streamref, xobjectBoundD = myBounds}) (emptyDrawState streamref) 89 | modifyStrict $ \s -> s {streams = IM.insert streamref (page,(state',w')) (streams s)} 90 | return (PDFReference streamref) 91 | 92 | -- | Returns a new unique identifier 93 | supply :: PDF Int 94 | supply = do 95 | r <- gets supplySrc 96 | modifyStrict $ \s -> s {supplySrc = r+1} 97 | return r 98 | 99 | -- | Add an object to the PDF object dictionary and return a PDF reference 100 | addObject :: (PdfObject a, PdfLengthInfo a) => a -> PDF (PDFReference a) 101 | addObject a = do 102 | r <- supply 103 | modifyStrict $ \s -> s {objects = IM.insert r (AnyPdfObject a) (objects s)} 104 | return (PDFReference r) 105 | 106 | 107 | -- | Update a referenced object with a new one 108 | updateObject :: (PdfObject a, PdfLengthInfo a) => PDFReference a -- ^ Reference to the initial object 109 | -> a -- ^ New value 110 | -> PDF () 111 | updateObject (PDFReference i) obj = do 112 | modifyStrict $ \s -> s {objects = IM.insert i (AnyPdfObject obj) (objects s)} 113 | 114 | 115 | 116 | 117 | 118 | standardViewerPrefs :: PDFViewerPreferences 119 | standardViewerPrefs = PDFViewerPreferences False False False False False False UseNone 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | -- | Record the page in the page catalog 128 | recordPage :: PDFReference PDFPage -- ^ Reference to the page 129 | -> PDFPage -- ^ Page content 130 | -> Pages -- ^ Pages n the documents 131 | -> Pages 132 | recordPage pageref page (Pages lPages) = Pages (PT.insert pageref page lPages) 133 | 134 | -- | Find a page in the catalog 135 | findPage :: PDFReference PDFPage -- ^ Reference to the page 136 | -> Pages -- ^ Pages in the document 137 | -> Maybe PDFPage -- ^ Page content if found 138 | findPage page (Pages lPages) = PT.lookup page lPages 139 | 140 | -- | Add a node PDFTree object 141 | nodePage :: Maybe (PDFReference PDFPages) -- ^ Parent node 142 | -> PDFTree PDFPage -- ^ Left tree 143 | -> PDFTree PDFPage -- ^ Right tree 144 | -> PDF (Int,PDFReference PDFPages) -- ^ PDF reference to the new node pointing to the left and right ones 145 | nodePage ref l r = do 146 | n <- supply 147 | -- Reserve an identifier for the root page object 148 | let pRef = (PDFReference n) :: PDFReference PDFPages 149 | (sl,lr) <- PT.fold2 (Just pRef) nodePage leafPage l 150 | (sr,rr) <- PT.fold2 (Just pRef) nodePage leafPage r 151 | let len = sl + sr 152 | case (PT.isLeaf l,PT.isLeaf r) of 153 | (False,False) -> updateObject pRef $ PDFPages len ref [Left lr,Left rr] 154 | (True,False) -> updateObject pRef $ PDFPages len ref [Right (PT.keyOf l),Left rr] 155 | (False,True) -> updateObject pRef $ PDFPages len ref [Left lr,Right (PT.keyOf r)] 156 | (True,True) -> updateObject pRef $ PDFPages len ref [Right (PT.keyOf l),Right (PT.keyOf r)] 157 | return (len,pRef) 158 | 159 | 160 | -- | Add a page to the PDG object dictionary 161 | leafPage :: Maybe (PDFReference PDFPages) -- ^ Page parent if any 162 | -> Key PDFPage -- ^ Page reference 163 | -> PDFPage -- ^ Page data 164 | -> PDF (Int,PDFReference PDFPages) -- ^ Reference to a PDFPages objects 165 | leafPage (Just ref) (PDFReference objectnb) (PDFPage _ a b c d e f) = do 166 | modifyStrict $ \s -> s {objects = IM.insert objectnb (AnyPdfObject $ PDFPage (Just ref) a b c d e f) (objects s) } 167 | return (1,ref) 168 | 169 | leafPage Nothing p@(PDFReference objectnb) (PDFPage _ a b c d e f) = do 170 | n <- supply 171 | -- Reserve an identifier for the root page object 172 | let pRef = (PDFReference n) :: PDFReference PDFPages 173 | updateObject pRef $ PDFPages 1 Nothing [Right p] 174 | modifyStrict $ \s -> s {objects = IM.insert objectnb (AnyPdfObject $ PDFPage (Just pRef) a b c d e f) (objects s) } 175 | return (1,pRef) 176 | 177 | -- | Add all pages to the PDF object dictionary 178 | addPages :: PDF (PDFReference PDFPages) 179 | addPages = do 180 | Pages lPages <- gets pages 181 | (_,r) <- PT.fold2 Nothing nodePage leafPage lPages 182 | return r 183 | 184 | -- | Empty page catalog 185 | noPages :: Pages 186 | noPages = Pages (PT.empty) 187 | 188 | 189 | -- insert a subtree to the right of the current node 190 | insertRight :: a -> OutlineLoc a -> OutlineLoc a 191 | insertRight _ (OutlineLoc _ Top) = error "Cannot insert right of the top node" 192 | insertRight t' (OutlineLoc t c ) = let c' = Child { value = value c 193 | , parent = parent c 194 | , rights = rights c 195 | , lefts = lefts c ++ [t] } 196 | in OutlineLoc (Node t' []) c' 197 | 198 | insertDown :: a -> OutlineLoc a -> OutlineLoc a 199 | insertDown t' (OutlineLoc (Node v cs) c) = let c' = Child { value = v 200 | , parent = c 201 | , rights = [] 202 | , lefts = cs 203 | } 204 | in OutlineLoc (Node t' []) c' 205 | 206 | -- move up 207 | up :: OutlineLoc a -> OutlineLoc a 208 | up (OutlineLoc _ Top ) = error "Cannot go up from the top node" 209 | up (OutlineLoc t (Child v c ls rs)) = let t' = Node v (ls ++ [t] ++ rs) 210 | in OutlineLoc t' c 211 | 212 | 213 | addOutlines :: Maybe Outline -> PDF (Maybe (PDFReference PDFOutline)) 214 | addOutlines Nothing = return Nothing 215 | addOutlines (Just r) = do 216 | let (Node _ l) = toTree r 217 | if null l 218 | then return Nothing 219 | else do 220 | rootRef <- supply 221 | (first,end) <- createOutline (PDFReference rootRef) l 222 | let outlineCatalog = PDFOutline first end 223 | updateObject (PDFReference rootRef) outlineCatalog 224 | return (Just (PDFReference rootRef)) 225 | 226 | 227 | createOutline :: PDFReference PDFOutlineEntry -> [Tree OutlineData] -> PDF (PDFReference PDFOutlineEntry,PDFReference PDFOutlineEntry) 228 | createOutline r children = do 229 | -- Get references for all these outlines 230 | refs' <- mapM (const (supply >>= return . Just . PDFReference)) children 231 | -- (previousRef, currentRef, currentNode, nextRef) 232 | let refs = zip4 (Nothing : init refs') refs' children (tail refs' ++ [Nothing]) 233 | current (_,c,_,_) = c 234 | Just first = current (head refs) 235 | Just end = current (last refs) 236 | mapM_ (addEntry first end) refs 237 | return (first,end) 238 | where 239 | addEntry _ _ (_,Nothing,_,_) = error "This pattern match in addEntry should never occur !" 240 | addEntry _ _ (prev,Just current,Node (title,col,style,dest) c,next) = do 241 | (f,e) <- if (null c) 242 | then 243 | return (Nothing,Nothing) 244 | else 245 | createOutline current c >>= \(x,y) -> return (Just x,Just y) 246 | let o = PDFOutlineEntry title 247 | r -- Parent 248 | prev -- Prev 249 | next 250 | f 251 | e 252 | (-(length c)) 253 | dest 254 | (maybe (Rgb 0 0 0) id col) 255 | (maybe NormalOutline id style) 256 | updateObject current o 257 | 258 | 259 | toTree :: OutlineLoc a -> Tree a 260 | toTree (OutlineLoc a Top) = a 261 | toTree a = toTree (up a) 262 | 263 | 264 | -- | Reference to the last created page 265 | getCurrentPage :: PDF (Maybe (PDFReference PDFPage)) 266 | getCurrentPage = gets currentPage 267 | 268 | -- | Record bound of an xobject 269 | recordBound :: Int -- ^ Reference 270 | -> PDFFloat -- ^ Width 271 | -> PDFFloat -- ^ Height 272 | -> PDF () 273 | recordBound ref width height = modifyStrict $ \s -> s {xobjectBound = IM.insert ref (width,height) (xobjectBound s)} 274 | 275 | 276 | -- | Create an embedded font 277 | createEmbeddedFont :: FontData -> PDF (PDFReference EmbeddedFont) 278 | createEmbeddedFont (Type1Data d) = do 279 | PDFReference s <- createContent (tell $ fromByteString d) Nothing 280 | return (PDFReference s) 281 | 282 | -- | Create a type 1 font 283 | readType1Font :: FilePath 284 | -> FilePath 285 | -> IO Type1FontStructure 286 | readType1Font pfb afmPath = do 287 | fd <- readFontData pfb 288 | afm <- getAfmData afmPath 289 | Just fs <- mkType1FontStructure fd afm 290 | return fs 291 | 292 | mkType1Font :: Type1FontStructure -> PDF AnyFont 293 | mkType1Font (Type1FontStructure fd fs) = do 294 | ref <- createEmbeddedFont fd 295 | return (AnyFont $ Type1Font fs ref) 296 | 297 | 298 | -------------------------------------------------------------------------------- /Graphics/PDF/Pattern.hs: -------------------------------------------------------------------------------- 1 | --------------------------------------------------------- 2 | -- | 3 | -- Copyright : (c) 2006-2016, alpheccar.org 4 | -- License : BSD-style 5 | -- 6 | -- Maintainer : misc@NOSPAMalpheccar.org 7 | -- Stability : experimental 8 | -- Portability : portable 9 | -- 10 | -- PDF Patterns 11 | --------------------------------------------------------- 12 | 13 | module Graphics.PDF.Pattern( 14 | -- * Pattern 15 | TilingType(..) 16 | , PDFColoredPattern 17 | , PDFUncoloredPattern 18 | , createColoredTiling 19 | , createUncoloredTiling 20 | , setColoredFillPattern 21 | , setColoredStrokePattern 22 | , setUncoloredFillPattern 23 | , setUncoloredStrokePattern 24 | ) where 25 | 26 | import Graphics.PDF.LowLevel.Types 27 | import Graphics.PDF.Draw 28 | import Graphics.PDF.Resources 29 | import qualified Data.Map.Strict as M 30 | import Graphics.PDF.Pages(recordBound,createContent) 31 | import Control.Monad.State 32 | import Control.Monad.Writer 33 | import Graphics.PDF.LowLevel.Serializer 34 | 35 | data PaintType = ColoredTiling 36 | | UncoloredTiling 37 | deriving(Eq,Enum) 38 | 39 | -- | Tiling type 40 | data TilingType = ConstantSpacing 41 | | NoDistortion 42 | | ConstantSpacingAndFaster 43 | deriving(Eq,Enum) 44 | 45 | -- | Create a colored tiling pattern 46 | createColoredTiling :: PDFFloat -- ^ Left 47 | -> PDFFloat -- ^ Bottom 48 | -> PDFFloat -- ^ Right 49 | -> PDFFloat -- ^ Top 50 | -> PDFFloat -- ^ Horizontal step 51 | -> PDFFloat -- ^ Vertical step 52 | -> TilingType 53 | -> Draw a -- ^ Drawing commands 54 | -> PDF (PDFReference PDFColoredPattern) 55 | createColoredTiling xa ya xb yb hstep vstep tt d = createTilingPattern xa ya xb yb hstep vstep ColoredTiling tt d >>= return . PDFReference 56 | 57 | -- | Create an uncolored tiling pattern 58 | createUncoloredTiling :: PDFFloat -- ^ Left 59 | -> PDFFloat -- ^ Bottom 60 | -> PDFFloat -- ^ Right 61 | -> PDFFloat -- ^ Top 62 | -> PDFFloat -- ^ Horizontal step 63 | -> PDFFloat -- ^ Vertical step 64 | -> TilingType 65 | -> Draw a -- ^ Drawing commands 66 | -> PDF (PDFReference PDFUncoloredPattern) 67 | createUncoloredTiling xa ya xb yb hstep vstep tt d = createTilingPattern xa ya xb yb hstep vstep UncoloredTiling tt d >>= return . PDFReference 68 | 69 | -- | Create a PDF tiling pattern 70 | createTilingPattern :: PDFFloat -- ^ Left 71 | -> PDFFloat -- ^ Bottom 72 | -> PDFFloat -- ^ Right 73 | -> PDFFloat -- ^ Top 74 | -> PDFFloat -- ^ Horizontal step 75 | -> PDFFloat -- ^ Vertical step 76 | -> PaintType 77 | -> TilingType 78 | -> Draw a -- ^ Drawing commands 79 | -> PDF Int 80 | createTilingPattern xa ya xb yb hstep vstep pt tt d = 81 | let a' = do modifyStrict $ \s -> s {otherRsrcs = PDFDictionary. M.fromList $ 82 | [ (PDFName "Type",AnyPdfObject . PDFName $ "Pattern") 83 | , (PDFName "PatternType",AnyPdfObject . PDFInteger $ 1) 84 | , (PDFName "PaintType",AnyPdfObject . PDFInteger $ (fromEnum pt) + 1) 85 | , (PDFName "TilingType",AnyPdfObject . PDFInteger $ (fromEnum tt) + 1) 86 | , (PDFName "Matrix",AnyPdfObject . (map (AnyPdfObject . PDFInteger)) $ [1,0,0,1,0,0]) 87 | , (PDFName "BBox",AnyPdfObject . map AnyPdfObject $ [xa,ya,xb,yb]) 88 | , (PDFName "XStep",AnyPdfObject hstep) 89 | , (PDFName "YStep",AnyPdfObject vstep) 90 | ] 91 | } 92 | d 93 | in do 94 | PDFReference s <- createContent a' Nothing 95 | recordBound s (xb-xa) (yb-ya) 96 | return s 97 | 98 | 99 | -- | Set the fill pattern 100 | setColoredFillPattern :: PDFReference PDFColoredPattern -> Draw () 101 | setColoredFillPattern (PDFReference a) = do 102 | patternMap <- gets patterns 103 | (newName,newMap) <- setResource "Pattern" (PDFReference a) patternMap 104 | modifyStrict $ \s -> s { patterns = newMap } 105 | tell . serialize $ ("\n/Pattern cs") 106 | tell . mconcat $[ serialize "\n/" 107 | , serialize newName 108 | , serialize " scn" 109 | ] 110 | 111 | -- | Set the stroke pattern 112 | setColoredStrokePattern :: PDFReference PDFColoredPattern -> Draw () 113 | setColoredStrokePattern (PDFReference a) = do 114 | patternMap <- gets patterns 115 | (newName,newMap) <- setResource "Pattern" (PDFReference a) patternMap 116 | modifyStrict $ \s -> s { patterns = newMap } 117 | tell . serialize $ ("\n/Pattern CS") 118 | tell . mconcat $[ serialize "\n/" 119 | , serialize newName 120 | , serialize " SCN" 121 | ] 122 | 123 | 124 | 125 | -- | Set the fill pattern 126 | setUncoloredFillPattern :: PDFReference PDFUncoloredPattern -> Color -> Draw () 127 | setUncoloredFillPattern (PDFReference a) col = do 128 | let (r,g,b) = getRgbColor col 129 | colorMap <- gets colorSpaces 130 | (newColorName,_) <- setResource "ColorSpace" PatternRGB colorMap 131 | patternMap <- gets patterns 132 | (newName,newMap) <- setResource "Pattern" (PDFReference a) patternMap 133 | modifyStrict $ \s -> s { patterns = newMap } 134 | tell . mconcat $[ serialize "\n/" 135 | , serialize newColorName 136 | , serialize " cs" 137 | ] 138 | tell . mconcat $[ serialize '\n' 139 | , toPDF r 140 | , serialize ' ' 141 | , toPDF g 142 | , serialize ' ' 143 | , toPDF b 144 | , serialize ' ' 145 | , serialize " /" 146 | , serialize newName 147 | , serialize " scn" 148 | ] 149 | 150 | -- | Set the stroke pattern 151 | setUncoloredStrokePattern :: PDFReference PDFUncoloredPattern -> Color -> Draw () 152 | setUncoloredStrokePattern (PDFReference a) col = do 153 | let (r,g,b) = getRgbColor col 154 | colorMap <- gets colorSpaces 155 | (newColorName,_) <- setResource "ColorSpace" PatternRGB colorMap 156 | patternMap <- gets patterns 157 | (newName,newMap) <- setResource "Pattern" (PDFReference a) patternMap 158 | modifyStrict $ \s -> s { patterns = newMap } 159 | tell . mconcat $[ serialize "\n/" 160 | , serialize newColorName 161 | , serialize " CS" 162 | ] 163 | tell . mconcat $ [ serialize '\n' 164 | , toPDF r 165 | , serialize ' ' 166 | , toPDF g 167 | , serialize ' ' 168 | , toPDF b 169 | , serialize ' ' 170 | , serialize " /" 171 | , serialize newName 172 | , serialize " SCN" 173 | ] -------------------------------------------------------------------------------- /Graphics/PDF/Resources.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDecls #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | --------------------------------------------------------- 4 | -- | 5 | -- Copyright : (c) 2006-2016, alpheccar.org 6 | -- License : BSD-style 7 | -- 8 | -- Maintainer : misc@NOSPAMalpheccar.org 9 | -- Stability : experimental 10 | -- Portability : portable 11 | -- 12 | -- PDF Resources 13 | --------------------------------------------------------- 14 | -- #hide 15 | module Graphics.PDF.Resources( 16 | PDFResource(..) 17 | , addResource 18 | , emptyRsrc 19 | , StrokeAlpha(..) 20 | , FillAlpha(..) 21 | , PdfResourceObject(..) 22 | , resourceToDict 23 | , emptyResource 24 | , PDFColoredPattern 25 | , PDFUncoloredPattern 26 | , AnyPdfPattern 27 | , PDFColorSpace(..) 28 | ) where 29 | 30 | import Graphics.PDF.LowLevel.Types 31 | import qualified Data.Map.Strict as M 32 | 33 | 34 | 35 | 36 | newtype StrokeAlpha = StrokeAlpha Double deriving(Eq,Ord) 37 | instance PdfResourceObject StrokeAlpha where 38 | toRsrc (StrokeAlpha a) = AnyPdfObject . PDFDictionary . M.fromList $ [(PDFName "CA",AnyPdfObject a)] 39 | 40 | newtype FillAlpha = FillAlpha Double deriving(Eq,Ord) 41 | instance PdfResourceObject FillAlpha where 42 | toRsrc (FillAlpha a) = AnyPdfObject . PDFDictionary . M.fromList $ [(PDFName "ca",AnyPdfObject a)] 43 | 44 | class PdfResourceObject a where 45 | toRsrc :: a -> AnyPdfObject 46 | 47 | 48 | -- | A PDF Resource 49 | data PDFResource = PDFResource { 50 | procSet :: !PDFArray 51 | , resources :: M.Map PDFName PDFDictionary 52 | } 53 | 54 | 55 | emptyRsrc :: PDFResource 56 | --emptyRsrc = PDFResource [AnyPdfObject . PDFName $ "PDF"] (M.empty) 57 | emptyRsrc = PDFResource [] (M.empty) 58 | 59 | getResources :: M.Map PDFName PDFDictionary -> [(PDFName,AnyPdfObject)] 60 | getResources = M.toList . M.map AnyPdfObject 61 | 62 | instance PdfObject PDFResource where 63 | toPDF r = toPDF . resourceToDict $ r 64 | 65 | instance PdfLengthInfo PDFResource where 66 | 67 | -- | Add a new G State to the G State dictionary for the given resource 68 | addResource :: PDFName -- ^ GState dictionary 69 | -> PDFName -- ^ GState name must be unique 70 | -> AnyPdfObject -- ^ G State content 71 | -> PDFResource -- ^ Old resource 72 | -> PDFResource -- ^ New resource 73 | addResource dict name newValue r = let addValue (Just (PDFDictionary a)) = Just . PDFDictionary $ M.insert name newValue a 74 | addValue (Nothing) = Just . PDFDictionary $ M.insert name newValue M.empty 75 | in 76 | r {resources = M.alter addValue dict (resources r)} 77 | 78 | -- | Convert the resource to a PDf dictionary 79 | resourceToDict :: PDFResource -> PDFDictionary 80 | resourceToDict r = PDFDictionary . M.fromList $ 81 | --[(PDFName "ProcSet",AnyPdfObject (procSet r))] ++ 82 | getResources (resources r) 83 | 84 | emptyResource :: PDFResource -> Bool 85 | emptyResource (PDFResource a b) = null a && M.null b 86 | 87 | 88 | -- | A PDF Pattern 89 | data PDFUncoloredPattern 90 | data PDFColoredPattern 91 | data AnyPdfPattern 92 | 93 | 94 | -- | A PDF Color space 95 | data PDFColorSpace = PatternRGB deriving(Eq,Ord) 96 | 97 | instance PdfResourceObject PDFColorSpace where 98 | toRsrc PatternRGB = AnyPdfObject . map AnyPdfObject $ [PDFName "Pattern",PDFName "DeviceRGB"] 99 | 100 | instance PdfObject PDFColoredPattern where 101 | toPDF _ = noPdfObject 102 | instance PdfLengthInfo PDFColoredPattern where 103 | 104 | instance PdfResourceObject (PDFReference PDFColoredPattern) where 105 | toRsrc = AnyPdfObject 106 | 107 | instance PdfObject PDFUncoloredPattern where 108 | toPDF _ = noPdfObject 109 | instance PdfLengthInfo PDFUncoloredPattern where 110 | 111 | instance PdfResourceObject (PDFReference PDFUncoloredPattern) where 112 | toRsrc = AnyPdfObject 113 | 114 | instance PdfObject AnyPdfPattern where 115 | toPDF _ = noPdfObject 116 | instance PdfLengthInfo AnyPdfPattern where 117 | 118 | instance PdfResourceObject (PDFReference AnyPdfPattern) where 119 | toRsrc = AnyPdfObject 120 | 121 | 122 | -------------------------------------------------------------------------------- /Graphics/PDF/Shading.hs: -------------------------------------------------------------------------------- 1 | --------------------------------------------------------- 2 | -- | 3 | -- Copyright : (c) 2006-2016, alpheccar.org 4 | -- License : BSD-style 5 | -- 6 | -- Maintainer : misc@NOSPAMalpheccar.org 7 | -- Stability : experimental 8 | -- Portability : portable 9 | -- 10 | -- PDF shading 11 | --------------------------------------------------------- 12 | module Graphics.PDF.Shading( 13 | -- * Shading 14 | -- ** Type 15 | PDFShading(..) 16 | , paintWithShading 17 | , applyShading 18 | ) where 19 | 20 | import Graphics.PDF.Draw 21 | import Graphics.PDF.LowLevel.Types 22 | import Control.Monad.State(gets) 23 | import Graphics.PDF.Shapes(setAsClipPath) 24 | import Control.Monad.Writer 25 | import Graphics.PDF.LowLevel.Serializer 26 | 27 | -- | Fill clipping region with a shading 28 | applyShading :: PDFShading -> Draw () 29 | applyShading shade = do 30 | shadingMap <- gets shadings 31 | (newName,newMap) <- setResource "Shading" shade shadingMap 32 | modifyStrict $ \s -> s { shadings = newMap } 33 | tell . mconcat $[ serialize "\n/" 34 | , serialize newName 35 | , serialize " sh" 36 | ] 37 | 38 | paintWithShading :: PDFShading -- ^ Shading 39 | -> Draw a -- ^ Shape to paint 40 | -> Draw () 41 | paintWithShading shade d = do 42 | withNewContext $ do 43 | _ <- d 44 | setAsClipPath 45 | applyShading shade -------------------------------------------------------------------------------- /Graphics/PDF/Shapes.hs: -------------------------------------------------------------------------------- 1 | --------------------------------------------------------- 2 | -- | 3 | -- Copyright : (c) 2006-2016, alpheccar.org 4 | -- License : BSD-style 5 | -- 6 | -- Maintainer : misc@NOSPAMalpheccar.org 7 | -- Stability : experimental 8 | -- Portability : portable 9 | -- 10 | -- PDF Shapes 11 | --------------------------------------------------------- 12 | 13 | module Graphics.PDF.Shapes( 14 | -- * Shapes 15 | -- ** Paths 16 | moveto 17 | , lineto 18 | , arcto 19 | , curveto 20 | , beginPath 21 | , closePath 22 | , addBezierCubic 23 | , addPolygonToPath 24 | , addLineToPath 25 | , strokePath 26 | , fillPath 27 | , fillAndStrokePath 28 | , fillPathEO 29 | , fillAndStrokePathEO 30 | , setAsClipPath 31 | , setAsClipPathEO 32 | -- ** Usual shapes 33 | , Shape(..) 34 | , Line(..) 35 | , Rectangle(..) 36 | , Polygon(..) 37 | , Arc(..) 38 | , Ellipse(..) 39 | , Circle(..) 40 | , RoundRectangle(..) 41 | -- ** Style 42 | , CapStyle(..) 43 | , JoinStyle(..) 44 | , DashPattern(..) 45 | , setWidth 46 | , setLineCap 47 | , setLineJoin 48 | , setDash 49 | , setNoDash 50 | , setMiterLimit 51 | ) where 52 | 53 | import Graphics.PDF.LowLevel.Types 54 | import Graphics.PDF.Coordinates 55 | import Graphics.PDF.Draw 56 | import Control.Monad.Writer 57 | import Graphics.PDF.LowLevel.Serializer 58 | 59 | class Shape a where 60 | addShape :: a -> Draw () 61 | stroke :: a -> Draw () 62 | fill :: a -> Draw () 63 | fillAndStroke :: a -> Draw () 64 | fillEO :: a -> Draw () 65 | fillAndStrokeEO :: a -> Draw () 66 | stroke r = do 67 | addShape r 68 | strokePath 69 | fill r = do 70 | addShape r 71 | fillPath 72 | fillAndStroke r = do 73 | addShape r 74 | fillAndStrokePath 75 | fillEO r = do 76 | addShape r 77 | fillPathEO 78 | fillAndStrokeEO r = do 79 | addShape r 80 | fillAndStrokePathEO 81 | 82 | data Line = Line PDFFloat PDFFloat PDFFloat PDFFloat deriving(Eq) 83 | instance Shape Line where 84 | addShape (Line x0 y0 x1 y1)= do 85 | moveto (x0 :+ y0) 86 | lineto (x1 :+ y1) 87 | fill _ = error "Can't fill a line !" 88 | fillAndStroke _ = error "Can't fill a line !" 89 | fillEO _ = error "Can't fill a line !" 90 | fillAndStrokeEO _ = error "Can't fill a line !" 91 | 92 | data Rectangle = Rectangle !Point !Point deriving (Eq) 93 | instance Shape Rectangle where 94 | addShape (Rectangle a b) 95 | = tell . mconcat $ [ serialize '\n' 96 | , toPDF a 97 | , serialize ' ' 98 | , toPDF (b - a) 99 | , serialize " re" ] 100 | 101 | data Arc = Arc PDFFloat PDFFloat PDFFloat PDFFloat deriving(Eq) 102 | instance Shape Arc where 103 | addShape (Arc x0 y0 x1 y1) = do 104 | let height = y1 - y0 105 | width = x1 - x0 106 | kappa = 0.5522847498 107 | beginPath (x0 :+ y0) 108 | addBezierCubic ((x0+width*kappa) :+ y0) (x1 :+ (y1-height*kappa)) (x1 :+ y1) 109 | 110 | data Ellipse = Ellipse PDFFloat PDFFloat PDFFloat PDFFloat deriving(Eq) 111 | instance Shape Ellipse where 112 | addShape (Ellipse x0 y0 x1 y1) = do 113 | let xm = (x0+x1)/2.0 114 | ym = (y0+y1)/2.0 115 | k = 0.5522847498 116 | h = k*(abs (y1 - y0)/2.0) 117 | w = k*(abs (x1 - x0)/2.0) 118 | 119 | beginPath (xm :+ y0) 120 | addBezierCubic ((xm + w) :+ y0) (x1 :+ (ym - h)) (x1 :+ ym) 121 | addBezierCubic (x1 :+ (ym + h)) ((xm + w) :+ y1) (xm :+ y1) 122 | addBezierCubic ((xm - w) :+ y1) (x0 :+ (ym + h)) (x0 :+ ym) 123 | addBezierCubic (x0 :+ (ym - h)) ((xm - w) :+ y0) (xm :+ y0) 124 | 125 | data RoundRectangle = RoundRectangle PDFFloat PDFFloat PDFFloat PDFFloat PDFFloat PDFFloat deriving(Eq) 126 | instance Shape RoundRectangle where 127 | addShape (RoundRectangle rw rh x0 y0 x1 y1) = do 128 | let k = 0.5522847498 129 | h = k*rw 130 | w = k*rh 131 | 132 | beginPath ((x0+rw) :+ y0) 133 | addLineToPath ((x1-rw) :+ y0) 134 | addBezierCubic ((x1-rw + w) :+ y0) (x1 :+ (y0+rh - h)) (x1 :+ (y0+rh)) 135 | addLineToPath (x1 :+ (y1-rh)) 136 | addBezierCubic (x1 :+ (y1-rh + h)) ((x1-rw + w) :+ y1) ((x1-rw) :+ y1) 137 | addLineToPath ((x0+rw) :+ y1) 138 | addBezierCubic ((x0+rw - w) :+ y1) (x0 :+ (y1-rh + h)) (x0 :+ (y1-rh)) 139 | addLineToPath (x0 :+ (y0+rh)) 140 | addBezierCubic (x0 :+ (y0+rh - h)) ((x0+rw - w) :+ y0) ((x0+rw) :+ y0) 141 | addLineToPath ((x1-rw) :+ y0) 142 | 143 | data Circle = Circle PDFFloat PDFFloat PDFFloat deriving(Eq) 144 | instance Shape Circle where 145 | addShape (Circle x0 y0 r) = addShape (Ellipse (x0-r) (y0-r) (x0+r) (y0+r) ) 146 | 147 | newtype Polygon = Polygon [Point] 148 | instance Shape Polygon where 149 | addShape (Polygon l) = addPolygonToPath l 150 | 151 | 152 | -- | Set pen width 153 | setWidth :: MonadPath m => PDFFloat -> m () 154 | setWidth w = tell . mconcat $[ serialize "\n" 155 | , toPDF w 156 | , serialize " w" 157 | ] 158 | 159 | -- | Set pen width 160 | setMiterLimit :: MonadPath m => PDFFloat -> m () 161 | setMiterLimit w = tell . mconcat $[ serialize "\n" 162 | , toPDF w 163 | , serialize " M" 164 | ] 165 | 166 | -- | Line cap styles 167 | data CapStyle = ButtCap 168 | | RoundCap 169 | | SquareCap 170 | deriving(Eq,Enum) 171 | 172 | -- | Line join styles 173 | data JoinStyle = MiterJoin 174 | | RoundJoin 175 | | BevelJoin 176 | deriving(Eq,Enum) 177 | 178 | -- | Set line cap 179 | setLineCap :: MonadPath m => CapStyle -> m () 180 | setLineCap w = tell . mconcat $[ serialize "\n " 181 | , toPDF (fromEnum w) 182 | , serialize " J" 183 | ] 184 | 185 | -- | Set line join 186 | setLineJoin :: MonadPath m => JoinStyle -> m () 187 | setLineJoin w = tell . mconcat $[ serialize "\n " 188 | , toPDF (fromEnum w) 189 | , serialize " j" 190 | ] 191 | 192 | data DashPattern = DashPattern ![PDFFloat] PDFFloat deriving(Eq) 193 | 194 | -- | Set the dash pattern 195 | setDash :: MonadPath m => DashPattern -> m() 196 | setDash (DashPattern a p) = 197 | tell . mconcat$ [ serialize "\n " 198 | , toPDF a 199 | , serialize ' ' 200 | , toPDF p 201 | , serialize " d" 202 | ] 203 | 204 | -- | No dash pattern 205 | setNoDash :: MonadPath m => m () 206 | setNoDash = setDash (DashPattern [] 0) 207 | 208 | -- | Begin a new path at a position 209 | beginPath :: Point 210 | -> Draw () 211 | beginPath = moveto 212 | 213 | -- | Close current path 214 | closePath :: Draw () 215 | closePath = tell . serialize $ "\nh" 216 | 217 | 218 | -- | Append a cubic Bezier curve to the current path. The curve extends 219 | -- from the current point to the point (x3 , y3), using (x1 , y1 ) and 220 | -- (x2, y2) as the Bezier control points 221 | addBezierCubic :: Point 222 | -> Point 223 | -> Point 224 | -> Draw () 225 | addBezierCubic b c d = do 226 | tell . mconcat $ [ serialize "\n" 227 | , toPDF b 228 | , serialize ' ' 229 | , toPDF c 230 | , serialize ' ' 231 | , toPDF d 232 | , serialize " c" 233 | ] 234 | writeDrawST penPosition d 235 | 236 | -- | Move pen to a given point without drawing anything 237 | moveto :: Point 238 | -> Draw () 239 | moveto a = do 240 | tell . mconcat $ [ serialize "\n" 241 | , toPDF a 242 | , serialize " m" 243 | ] 244 | writeDrawST penPosition a 245 | 246 | -- | Draw a line from current point to the one specified by lineto 247 | lineto :: Point 248 | -> Draw () 249 | lineto a = do 250 | tell . mconcat $[ serialize "\n" 251 | , toPDF a 252 | , serialize " l" 253 | ] 254 | writeDrawST penPosition a 255 | 256 | curveto :: Point -> Point -> Point -> Draw () 257 | curveto = addBezierCubic 258 | 259 | -- | Approximate a circular arc by one cubic bezier curve. 260 | -- larger arc angles mean larger distortions 261 | arcto :: Angle -- ^ Extent of arc 262 | -> Point -- ^ Center of arc 263 | -> Draw () 264 | arcto extent 265 | = let theta = toRadian extent 266 | kappa = 4 / 3 * tan (theta / 4) 267 | cis_theta = cis theta 268 | rot90 (x :+ y) = ((-y) :+ x) 269 | in if theta == 0 270 | then \_center -> return () 271 | else \center -> do 272 | a <- readDrawST penPosition 273 | let delta = a - center 274 | delta' = scalePt kappa (rot90 delta) 275 | d = center + delta * cis_theta 276 | c = d - delta' * cis_theta 277 | b = a + delta' 278 | curveto b c d 279 | 280 | addLineToPath :: Point 281 | -> Draw () 282 | addLineToPath = lineto 283 | 284 | -- | Add a polygon to current path 285 | addPolygonToPath :: [Point] 286 | -> Draw () 287 | addPolygonToPath [] = return () 288 | addPolygonToPath (l : ls) = do 289 | moveto l 290 | mapM_ addLineToPath ls 291 | 292 | -- | Draw current path 293 | strokePath :: Draw () 294 | strokePath = tell . serialize $ "\nS" 295 | 296 | -- | Fill current path 297 | fillPath :: Draw () 298 | fillPath = tell . serialize $ "\nf" 299 | 300 | -- | Fill current path 301 | fillAndStrokePath :: Draw () 302 | fillAndStrokePath = tell . serialize $ "\nB" 303 | 304 | -- | Set clipping path 305 | setAsClipPathEO :: Draw () 306 | setAsClipPathEO = tell . serialize $ "\nW* n" 307 | 308 | -- | Set clipping path 309 | setAsClipPath :: Draw () 310 | setAsClipPath = tell . serialize $ "\nW n" 311 | 312 | -- | Fill current path using even odd rule 313 | fillPathEO :: Draw () 314 | fillPathEO = tell . serialize $ "\nf*" 315 | 316 | -- | Fill current path using even odd rule 317 | fillAndStrokePathEO :: Draw () 318 | fillAndStrokePathEO = tell . serialize $ "\nB*" -------------------------------------------------------------------------------- /Graphics/PDF/Text.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 3 | {-# LANGUAGE DeriveFunctor #-} 4 | --------------------------------------------------------- 5 | -- | 6 | -- Copyright : (c) 2006-2016, alpheccar.org 7 | -- License : BSD-style 8 | -- 9 | -- Maintainer : misc@NOSPAMalpheccar.org 10 | -- Stability : experimental 11 | -- Portability : portable 12 | -- 13 | -- PDF Text 14 | --------------------------------------------------------- 15 | {-# LANGUAGE FlexibleContexts #-} 16 | module Graphics.PDF.Text( 17 | -- * Text 18 | -- ** Types 19 | PDFFont(..) 20 | , FontName(..) 21 | , TextMode(..) 22 | , PDFText 23 | , UnscaledUnit 24 | -- ** Functions 25 | , drawText 26 | , text 27 | , startNewLine 28 | , displayGlyphs 29 | , displayText 30 | , textStart 31 | , setFont 32 | , leading 33 | , charSpace 34 | , wordSpace 35 | , textScale 36 | , renderMode 37 | , rise 38 | , setTextMatrix 39 | , textWidth 40 | , pdfGlyph 41 | , glyph 42 | ) where 43 | 44 | import Graphics.PDF.LowLevel.Types 45 | import Graphics.PDF.Draw 46 | import Control.Monad.State 47 | import Graphics.PDF.Resources 48 | import Control.Monad.Writer 49 | import qualified Data.Set as Set 50 | import Data.List(foldl') 51 | import Data.Binary.Builder(Builder) 52 | import Graphics.PDF.LowLevel.Serializer 53 | import qualified Data.ByteString as S 54 | import qualified Data.Text as T 55 | import Graphics.PDF.Fonts.Font 56 | import Graphics.PDF.Fonts.StandardFont 57 | 58 | 59 | glyphStreamWidth :: PDFFont 60 | -> PDFGlyph 61 | -> PDFFloat 62 | glyphStreamWidth (PDFFont f s) (PDFGlyph t) = 63 | let w = foldl' (\a b -> a + glyphWidth f s (fromIntegral b)) 0 . S.unpack $ t 64 | in 65 | w + (foldl' (\a (x,y) -> a + getKern f s x y) 0 $ [(GlyphCode ca,GlyphCode cb) | (ca,cb) <- S.zip t (S.tail t)]) 66 | 67 | textWidth :: PDFFont -> T.Text -> PDFFloat 68 | textWidth f t = glyphStreamWidth f . pdfGlyph f $ t 69 | 70 | pdfGlyph :: PDFFont 71 | -> T.Text 72 | -> PDFGlyph 73 | pdfGlyph (PDFFont f _) t = PDFGlyph . S.pack . map (fromIntegral . charGlyph f) . T.unpack $ t 74 | 75 | 76 | type FontState = (Set.Set AnyFont) 77 | 78 | data TextParameter = TextParameter { tc :: !PDFFloat 79 | , tw :: !PDFFloat 80 | , tz :: !PDFFloat 81 | , tl :: !PDFFloat 82 | , ts :: !PDFFloat 83 | , fontState :: FontState 84 | , currentFont :: Maybe PDFFont 85 | } 86 | defaultParameters :: TextParameter 87 | defaultParameters = TextParameter 0 0 100 0 0 (Set.empty) Nothing 88 | 89 | 90 | -- | The text monad 91 | newtype PDFText a = PDFText {unText :: WriterT Builder (State TextParameter) a} 92 | #ifndef __HADDOCK__ 93 | deriving(Monad,Applicative,Functor,MonadWriter Builder,MonadState TextParameter) 94 | #else 95 | instance Monad PDFText 96 | instance Functor PDFText 97 | instance MonadWriter Builder PDFText 98 | instance MonadState TextParameter PDFText 99 | #endif 100 | 101 | instance MonadPath PDFText 102 | 103 | -- | Unscaled unit (not scaled by the font size) 104 | type UnscaledUnit = PDFFloat 105 | 106 | -- | Rendering mode for text display 107 | data TextMode = FillText 108 | | StrokeText 109 | | FillAndStrokeText 110 | | InvisibleText 111 | | FillTextAndAddToClip 112 | | StrokeTextAndAddToClip 113 | | FillAndStrokeTextAndAddToClip 114 | | AddToClip 115 | deriving(Eq,Ord,Enum) 116 | 117 | -- | Select a font to use 118 | setFont :: PDFFont -> PDFText () 119 | setFont f@(PDFFont n size) = PDFText $ do 120 | lift (modifyStrict $ \s -> s {fontState = Set.insert n (fontState s), currentFont = Just f}) 121 | tell . mconcat$ [ serialize "\n/" 122 | , serialize (name n) 123 | , serialize ' ' 124 | , toPDF size 125 | , serialize " Tf" 126 | ] 127 | 128 | 129 | -- | Draw a text in the draw monad 130 | drawText :: PDFText a 131 | -> Draw a 132 | drawText t = do 133 | let ((a,w),s) = (runState . runWriterT . unText $ t) defaultParameters 134 | mapM_ addFontRsrc (Set.elems (fontState s)) 135 | tell . serialize $ "\nBT" 136 | tell w 137 | tell . serialize $ "\nET" 138 | return a 139 | where 140 | addFontRsrc font = modifyStrict $ \s -> 141 | s { rsrc = addResource (PDFName "Font") (PDFName (name font)) (toRsrc font) (rsrc s)} 142 | 143 | -- | Set position for the text beginning 144 | textStart :: PDFFloat 145 | -> PDFFloat 146 | -> PDFText () 147 | textStart x y = tell . mconcat $ [ serialize '\n' 148 | , toPDF x 149 | , serialize ' ' 150 | , toPDF y 151 | , serialize " Td" 152 | ] 153 | --writeCmd $ "\n" ++ (show x) ++ " " ++ (show y) ++ " Td" 154 | 155 | 156 | glyph :: GlyphCode -> PDFGlyph 157 | glyph c = PDFGlyph . S.singleton $ (fromIntegral c) 158 | 159 | -- | Display glyphs 160 | displayGlyphs :: PDFGlyph 161 | -> PDFText () 162 | displayGlyphs t = do 163 | tell $ serialize ' ' 164 | tell . toPDF $ t 165 | tell . serialize $ " Tj" 166 | 167 | -- | Display text 168 | displayText :: T.Text 169 | -> PDFText () 170 | displayText t = do 171 | f <- gets currentFont 172 | case f of 173 | Nothing -> return () 174 | Just aFont -> do 175 | let g = pdfGlyph aFont t 176 | displayGlyphs g 177 | 178 | 179 | -- f <- gets currentFont 180 | -- let rt = ripText f t 181 | -- tell . serialize $ '\n' 182 | -- tell lbracket 183 | -- mapM_ displayGlyphs rt 184 | -- tell rbracket 185 | -- tell $ serialize " TJ" 186 | -- where 187 | -- displayGlyphs (w,c) = do 188 | -- tell $ toPDF (toPDFString $ c:[]) 189 | -- tell bspace 190 | -- tell . toPDF $ w 191 | -- tell bspace 192 | 193 | 194 | -- | Start a new line (leading value must have been set) 195 | startNewLine :: PDFText () 196 | startNewLine = tell . serialize $ "\nT*" 197 | 198 | -- | Set leading value 199 | leading :: UnscaledUnit -> PDFText () 200 | leading v = PDFText $ do 201 | lift (modifyStrict $ \s -> s {tl = v}) 202 | tell . mconcat $ [ serialize '\n' 203 | , toPDF v 204 | , serialize " TL" 205 | ] 206 | 207 | -- | Set the additional char space 208 | charSpace :: UnscaledUnit -> PDFText () 209 | charSpace v = PDFText $ do 210 | lift (modifyStrict $ \s -> s {tc = v}) 211 | tell . mconcat $ [ serialize '\n' 212 | , toPDF v 213 | , serialize " Tc" 214 | ] 215 | 216 | -- | Set the additional word space 217 | wordSpace :: UnscaledUnit -> PDFText () 218 | wordSpace v = PDFText $ do 219 | lift (modifyStrict $ \s -> s {tw = v}) 220 | tell . mconcat $ [ serialize '\n' 221 | , toPDF v 222 | , serialize " Tw" 223 | ] 224 | 225 | -- | Set scaling factor for text 226 | textScale :: PDFFloat -> PDFText () 227 | textScale v = PDFText $ do 228 | lift (modifyStrict $ \s -> s {tz = v}) 229 | tell . mconcat $ [ serialize '\n' 230 | , toPDF v 231 | , serialize " Tz" 232 | ] 233 | 234 | -- | Choose the text rendering mode 235 | renderMode :: TextMode -> PDFText () 236 | renderMode v = 237 | tell . mconcat $ [ serialize '\n' 238 | , toPDF (fromEnum v) 239 | , serialize " Tr" 240 | ] 241 | 242 | -- | Set the rise value 243 | rise :: UnscaledUnit -> PDFText () 244 | rise v = PDFText $ do 245 | lift (modifyStrict $ \s -> s {ts = v}) 246 | tell . mconcat $ [ serialize '\n' 247 | , toPDF v 248 | , serialize " Ts" 249 | ] 250 | 251 | -- | Set the text transformation matrix 252 | setTextMatrix :: Matrix -> PDFText() 253 | setTextMatrix (Matrix a b c d e f) = 254 | tell . mconcat $[ serialize '\n' 255 | , toPDF a 256 | , serialize ' ' 257 | , toPDF b 258 | , serialize ' ' 259 | , toPDF c 260 | , serialize ' ' 261 | , toPDF d 262 | , serialize ' ' 263 | , toPDF e 264 | , serialize ' ' 265 | , toPDF f 266 | , serialize " Tm" 267 | ] 268 | 269 | -- | Utility function to quickly display one line of text 270 | text :: PDFFont 271 | -> PDFFloat 272 | -> PDFFloat 273 | -> T.Text 274 | -> PDFText () 275 | text f x y t = do 276 | setFont f 277 | let g = pdfGlyph f t 278 | textStart x y 279 | displayGlyphs g 280 | 281 | -------------------------------------------------------------------------------- /Graphics/PDF/Typesetting/Box.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ExistentialQuantification #-} 2 | {-# LANGUAGE TypeSynonymInstances #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | --------------------------------------------------------- 5 | -- | 6 | -- Copyright : (c) 2006-2016, alpheccar.org 7 | -- License : BSD-style 8 | -- 9 | -- Maintainer : misc@NOSPAMalpheccar.org 10 | -- Stability : experimental 11 | -- Portability : portable 12 | -- 13 | -- Box 14 | --------------------------------------------------------- 15 | -- #hide 16 | module Graphics.PDF.Typesetting.Box ( 17 | Box(..) 18 | , DisplayableBox(..) 19 | , AnyBox(..) 20 | , Style(..) 21 | , TextStyle(..) 22 | , StyleFunction(..) 23 | , BoxDimension 24 | , DrawBox 25 | , ComparableStyle(..) 26 | , mkDrawBox 27 | , styleFont 28 | ) where 29 | 30 | import Graphics.PDF.LowLevel.Types 31 | import Graphics.PDF.Draw 32 | import Graphics.PDF.Text 33 | import Graphics.PDF.Shapes 34 | import Graphics.PDF.Coordinates 35 | import Graphics.PDF.Fonts.Font 36 | 37 | -- | Make a drawing box. A box object containing a Draw value 38 | mkDrawBox :: Draw () -> DrawBox 39 | mkDrawBox d = DrawBox d 40 | 41 | -- | A box containing a Draw value 42 | newtype DrawBox = DrawBox (Draw()) 43 | 44 | instance Box DrawBox where 45 | boxWidth _ = 0 46 | boxHeight _ = 0 47 | boxDescent _ = 0 48 | 49 | instance DisplayableBox DrawBox where 50 | strokeBox (DrawBox a) x y = do 51 | withNewContext $ do 52 | applyMatrix $ translate (x :+ y) 53 | a 54 | 55 | instance Show DrawBox where 56 | show _ = "DrawBox" 57 | 58 | -- | Dimension of a box : width, height and descent 59 | type BoxDimension = (PDFFloat,PDFFloat,PDFFloat) 60 | 61 | -- | Text style used by PDF operators 62 | data TextStyle = TextStyle { textFont :: !PDFFont 63 | , textStrokeColor :: !Color 64 | , textFillColor :: !Color 65 | , textMode :: !TextMode 66 | , penWidth :: !PDFFloat 67 | , scaleSpace :: !PDFFloat -- ^ Scaling factor for normal space size (scale also the dilation and compression factors) 68 | , scaleDilatation :: !PDFFloat -- ^ Scale the dilation factor of glues 69 | , scaleCompression :: !PDFFloat -- ^ Scale the compression factor of glues 70 | } 71 | deriving(Eq) 72 | 73 | -- | What kind of style drawing function is required for a word 74 | -- when word styling is enabled 75 | data StyleFunction = DrawWord -- ^ Must style a word 76 | | DrawGlue -- ^ Must style a glue 77 | deriving(Eq) 78 | 79 | -- | Used to compare two style without taking into account the style state 80 | class ComparableStyle a where 81 | isSameStyleAs :: a -> a -> Bool 82 | 83 | -- | Style of text (sentences and words). Minimum definition textStyle 84 | class ComparableStyle a => Style a where 85 | -- ^ Modify the look of a sentence (sequence of words using the same style on a line) 86 | sentenceStyle :: a -- ^ The style 87 | -> Maybe (Rectangle -> Draw b -> Draw ()) -- ^ Function receiving the bounding rectangle and the command for drawing the sentence 88 | sentenceStyle _ = Nothing 89 | 90 | -- ^ Modify the look of a word 91 | wordStyle :: a -- ^ The style 92 | -> Maybe (Rectangle -> StyleFunction -> Draw b -> Draw ()) -- ^ Word styling function 93 | wordStyle _ = Nothing 94 | 95 | textStyle :: a -> TextStyle 96 | 97 | -- | A style may contain data changed from word to word 98 | updateStyle :: a -> a 99 | updateStyle = id 100 | 101 | -- | A style may change the height of words 102 | -- 103 | -- > Default implementation 104 | -- > styleHeight = getHeight . textFont . textStyle 105 | -- 106 | styleHeight :: a -> PDFFloat 107 | 108 | -- | A style may change the descent of lines 109 | -- 110 | -- > Default implementation 111 | -- > styleDescent = getDescent . textFont . textStyle 112 | -- 113 | styleDescent :: a -> PDFFloat 114 | styleHeight a = 115 | let PDFFont f s = textFont . textStyle $ a in 116 | getHeight f s 117 | styleDescent a = 118 | let PDFFont f s = textFont . textStyle $ a in 119 | getDescent f s 120 | 121 | 122 | styleFont :: Style s => s -> AnyFont 123 | styleFont style = 124 | let PDFFont n _ = textFont . textStyle $ style 125 | in 126 | n 127 | 128 | 129 | -- | A box is an object with dimensions and used in the typesetting process 130 | class Box a where 131 | -- | Box width 132 | boxWidth :: a -- ^ Box 133 | -> PDFFloat -- ^ Width of the box 134 | 135 | -- | Box height 136 | boxHeight :: a -> PDFFloat 137 | -- | Distance between box bottom and box baseline 138 | boxDescent :: a -> PDFFloat 139 | -- | Distance between box top and box baseline 140 | boxAscent :: a -> PDFFloat 141 | boxAscent a = boxHeight a - boxDescent a 142 | 143 | instance Box BoxDimension where 144 | boxWidth (w,_,_) = w 145 | boxHeight (_,h,_) = h 146 | boxDescent (_,_,d) = d 147 | 148 | -- | A box that can be displayed 149 | class DisplayableBox a where 150 | -- | Draw a box 151 | strokeBox :: a -- ^ The box 152 | -> PDFFloat -- ^ Horizontal position 153 | -> PDFFloat -- ^ Vertical position (top of the box and NOT baseline) 154 | -> Draw () 155 | 156 | instance Box AnyBox where 157 | boxWidth (AnyBox a) = boxWidth a 158 | boxHeight (AnyBox a) = boxHeight a 159 | boxDescent (AnyBox a) = boxDescent a 160 | 161 | instance DisplayableBox AnyBox where 162 | strokeBox (AnyBox a) = strokeBox a 163 | 164 | instance Show AnyBox where 165 | show (AnyBox a) = show a 166 | 167 | data AnyBox = forall a. (Show a,Box a, DisplayableBox a) => AnyBox a 168 | -------------------------------------------------------------------------------- /Graphics/PDF/Typesetting/StandardStyle.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses #-} 2 | --------------------------------------------------------- 3 | -- | 4 | -- Copyright : (c) 2006-2016, alpheccar.org 5 | -- License : BSD-style 6 | -- 7 | -- Maintainer : misc@NOSPAMalpheccar.org 8 | -- Stability : experimental 9 | -- Portability : portable 10 | -- 11 | -- Standard styles for typesettings 12 | --------------------------------------------------------- 13 | -- #hide 14 | module Graphics.PDF.Typesetting.StandardStyle( 15 | -- * Styles 16 | StandardStyle(..) 17 | , StandardParagraphStyle(..) 18 | ) where 19 | 20 | import Graphics.PDF.Colors 21 | import Graphics.PDF.Text 22 | import Graphics.PDF.Typesetting.Vertical 23 | import Graphics.PDF.Typesetting.Box 24 | 25 | -- | Standard styles for sentences 26 | data StandardStyle = Font PDFFont Color Color 27 | 28 | -- | Standard styles for paragraphs 29 | data StandardParagraphStyle = NormalParagraph 30 | 31 | 32 | instance ComparableStyle StandardStyle where 33 | isSameStyleAs (Font a sca fca) (Font b scb fcb) = a == b && sca == scb && fca == fcb 34 | --isSameStyleAs _ _ = False 35 | 36 | instance ComparableStyle StandardParagraphStyle where 37 | isSameStyleAs NormalParagraph NormalParagraph = True 38 | 39 | instance Style StandardStyle where 40 | textStyle (Font a sc fc) = TextStyle a sc fc FillText 1.0 1.0 1.0 1.0 41 | 42 | instance ParagraphStyle StandardParagraphStyle StandardStyle -------------------------------------------------------------------------------- /Graphics/PDF/Typesetting/Vertical.hs: -------------------------------------------------------------------------------- 1 | --------------------------------------------------------- 2 | -- | 3 | -- Copyright : (c) 2006-2016, alpheccar.org 4 | -- License : BSD-style 5 | -- 6 | -- Maintainer : misc@NOSPAMalpheccar.org 7 | -- Stability : experimental 8 | -- Portability : portable 9 | -- 10 | -- Vertical mode 11 | --------------------------------------------------------- 12 | -- #hide 13 | module Graphics.PDF.Typesetting.Vertical ( 14 | mkVboxWithRatio 15 | , vglue 16 | , defaultVerState 17 | , ParagraphStyle(..) 18 | , VerState(..) 19 | , fillContainer 20 | , mkContainer 21 | , VBox(..) 22 | ) where 23 | 24 | import Graphics.PDF.LowLevel.Types 25 | import Graphics.PDF.Typesetting.Breaking 26 | import Graphics.PDF.Typesetting.Horizontal(horizontalPostProcess,HBox) 27 | import Graphics.PDF.Draw 28 | import Graphics.PDF.Typesetting.Box 29 | import Data.List(foldl') 30 | import Graphics.PDF.Typesetting.Layout 31 | 32 | -- | Default vertical state 33 | -- 34 | -- > Default values 35 | -- > baselineskip = (12,0.17,0.0) 36 | -- > lineskip = (3.0,0.33,0.0) 37 | -- > lineskiplimit = 2 38 | -- 39 | defaultVerState :: s -> VerState s 40 | defaultVerState s = VerState { baselineskip = (12,0.17,0.0) 41 | , lineskip = (3.0,0.33,0.0) 42 | , lineskiplimit = 2 43 | , currentParagraphStyle = s 44 | } 45 | 46 | -- | Pair of functions describing the shape of a text areas : horizontal position of each line, vertical top of the area, width of each line 47 | -- First line is 1 48 | 49 | 50 | 51 | 52 | 53 | -- | A line of hboxes with an adjustement ratio required to display the text (generate the PDF command to increase space size) 54 | --data HLine = HLine !PDFFloat ![HBox] deriving(Show) 55 | 56 | mkVboxWithRatio :: PDFFloat -- ^ Adjustement ratio 57 | -> [VBox ps s] 58 | -> VBox ps s 59 | mkVboxWithRatio _ [] = error "Cannot make an empty vbox" 60 | mkVboxWithRatio r l = 61 | let w = foldl' (\x y -> x + glueSizeWithRatio y r) 0.0 l 62 | h = maximum . map boxHeight $ l 63 | d = maximum . map boxDescent $ l 64 | addBox (VGlue gw gh gdelta (Just(y,z)) s) (VBox w' h' d' l' s') = VBox w' h' d' (VGlue (glueSize gw y z r) gh gdelta Nothing s:l') s' 65 | addBox a (VBox w' h' d' l' s') = VBox w' h' d' (a:l') s' 66 | addBox _ _ = error "We can add boxes only to an horizontal list" 67 | in 68 | -- Add boxes and dilate glues when needing fixing their dimensions after dilatation 69 | foldr addBox (VBox w h d [] Nothing) l 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | dilateVboxes :: PDFFloat -> VBox ps s -> VBox ps s 79 | dilateVboxes r g@(VGlue _ w l (Just(_,_)) s) = 80 | let h' = glueSizeWithRatio g r 81 | in 82 | VGlue h' w l Nothing s 83 | dilateVboxes _ g@(VGlue _ _ _ Nothing _) = g 84 | dilateVboxes _ a = a 85 | 86 | drawContainer :: ParagraphStyle ps s => Container ps s -- ^ Container 87 | -> Draw () 88 | drawContainer (Container px py _ maxh h y z _ oldl) = 89 | let l' = reverse oldl 90 | r = min (dilatationRatio maxh h y z) 2.0 91 | l'' = map (dilateVboxes r) l' 92 | in 93 | strokeVBoxes l'' px py 94 | 95 | -- | Create a new paragraph from the remaining letters 96 | createPara :: Int 97 | -> Maybe ps 98 | -> BRState 99 | -> [Letter s] 100 | -> [VBox ps s] 101 | createPara _ _ _ [] = [] 102 | createPara lineOffset style paraSettings l = [Paragraph lineOffset (simplify l) style paraSettings] 103 | 104 | -- | Add paragraph lines to a container 105 | addParaLine :: (ParagraphStyle ps s, ComparableStyle ps) => VerState ps 106 | -> Maybe ps 107 | -> BRState 108 | -> Container ps s -- ^ Container 109 | -> [((HBox s,[Letter s]),Int)] 110 | -> Either (Draw (),Container ps s,[VBox ps s]) (Container ps s) 111 | addParaLine _ _ _ c [] = Right c 112 | addParaLine verstate style paraSettings c (((line,remainingPar),lineNb):l) = 113 | let c' = addTo verstate (toVBoxes style (containerWidth c) line lineNb) c 114 | in 115 | if isOverfull c' 116 | then 117 | Left (drawContainer c,c,createPara lineNb style paraSettings remainingPar) 118 | else 119 | addParaLine verstate style paraSettings c' l 120 | 121 | -- | Fill a container with lines 122 | fillContainer :: (ParagraphStyle ps s, ComparableStyle ps) => VerState ps -- ^ Vertical style for interline glues 123 | -> Container ps s -- ^ Container 124 | -> [VBox ps s] -- ^ VBox to add 125 | -> (Draw(),Container ps s,[VBox ps s]) -- ^ Component to draw, new container and remaining VBoxes due to overfull container 126 | fillContainer _ c [] = (drawContainer c,c,[]) 127 | fillContainer verstate c para@(Paragraph lineOffset l style paraSettings:l') = 128 | if containerContentHeight c > containerHeight c - containerParaTolerance c 129 | then 130 | (drawContainer c,c,para) 131 | else 132 | let (fl,newStyle) = case style of 133 | Nothing -> (formatList paraSettings (const $ containerWidth c) l,Nothing) 134 | Just aStyle -> let (style',nl) = paragraphChange aStyle lineOffset l 135 | in 136 | (formatList paraSettings (\nb -> (lineWidth style') (containerWidth c) (nb+lineOffset) ) nl,Just style') 137 | newLines = horizontalPostProcess fl 138 | r = addParaLine verstate newStyle paraSettings c (zip newLines [1..]) 139 | in 140 | case r of 141 | Left (d,c',remPara) -> (d,c',remPara ++ l') 142 | Right c' -> fillContainer verstate c' l' 143 | 144 | fillContainer verstate c oldl@(a:l) = 145 | let c' = addTo verstate a c 146 | in 147 | if isOverfull c' 148 | then 149 | (drawContainer c,c,oldl) 150 | else 151 | fillContainer verstate c' l 152 | 153 | -- | Convert pure lines to VBoxes 154 | toVBoxes :: (ParagraphStyle ps s) => Maybe ps 155 | -> PDFFloat -- ^ Max width 156 | -> HBox s -- ^ List of lines 157 | -> Int -- ^ Line number 158 | -> VBox ps s -- ^ List of VBoxes 159 | toVBoxes Nothing _ a _ = SomeVBox 0.0 (boxWidth a,boxHeight a,boxDescent a) (AnyBox a) Nothing 160 | toVBoxes s@(Just style) w a nb = 161 | let delta = (linePosition style) w nb in 162 | SomeVBox delta (boxWidth a,boxHeight a,boxDescent a) (AnyBox a) s 163 | 164 | -------------------------------------------------------------------------------- /Graphics/PDF/Typesetting/WritingSystem.hs: -------------------------------------------------------------------------------- 1 | --------------------------------------------------------- 2 | -- | 3 | -- Copyright : (c) 2006-2016, alpheccar.org 4 | -- License : BSD-style 5 | -- 6 | -- Maintainer : misc@NOSPAMalpheccar.org 7 | -- Stability : experimental 8 | -- Portability : portable 9 | -- 10 | -- PDF Font 11 | --------------------------------------------------------- 12 | module Graphics.PDF.Typesetting.WritingSystem( 13 | WritingSystem(..) 14 | , Language(..) 15 | , mapToSpecialGlyphs 16 | ) where 17 | 18 | import qualified Data.Text as T 19 | import Graphics.PDF.LowLevel.Types 20 | import qualified Graphics.PDF.Hyphenate as H 21 | import Data.List(intersperse) 22 | import Data.Char 23 | import Data.List(unfoldr) 24 | 25 | data Language = English 26 | | OtherLanguage 27 | 28 | data WritingSystem = Latin Language 29 | | UnknownWritingSystem 30 | 31 | 32 | myWords' :: T.Text -> Maybe (T.Text, T.Text) 33 | myWords' l | T.null l = Nothing 34 | | otherwise = if T.null h then Just (h', t') else Just (T.singleton ' ', t) 35 | where 36 | (h, t) = T.span isSpace l 37 | (h', t') = T.span (not . isSpace) l 38 | 39 | 40 | -- | Split a sentence into words keeping the space but shortening them to 1 space 41 | myWords :: T.Text -> [T.Text] 42 | myWords l = concatMap onlyWord . unfoldr myWords' $ l 43 | where 44 | onlyWord s = 45 | let (w,p) = T.span isAlpha s in 46 | case (T.null w,T.null p) of 47 | (True,True) -> [] 48 | (False,True) -> [w] 49 | (True,False) -> [p] 50 | (False,False) -> [w,p] 51 | 52 | addHyphens :: H.HyphenationDatabase -> T.Text -> T.Text 53 | addHyphens db f = T.concat . map (T.concat . intersperse (T.pack "/-") . H.hyphenate db) . myWords $ f 54 | 55 | 56 | mapToSpecialGlyphs :: WritingSystem -> T.Text -> [SpecialChar] 57 | mapToSpecialGlyphs UnknownWritingSystem theText = 58 | let getBreakingGlyphs (' ':l) = NormalSpace:getBreakingGlyphs l 59 | getBreakingGlyphs (a:l) = NormalChar a:getBreakingGlyphs l 60 | getBreakingGlyphs [] = [] 61 | in getBreakingGlyphs (T.unpack theText) 62 | mapToSpecialGlyphs (Latin OtherLanguage) theText = 63 | let getBreakingGlyphs (' ':l) = NormalSpace:getBreakingGlyphs l 64 | getBreakingGlyphs (a:l) = NormalChar a:getBreakingGlyphs l 65 | getBreakingGlyphs [] = [] 66 | in getBreakingGlyphs (T.unpack theText) 67 | mapToSpecialGlyphs (Latin English) theText = 68 | let getBreakingGlyphs [] = [] 69 | getBreakingGlyphs (a:'/':'-':d:l) = (NormalChar a):BreakingHyphen:getBreakingGlyphs (d:l) 70 | getBreakingGlyphs (',':' ':l) = NormalChar ',':BiggerSpace:getBreakingGlyphs l 71 | getBreakingGlyphs (';':' ':l) = NormalChar ';':BiggerSpace:getBreakingGlyphs l 72 | getBreakingGlyphs ('.':' ':l) = NormalChar '.':BiggerSpace:getBreakingGlyphs l 73 | getBreakingGlyphs (':':' ':l) = NormalChar ':':BiggerSpace:getBreakingGlyphs l 74 | getBreakingGlyphs ('!':' ':l) = NormalChar '!':BiggerSpace:getBreakingGlyphs l 75 | getBreakingGlyphs ('?':' ':l) = NormalChar '?':BiggerSpace:getBreakingGlyphs l 76 | getBreakingGlyphs (' ':l) = NormalSpace:getBreakingGlyphs l 77 | getBreakingGlyphs (a:l) = NormalChar a:getBreakingGlyphs l 78 | in getBreakingGlyphs (T.unpack . addHyphens (H.English Nothing) $ theText) 79 | -------------------------------------------------------------------------------- /HPDF.cabal: -------------------------------------------------------------------------------- 1 | Name: HPDF 2 | Version: 1.5.0 3 | cabal-version: >=1.10 4 | License: BSD3 5 | License-file:LICENSE 6 | Copyright: Copyright (c) 2007-2016, alpheccar.org 7 | category: Graphics 8 | synopsis: Generation of PDF documents 9 | maintainer: misc@NOSPAMalpheccar.org 10 | build-type: Simple 11 | tested-with: GHC==7.10.2 12 | homepage: http://www.alpheccar.org 13 | description: A PDF library with support for several pages, page transitions, outlines, annotations, compression, colors, shapes, patterns, jpegs, fonts, typesetting ... Have a look at the "Graphics.PDF.Documentation" module to see how to use it. Or, download the package and look at the test.hs file in the Test folder. That file is giving an example of each feature. 14 | extra-source-files: 15 | c/conversion.h 16 | Test/logo.jpg 17 | Test/Makefile 18 | Test/Penrose.hs 19 | Test/test.hs 20 | README.txt 21 | NEWS.txt 22 | TODO.txt 23 | changelog 24 | data-files: 25 | Core14_AFMs/Courier-Bold.afm 26 | Core14_AFMs/Helvetica-BoldOblique.afm 27 | Core14_AFMs/Times-Bold.afm 28 | Core14_AFMs/Courier-BoldOblique.afm 29 | Core14_AFMs/Helvetica-Oblique.afm 30 | Core14_AFMs/Times-BoldItalic.afm 31 | Core14_AFMs/Courier-Oblique.afm 32 | Core14_AFMs/Helvetica.afm 33 | Core14_AFMs/Times-Italic.afm 34 | Core14_AFMs/Courier.afm 35 | Core14_AFMs/MustRead.html 36 | Core14_AFMs/Times-Roman.afm 37 | Core14_AFMs/Helvetica-Bold.afm 38 | Core14_AFMs/Symbol.afm 39 | Core14_AFMs/ZapfDingbats.afm 40 | Encodings/glyphlist.txt 41 | Encodings/zapfdingbats.txt 42 | Encodings/pdfencodings.txt 43 | Test/logo.jpg 44 | 45 | source-repository head 46 | type: git 47 | location: https://github.com/alpheccar/HPDF.git 48 | 49 | Test-Suite HPDF-Tests 50 | Type: exitcode-stdio-1.0 51 | Main-is: HPDF-tests.hs 52 | hs-source-dirs: Test 53 | Build-depends: base >= 4, 54 | HTF >= 0.10, 55 | HPDF 56 | Default-language: Haskell2010 57 | 58 | Executable HPDF-Demo 59 | Main-is: test.hs 60 | hs-source-dirs: Test 61 | Build-depends: base >= 4, 62 | HPDF, 63 | random >= 1.0, 64 | text >= 1.2.0, 65 | network-uri >= 2.6.0.3, 66 | vector >=0.10, 67 | filepath >= 1.4.0 68 | 69 | Default-language: Haskell2010 70 | Other-Modules: 71 | Paths_HPDF 72 | Penrose 73 | 74 | library 75 | build-depends: 76 | base >= 4 && < 5, 77 | containers, 78 | random >= 1.0, 79 | bytestring >= 0.9, 80 | array >= 0.1, 81 | zlib >= 0.5, 82 | binary >= 0.4, 83 | mtl, 84 | vector >=0.10, 85 | errors, 86 | base64-bytestring >= 0.1, 87 | text >= 1.2.0, 88 | network-uri >= 2.6.0.3, 89 | parsec >=3.1.9, 90 | filepath >= 1.4.0 91 | Default-language: Haskell2010 92 | 93 | ghc-options: -Wall -fno-warn-tabs -funbox-strict-fields -O2 94 | 95 | C-Sources: 96 | c/conversion.c 97 | Include-Dirs: c 98 | Install-Includes: 99 | conversion.h 100 | exposed-Modules: 101 | Graphics.PDF 102 | Graphics.PDF.Colors 103 | Graphics.PDF.Coordinates 104 | Graphics.PDF.Document 105 | Graphics.PDF.Shapes 106 | Graphics.PDF.Text 107 | Graphics.PDF.Fonts.Font 108 | Graphics.PDF.Fonts.StandardFont 109 | Graphics.PDF.Fonts.Type1 110 | Graphics.PDF.Typesetting.WritingSystem 111 | Graphics.PDF.Navigation 112 | Graphics.PDF.Image 113 | Graphics.PDF.Action 114 | Graphics.PDF.Annotation 115 | Graphics.PDF.Pattern 116 | Graphics.PDF.Shading 117 | Graphics.PDF.Typesetting 118 | Graphics.PDF.Hyphenate 119 | Graphics.PDF.Documentation 120 | Paths_HPDF 121 | Other-Modules: 122 | Graphics.PDF.LowLevel.Types 123 | Graphics.PDF.Fonts.FontTypes 124 | Graphics.PDF.Data.PDFTree 125 | Graphics.PDF.Data.Trie 126 | Graphics.PDF.Pages 127 | Graphics.PDF.Resources 128 | Graphics.PDF.Draw 129 | Graphics.PDF.Hyphenate.English 130 | Graphics.PDF.Hyphenate.LowLevel 131 | Graphics.PDF.Typesetting.Breaking 132 | Graphics.PDF.Typesetting.Horizontal 133 | Graphics.PDF.Typesetting.Vertical 134 | Graphics.PDF.Typesetting.Box 135 | Graphics.PDF.Typesetting.Layout 136 | Graphics.PDF.LowLevel.Serializer 137 | Graphics.PDF.Typesetting.StandardStyle 138 | Graphics.PDF.Fonts.AFMParser 139 | Graphics.PDF.Fonts.Encoding 140 | 141 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | * Copyright (c) 2006-2016, alpheccar.org 2 | * All rights reserved. 3 | * Redistribution and use in source and binary forms, with or without 4 | * modification, are permitted provided that the following conditions are met: 5 | * 6 | * * Redistributions of source code must retain the above copyright 7 | * notice, this list of conditions and the following disclaimer. 8 | * * Redistributions in binary form must reproduce the above copyright 9 | * notice, this list of conditions and the following disclaimer in the 10 | * documentation and/or other materials provided with the distribution. 11 | * * Neither the name of alpheccar.org nor the 12 | * names of its contributors may be used to endorse or promote products 13 | * derived from this software without specific prior written permission. 14 | * 15 | * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY 16 | * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | * DISCLAIMED. IN NO EVENT SHALL THE REGENTS AND CONTRIBUTORS BE LIABLE FOR ANY 19 | * DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 20 | * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 21 | * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 22 | * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 24 | * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | * 26 | * Files not covered by the above license are covered by their respective licences: 27 | * 28 | * PDFTree.hs reusing the code from IntMap : Copyright Daan Leijen. See the comments in the file. 29 | * 30 | * For hyphenation see files in Graphics/PDF/Hyphenate 31 | * 32 | * Extra patterns, from ushyphmax.tex, dated 2005-05-30. 33 | * -- Copyright (C) 1990, 2004, 2005 Gerard D.C. Kuiken. 34 | * 35 | * For the license for the included AFM Files, see the MustRead.html file in folder Core14_AFMs 36 | * 37 | * For the license for the unicode to Adobe encodings, see the headers in each files of the folder Encoding. 38 | * -------------------------------------------------------------------------------- /NEWS.txt: -------------------------------------------------------------------------------- 1 | 2 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![Build Status](https://travis-ci.org/alpheccar/HPDF.svg?branch=master)](https://travis-ci.org/alpheccar/HPDF) 2 | [![Hackage](https://img.shields.io/hackage/v/HPDF.svg)](https://hackage.haskell.org/package/HPDF) 3 | 4 | HPDF 5 | ==== 6 | 7 | A PDF library with support for several pages, page transitions, outlines, annotations, compression, colors, shapes, patterns, jpegs, fonts, typesetting ... 8 | 9 | Have a look at the "Graphics.PDF.Documentation" module to see how to use it. 10 | 11 | Or, download the package and look at the test.hs file in the Test folder. That file is giving an example of each feature. 12 | 13 | Documentation 14 | ------------- 15 | 16 | The library documentation can be accessed on [Hackage](https://hackage.haskell.org/package/HPDF) 17 | 18 | 19 | TO TEST THE LIBRARY 20 | ===================== 21 | cd Test 22 | make demo : to build a demo pdf 23 | ./test : to run the demo -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | import Distribution.Simple( defaultMain ) 3 | main = defaultMain -------------------------------------------------------------------------------- /TODO.txt: -------------------------------------------------------------------------------- 1 | The MAIN missing feature is the support for unicode and the bidirectionnal layout algorithm that will then be required. 2 | -------------------------------------------------------------------------------- /Test/HPDF-tests.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF htfpp #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | module Main where 4 | 5 | import Test.Framework 6 | import Data.Either (isRight) 7 | 8 | import Graphics.PDF.Image(JpegFile, readJpegDataURL, jpegBounds) 9 | 10 | main = htfMain htf_thisModulesTests 11 | 12 | raw_jpeg :: String 13 | raw_jpeg = "data:image/jpeg;base64,/9j/4AAQSkZJRgABAQEAYABgAAD/4RDcRXhpZgAATU0AKgAAAAgABAE7AAIAAAAGAAAISodpAAQAAAABAAAIUJydAAEAAAAMAAAQyOocAAcAAAgMAAAAPgAAAAAc6gAAAAgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFNjb3R0AAAFkAMAAgAAABQAABCekAQAAgAAABQAABCykpEAAgAAAAMwNwAAkpIAAgAAAAMwNwAA6hwABwAACAwAAAiSAAAAABzqAAAACAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMjAxNDoxMjowNiAwOTo0Mzo1MQAyMDE0OjEyOjA2IDA5OjQzOjUxAAAAUwBjAG8AdAB0AAAA/+ELGGh0dHA6Ly9ucy5hZG9iZS5jb20veGFwLzEuMC8APD94cGFja2V0IGJlZ2luPSfvu78nIGlkPSdXNU0wTXBDZWhpSHpyZVN6TlRjemtjOWQnPz4NCjx4OnhtcG1ldGEgeG1sbnM6eD0iYWRvYmU6bnM6bWV0YS8iPjxyZGY6UkRGIHhtbG5zOnJkZj0iaHR0cDovL3d3dy53My5vcmcvMTk5OS8wMi8yMi1yZGYtc3ludGF4LW5zIyI+PHJkZjpEZXNjcmlwdGlvbiByZGY6YWJvdXQ9InV1aWQ6ZmFmNWJkZDUtYmEzZC0xMWRhLWFkMzEtZDMzZDc1MTgyZjFiIiB4bWxuczpkYz0iaHR0cDovL3B1cmwub3JnL2RjL2VsZW1lbnRzLzEuMS8iLz48cmRmOkRlc2NyaXB0aW9uIHJkZjphYm91dD0idXVpZDpmYWY1YmRkNS1iYTNkLTExZGEtYWQzMS1kMzNkNzUxODJmMWIiIHhtbG5zOnhtcD0iaHR0cDovL25zLmFkb2JlLmNvbS94YXAvMS4wLyI+PHhtcDpDcmVhdGVEYXRlPjIwMTQtMTItMDZUMDk6NDM6NTEuMDcyPC94bXA6Q3JlYXRlRGF0ZT48L3JkZjpEZXNjcmlwdGlvbj48cmRmOkRlc2NyaXB0aW9uIHJkZjphYm91dD0idXVpZDpmYWY1YmRkNS1iYTNkLTExZGEtYWQzMS1kMzNkNzUxODJmMWIiIHhtbG5zOmRjPSJodHRwOi8vcHVybC5vcmcvZGMvZWxlbWVudHMvMS4xLyI+PGRjOmNyZWF0b3I+PHJkZjpTZXEgeG1sbnM6cmRmPSJodHRwOi8vd3d3LnczLm9yZy8xOTk5LzAyLzIyLXJkZi1zeW50YXgtbnMjIj48cmRmOmxpPlNjb3R0PC9yZGY6bGk+PC9yZGY6U2VxPg0KCQkJPC9kYzpjcmVhdG9yPjwvcmRmOkRlc2NyaXB0aW9uPjwvcmRmOlJERj48L3g6eG1wbWV0YT4NCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgPD94cGFja2V0IGVuZD0ndyc/Pv/bAEMABwUFBgUEBwYFBggHBwgKEQsKCQkKFQ8QDBEYFRoZGBUYFxseJyEbHSUdFxgiLiIlKCkrLCsaIC8zLyoyJyorKv/bAEMBBwgICgkKFAsLFCocGBwqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKv/AABEIABMAEwMBIgACEQEDEQH/xAAfAAABBQEBAQEBAQAAAAAAAAAAAQIDBAUGBwgJCgv/xAC1EAACAQMDAgQDBQUEBAAAAX0BAgMABBEFEiExQQYTUWEHInEUMoGRoQgjQrHBFVLR8CQzYnKCCQoWFxgZGiUmJygpKjQ1Njc4OTpDREVGR0hJSlNUVVZXWFlaY2RlZmdoaWpzdHV2d3h5eoOEhYaHiImKkpOUlZaXmJmaoqOkpaanqKmqsrO0tba3uLm6wsPExcbHyMnK0tPU1dbX2Nna4eLj5OXm5+jp6vHy8/T19vf4+fr/xAAfAQADAQEBAQEBAQEBAAAAAAAAAQIDBAUGBwgJCgv/xAC1EQACAQIEBAMEBwUEBAABAncAAQIDEQQFITEGEkFRB2FxEyIygQgUQpGhscEJIzNS8BVictEKFiQ04SXxFxgZGiYnKCkqNTY3ODk6Q0RFRkdISUpTVFVWV1hZWmNkZWZnaGlqc3R1dnd4eXqCg4SFhoeIiYqSk5SVlpeYmZqio6Slpqeoqaqys7S1tre4ubrCw8TFxsfIycrS09TV1tfY2dri4+Tl5ufo6ery8/T19vf4+fr/2gAMAwEAAhEDEQA/APoH+3tJOvf2INRtjqnlecbMSDzAn97b1xXB/Er4rN4ev4fC3g62Gr+Lb0hIbZBuW2z/ABSe+OcenJwOvi3xBk8W+G/2l9SufCVrO+qaioWzxCX8xXhVSy54O0g89AV56V7d8J/hVD4FspNT1iX+0PE2oAveXrtvKZOSik84z1PVj+ApRXPFSe3X/L/Njk+WTS36f5v9Ed7pS3q6PZrqzRvfiBBctEPlMm0biPbOaKtUVTd3clKysIVBYMQMjocdKWiikMKKKKAP/9k=" 14 | raw_jpeg_bounds :: (Int, Int) 15 | raw_jpeg_bounds = (19, 19) 16 | 17 | jpg :: JpegFile 18 | jpg = jpegFile 19 | where Right jpegFile = readJpegDataURL raw_jpeg 20 | 21 | test_decodeTick :: IO() 22 | test_decodeTick = case (readJpegDataURL raw_jpeg) of 23 | Right _ -> assertBool True 24 | Left msg -> assertEqual "Error:" msg 25 | 26 | test_bounds :: IO() 27 | test_bounds = assertEqual raw_jpeg_bounds (jpegBounds jpg) 28 | -------------------------------------------------------------------------------- /Test/Makefile: -------------------------------------------------------------------------------- 1 | debug: 2 | ghc -o test -DDEBUG -O -package-db ../dist/package.conf.inplace --make test.hs 3 | 4 | onepage: 5 | ghc -o test -DDEBUG -O -package-db ../dist/package.conf.inplace --make onepage.hs 6 | 7 | profile: 8 | ghc -o test -DDEBUG -prof -fprof-auto -rtsopts -O -package-db ../dist/package.conf.inplace --make test.hs 9 | 10 | runprof: 11 | ./test +RTS -p -hy 12 | 13 | demo: 14 | ghc -o test -O2 --make test.hs 15 | 16 | clean: 17 | rm -f test 18 | rm -f *.o 19 | rm -f *.hi 20 | rm -f *.exe 21 | rm -f test.prof 22 | rm -f demo.pdf 23 | 24 | -------------------------------------------------------------------------------- /Test/Penrose.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Penrose ( 3 | penrose 4 | )where 5 | 6 | import Graphics.PDF 7 | 8 | golden :: PDFFloat 9 | golden = ((sqrt 5) + 1) / 2 10 | 11 | phi :: PDFFloat 12 | phi = 36 / 180 * pi 13 | 14 | width :: PDFFloat 15 | width = 300 16 | 17 | myBlue :: Color 18 | myBlue = Rgb 0.8 0.8 1 19 | 20 | myGreen :: Color 21 | myGreen = Rgb 0.8 1 0.8 22 | 23 | data Tile = A | B | A' | B' 24 | 25 | tilea :: PDFFloat -> Tile -> Int -> Draw () 26 | tilea angle k n = withNewContext $ do 27 | applyMatrix (translate (width :+ 0)) 28 | applyMatrix (rotate . Degree $ angle) 29 | applyMatrix (scale (1/golden) (1/golden)) 30 | divide (n-1) k 31 | 32 | 33 | tileb :: PDFFloat -> Tile -> Int -> Draw () 34 | tileb angle k n = withNewContext $ do 35 | applyMatrix (translate ((width*golden) :+ 0)) 36 | applyMatrix (rotate . Degree $ angle) 37 | applyMatrix (scale (1/golden) (1/golden)) 38 | divide (n-1) k 39 | 40 | 41 | divide :: Int -> Tile -> Draw () 42 | divide n A | n == 0 = a width 43 | | otherwise = do 44 | tilea 108 A n 45 | tilea 180 B' n 46 | 47 | divide n A' | n == 0 = a' width 48 | | otherwise = do 49 | tilea (-108) A' n 50 | tilea 180 B n 51 | 52 | divide n B | n == 0 = b width 53 | | otherwise = do 54 | tileb 144 B n 55 | tilea 108 A n 56 | tilea 180 B' n 57 | 58 | divide n B' | n == 0 = b' width 59 | | otherwise = do 60 | tileb (-144) B' n 61 | tilea (-108) A' n 62 | tilea 180 B n 63 | 64 | 65 | b :: PDFFloat -> Draw () 66 | b s = do 67 | setFillAlpha 0.8 68 | fillColor myBlue 69 | strokeColor myBlue 70 | let pol = [ 0 71 | , mkPolar s phi 72 | , ((s*golden) :+ 0) 73 | ] 74 | fillAndStroke (Polygon pol) 75 | strokeColor black 76 | stroke (Polygon pol) 77 | 78 | 79 | b' :: PDFFloat -> Draw () 80 | b' s = withNewContext $ do 81 | applyMatrix (scale 1 (-1)) 82 | b s 83 | 84 | 85 | a :: PDFFloat -> Draw () 86 | a s = do 87 | setFillAlpha 0.8 88 | fillColor myGreen 89 | strokeColor myGreen 90 | let pol = [ 0 91 | , mkPolar s phi 92 | , (s :+ 0) 93 | ] 94 | fillAndStroke (Polygon pol) 95 | strokeColor black 96 | stroke (Polygon pol) 97 | 98 | a' :: PDFFloat -> Draw () 99 | a' s = withNewContext $ do 100 | applyMatrix (scale 1 (-1)) 101 | a s 102 | 103 | penrose :: PDF () 104 | penrose = do 105 | page <- addPage (Just (PDFRect 0 0 (1.5*width) width)) 106 | newSection "Penrose" Nothing Nothing $ do 107 | drawWithPage page $ do 108 | applyMatrix (translate (20 :+ 5)) 109 | applyMatrix (rotate . Degree $ 36) 110 | let r = 4 111 | divide r B 112 | divide r B' 113 | 114 | 115 | -------------------------------------------------------------------------------- /Test/logo.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/alpheccar/HPDF/5a901376470b549b2354cdd8013e655f7ac19e0b/Test/logo.jpg -------------------------------------------------------------------------------- /Test/onepage.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables, MultiParamTypeClasses,OverloadedStrings #-} 2 | --------------------------------------------------------- 3 | -- | 4 | -- Copyright : (c) 2006-2013, alpheccar.org 5 | -- License : BSD-style 6 | -- 7 | -- Maintainer : misc@NOSPAMalpheccar.org 8 | -- Stability : experimental 9 | -- Portability : portable 10 | -- 11 | -- Test 12 | --------------------------------------------------------- 13 | 14 | 15 | module Main where 16 | 17 | 18 | import Graphics.PDF 19 | import System.Random 20 | import qualified Data.Vector.Unboxed as U 21 | import qualified Data.Text as T 22 | import Network.URI 23 | import Data.Maybe(fromJust) 24 | import Control.Monad.IO.Class 25 | 26 | import Debug.Trace 27 | 28 | alpheccarURL = fromJust $ parseURI "http://www.alpheccar.org" 29 | 30 | vertical = 200.0 31 | margin = 10.0 32 | debugText = "Встретились)" 33 | debugFontSize = 12 34 | lightBlue= Rgb 0.6 0.6 1.0 35 | 36 | testFont="/usr/local/texlive/2015/texmf-dist/fonts/type1/public/droid/DroidSans.pfb" 37 | afm="/usr/local/texlive/2015/texmf-dist/fonts/afm/public/droid/DroidSans.afm" 38 | 39 | data MyParaStyles = DebugStyle AnyFont 40 | data MyVertStyles = NormalPara 41 | 42 | 43 | instance ComparableStyle MyParaStyles where 44 | isSameStyleAs (DebugStyle fa) (DebugStyle fb) = fa == fb 45 | 46 | instance Style MyParaStyles where 47 | textStyle (DebugStyle f) = TextStyle (PDFFont f debugFontSize) black black FillText 1.0 1.0 1.0 1.0 48 | 49 | sentenceStyle _ = Nothing 50 | 51 | wordStyle (DebugStyle _) = Just $ \r m d -> 52 | case m of 53 | DrawWord -> d >> setWidth 0.5 >> strokeColor red >> stroke r 54 | DrawGlue -> d >> setWidth 0.5 >> fillColor lightBlue >> fill r 55 | 56 | updateStyle a = a 57 | 58 | instance ComparableStyle MyVertStyles where 59 | isSameStyleAs NormalPara NormalPara = True 60 | 61 | instance ParagraphStyle MyVertStyles MyParaStyles where 62 | 63 | 64 | testAll :: PDFFont -> PDF () 65 | testAll theFont@(PDFFont f s) = do 66 | page1 <- addPage Nothing 67 | drawWithPage page1 $ do 68 | displayFormattedText (Rectangle (10 :+ 0) ((10+100) :+ 300)) (NormalPara) (DebugStyle f) $ 69 | paragraph $ do 70 | txt $ debugText 71 | strokeColor black 72 | drawText $ do 73 | setFont theFont 74 | textStart margin vertical 75 | displayText debugText 76 | setWidth 0.5 77 | stroke $ Rectangle (margin :+ (vertical - (getDescent f s))) ((margin + textWidth theFont debugText) :+ (vertical - getDescent f s + getHeight f s)) 78 | 79 | 80 | main :: IO() 81 | main = do 82 | fontData <- readType1Font testFont afm 83 | Just timesRoman <- mkStdFont Times_Roman 84 | let rect = PDFRect 0 0 600 400 85 | runPdf "demo.pdf" (standardDocInfo { author= "alpheccar éèçàü", compressed = False}) rect $ do 86 | testFont <- mkType1Font fontData 87 | testAll (PDFFont testFont debugFontSize) 88 | traceM . show $ (spaceGlyph testFont) 89 | traceM . show $ 1000 * (glyphWidth testFont debugFontSize $ spaceGlyph testFont) / fromIntegral debugFontSize 90 | -------------------------------------------------------------------------------- /c/conversion.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include "conversion.h" 5 | 6 | 7 | short c_floatToString(double f,char* s) 8 | { 9 | sprintf(s,"%.5f",f); 10 | return(strlen(s)); 11 | } 12 | 13 | short c_shortToString(short d,char* s) 14 | { 15 | sprintf(s,"%d",d); 16 | return(strlen(s)); 17 | } -------------------------------------------------------------------------------- /c/conversion.h: -------------------------------------------------------------------------------- 1 | #ifndef _CONVERSION_H_ 2 | #define _CONVERSION_H_ 3 | extern short c_floatToString(double f,char* s); 4 | extern short c_shortToString(short d,char* s); 5 | #endif 6 | -------------------------------------------------------------------------------- /changelog: -------------------------------------------------------------------------------- 1 | 2 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md 2 | 3 | # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) 4 | resolver: lts-6.14 5 | 6 | # Local packages, usually specified by relative directory name 7 | packages: 8 | - '.' 9 | 10 | # Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3) 11 | extra-deps: [] 12 | 13 | # Override default flag values for local packages and extra-deps 14 | flags: {} 15 | 16 | # Extra package databases containing global packages 17 | extra-package-dbs: [] 18 | 19 | # Control whether we use the GHC we find on the path 20 | # system-ghc: true 21 | 22 | # Require a specific version of stack, using version ranges 23 | # require-stack-version: -any # Default 24 | # require-stack-version: >= 1.0.0 25 | 26 | # Override the architecture used by stack, especially useful on Windows 27 | # arch: i386 28 | # arch: x86_64 29 | 30 | # Extra directories used by stack for building 31 | # extra-include-dirs: [/path/to/dir] 32 | # extra-lib-dirs: [/path/to/dir] 33 | --------------------------------------------------------------------------------