lib/PDFJ.pm

   1 # PDFJ.pm
   2 # PDF for Japanese
   3 # 2001-2 Sey <nakajima@netstock.co.jp>
   4 package PDFJ;
   5 use PDFJ::Object;
   6 use PDFJ::Unicode;
   7 use PDFJ::E2U;
   8 use Carp;
   9 use strict;
  10 use vars qw($VERSION @EXFUNC %Default);
  11
  12 $VERSION = 0.7;
  13
  14 @EXFUNC = qw(
  15         PDFJ::TextStyle::TStyle PDFJ::Text::Text
  16         PDFJ::NewLine::NewLine PDFJ::Outline::Outline PDFJ::Dest::Dest
  17         PDFJ::ParagraphStyle::PStyle PDFJ::Paragraph::Paragraph
  18         PDFJ::BlockStyle::BStyle PDFJ::Block::Block PDFJ::NewBlock::NewBlock
  19         PDFJ::Shape::Shape
  20         PDFJ::ShapeStyle::SStyle PDFJ::Color::Color
  21 );
  22
  23 sub import {
  24         my($pkg, $code, $prefix) = @_;
  25         if( $code ) {
  26                 croak "code argument '$code' must be 'SJIS' or 'EUC'"
  27                         unless $code =~ /^(SJIS|EUC)$/;
  28                 $Default{Jcode} = $code;
  29         }
  30         $prefix ||= "";
  31         for my $name(@EXFUNC) {
  32                 my $to = caller;
  33                 my $from = "";
  34                 ($from, $name) = $name =~ /^(.+)::([^:]+)$/;
  35                 no strict 'refs';
  36                 *{"${to}::$prefix$name"} = \&{"${from}::$name"};
  37         }
  38 }
  39
  40 $Default{Jcode} = 'SJIS';
  41
  42 $Default{AFontEncoding} = 'WinAnsiEncoding';
  43 $Default{BaseAFont} = 'Times-Roman';
  44 $Default{JFontEncoding} = '90ms-RKSJ-H';
  45 $Default{BaseJFont} = 'Ryumin-Light';
  46
  47 # $Default{BBox} = [-200,-331,1116,962];
  48 $Default{BBox} = [-150,-331,1143,962];
  49
  50 $Default{SBoxH} = [0,-125,1000,875];
  51 $Default{SBoxV} = [-500,-1000,500,0];
  52
  53 $Default{ULine} = -200;
  54 $Default{OLine} = 900;
  55 $Default{LLine} = -550;
  56 $Default{RLine} = 550;
  57
  58 $Default{ORuby} = 950;
  59 $Default{RRuby} = 750;
  60
  61 $Default{HBaseShift} = 0.125;
  62 $Default{HBaseHeight} = 0.875;
  63
  64 $Default{ParaPreSkipRatio} = 0.5;
  65 $Default{ParaPostSkipRatio} = 0.5;
  66
  67 $Default{SlantRatio} = 0.2;
  68
  69 $Default{HDotXShift} = 0;
  70 $Default{HDotYShift} = 0.7;
  71 $Default{HDot}{SJIS} = "\x81\x45";
  72 $Default{HDot}{EUC} = "\xa1\xa6";
  73
  74 $Default{VDotXShift} = 0.5;
  75 $Default{VDotYShift} = -0.3;
  76 $Default{VDot}{SJIS} = "\x81\x41";
  77 $Default{VDot}{EUC} = "\xa1\xa2";
  78
  79 $Default{VHShift} = 0.8;
  80 $Default{VAShift} = -0.33;
  81
  82 $Default{SuffixSize} = 0.6;
  83 $Default{USuffixRise} = 0.5;
  84 $Default{LSuffixRise} = -0.15;
  85
  86 $Default{HNote} = 990;
  87 $Default{VNote} = 750;
  88
  89 $Default{Fonts} = {qw(
  90         Courier               a
  91         Courier-Bold          a
  92         Courier-BoldOblique   a
  93         Courier-Oblique       a
  94         Helvetica             a
  95         Helvetica-Bold        a
  96         Helvetica-BoldOblique a
  97         Helvetica-Oblique     a
  98         Times-Bold            a
  99         Times-BoldItalic      a
 100         Times-Italic          a
 101         Times-Roman           a
 102         Ryumin-Light          j
 103         GothicBBB-Medium      j
 104 )};
 105
 106 $Default{Encodings} = {qw(
 107         WinAnsiEncoding       a
 108         MacRomanEncoding      a
 109         83pv-RKSJ-H           js
 110         90pv-RKSJ-H           js
 111         90ms-RKSJ-H           js
 112         90ms-RKSJ-V           js
 113         Add-RKSJ-H            js
 114         Add-RKSJ-V            js
 115         Ext-RKSJ-H            js
 116         Ext-RKSJ-V            js
 117         EUC-H                 je
 118         EUC-V                 je
 119 )};
 120
 121 $Default{JFD}{'Ryumin-Light'} =
 122         dictionary({
 123                 Type => name('FontDescriptor'),
 124                 Ascent => 723,
 125                 CapHeight => 709,
 126                 Descent => -241,
 127                 Flags => 6,
 128                 FontBBox => [-170,-331,1024,903],
 129                 FontName => name('Ryumin-Light'),
 130                 ItalicAngle => 0,
 131                 StemV => 69,
 132                 XHeight => 450,
 133                 Style => {
 134                         Panose => string(
 135                                 value => '010502020300000000000000',
 136                                 outputtype => 'hexliteral')
 137                 },
 138         });
 139
 140 $Default{JFD}{'GothicBBB-Medium'} =
 141         dictionary({
 142                 Type => name('FontDescriptor'),
 143                 Ascent => 752,
 144                 CapHeight => 737,
 145                 Descent => -271,
 146                 Flags => 4,
 147                 FontBBox => [-174,-268,1001,944],
 148                 FontName => name('GothicBBB-Medium'),
 149                 ItalicAngle => 0,
 150                 StemV => 99,
 151                 XHeight => 553,
 152                 Style => {
 153                         Panose => string(
 154                                 value => '0801020b0500000000000000',
 155                                 outputtype => 'hexliteral')
 156                 }
 157         });
 158
 159 # character class (based on JIS X 4051)
 160 # 0: begin paren
 161 # 1: end paren
 162 # 2: not at top of line
 163 # 3: ?!
 164 # 4: dot
 165 # 5: punc
 166 # 6: leader
 167 # 7: pre unit
 168 # 8: post unit
 169 # 9: zenkaku space
 170 # 10: hirakana
 171 # 11: japanese
 172 # 12: suffixed
 173 # 13: rubied
 174 # 14: number
 175 # 15: unit
 176 # 16: space
 177 # 17: ascii
 178 $Default{Class}{SJIS} = {
 179         # begin paren
 180         "\x81\x65" => 0, "\x81\x67" => 0, "\x81\x69" => 0, "\x81\x6b" => 0,
 181         "\x81\x6d" => 0, "\x81\x6f" => 0, "\x81\x71" => 0, "\x81\x73" => 0,
 182         "\x81\x75" => 0, "\x81\x77" => 0, "\x81\x79" => 0,
 183         # end paren
 184         "\x81\x41" => 1, "\x81\x43" => 1,
 185         "\x81\x66" => 1, "\x81\x68" => 1, "\x81\x6a" => 1, "\x81\x6c" => 1,
 186         "\x81\x6e" => 1, "\x81\x70" => 1, "\x81\x72" => 1, "\x81\x74" => 1,
 187         "\x81\x76" => 1, "\x81\x78" => 1, "\x81\x7a" => 1,
 188         # not at top of line
 189         "\x81\x52" => 2, "\x81\x53" => 2, "\x81\x54" => 2, "\x81\x55" => 2,
 190         "\x81\x58" => 2, "\x81\x5b" => 2,
 191         "\x82\x9f" => 2, "\x82\xa1" => 2, "\x82\xa3" => 2, "\x82\xa5" => 2,
 192         "\x82\xa7" => 2, "\x82\xc1" => 2, "\x82\xe1" => 2, "\x82\xe3" => 2,
 193         "\x82\xe5" => 2, "\x82\xec" => 2,
 194         "\x83\x40" => 2, "\x83\x42" => 2, "\x83\x44" => 2, "\x83\x46" => 2,
 195         "\x83\x48" => 2, "\x83\x62" => 2, "\x83\x83" => 2, "\x83\x85" => 2,
 196         "\x83\x87" => 2, "\x83\x8e" => 2, "\x83\x95" => 2, "\x83\x96" => 2,
 197         # ?!
 198         "\x81\x48" => 3, "\x81\x49" => 3,
 199         # dot
 200         "\x81\x45" => 4, "\x81\x46" => 4, "\x81\x47" => 4,
 201         # punc
 202         "\x81\x42" => 5, "\x81\x44" => 5,
 203         # leader
 204         "\x81\x5c" => 6, "\x81\x63" => 6, "\x81\x64" => 6,
 205         # pre unit
 206         "\x81\x8f" => 7, "\x81\x90" => 7, "\x81\x92" => 7,
 207         # post unit
 208         "\x81\x8b" => 8, "\x81\x8c" => 8, "\x81\x8d" => 8,
 209         "\x81\x91" => 8, "\x81\x93" => 8, "\x81\xf1" => 8,
 210         # zenkaku space
 211         "\x81\x40" => 9,
 212 };
 213
 214 $Default{PreShift}{SJIS} = {
 215         # begin paren
 216         "\x81\x65" => 500, "\x81\x67" => 500, "\x81\x69" => 500, "\x81\x6b" => 500,
 217         "\x81\x6d" => 500, "\x81\x6f" => 500, "\x81\x71" => 500, "\x81\x73" => 500,
 218         "\x81\x75" => 500, "\x81\x77" => 500, "\x81\x79" => 500,
 219         # dot
 220         "\x81\x45" => 250, "\x81\x46" => 250, "\x81\x47" => 250,
 221 };
 222
 223 $Default{PostShift}{SJIS} = {
 224         # end paren
 225         "\x81\x41" => 500, "\x81\x43" => 500,
 226         "\x81\x66" => 500, "\x81\x68" => 500, "\x81\x6a" => 500, "\x81\x6c" => 500,
 227         "\x81\x6e" => 500, "\x81\x70" => 500, "\x81\x72" => 500, "\x81\x74" => 500,
 228         "\x81\x76" => 500, "\x81\x78" => 500, "\x81\x7a" => 500,
 229         # dot
 230         "\x81\x45" => 250, "\x81\x46" => 250, "\x81\x47" => 250,
 231         # punc
 232         "\x81\x42" => 500, "\x81\x44" => 500,
 233         # post unit
 234         "\x81\x8b" => 500, "\x81\x8c" => 500, "\x81\x8d" => 500,
 235 };
 236
 237 $Default{Class}{EUC} = {
 238         # begin paren
 239         "\xa1\xc6" => 0, "\xa1\xc8" => 0, "\xa1\xca" => 0, "\xa1\xcc" => 0,
 240         "\xa1\xce" => 0, "\xa1\xd0" => 0, "\xa1\xd2" => 0, "\xa1\xd4" => 0,
 241         "\xa1\xd6" => 0, "\xa1\xd8" => 0, "\xa1\xda" => 0,
 242         # end paren
 243         "\xa1\xa2" => 1, "\xa1\xa4" => 1,
 244         "\xa1\xc7" => 1, "\xa1\xc9" => 1, "\xa1\xcb" => 1, "\xa1\xcd" => 1,
 245         "\xa1\xcf" => 1, "\xa1\xd1" => 1, "\xa1\xd3" => 1, "\xa1\xd5" => 1,
 246         "\xa1\xd7" => 1, "\xa1\xd9" => 1, "\xa1\xdb" => 1,
 247         # not at top of line
 248         "\xa1\xb3" => 2, "\xa1\xb4" => 2, "\xa1\xb5" => 2, "\xa1\xb6" => 2,
 249         "\xa1\xb9" => 2, "\xa1\xbc" => 2,
 250         "\xa4\xa1" => 2, "\xa4\xa3" => 2, "\xa4\xa5" => 2, "\xa4\xa7" => 2,
 251         "\xa4\xa9" => 2, "\xa4\xc3" => 2, "\xa4\xe3" => 2, "\xa4\xe5" => 2,
 252         "\xa4\xe7" => 2, "\xa4\xee" => 2,
 253         "\xa5\xa1" => 2, "\xa5\xa3" => 2, "\xa5\xa5" => 2, "\xa5\xa7" => 2,
 254         "\xa5\xa9" => 2, "\xa5\xc3" => 2, "\xa5\xe3" => 2, "\xa5\xe5" => 2,
 255         "\xa5\xe7" => 2, "\xa5\xee" => 2, "\xa5\xf5" => 2, "\xa5\xf6" => 2,
 256         # ?!
 257         "\xa1\xa9" => 3, "\xa1\xaa" => 3,
 258         # dot
 259         "\xa1\xa6" => 4, "\xa1\xa7" => 4, "\xa1\xa8" => 4,
 260         # punc
 261         "\xa1\xa3" => 5, "\xa1\xa5" => 5,
 262         # leader
 263         "\xa1\xbd" => 6, "\xa1\xc4" => 6, "\xa1\xc5" => 6,
 264         # pre unit
 265         "\xa1\xef" => 7, "\xa1\xf0" => 7, "\xa1\xf2" => 7,
 266         # post unit
 267         "\xa1\xeb" => 8, "\xa1\xec" => 8, "\xa1\xed" => 8, "\xa1\xf1" => 8,
 268         "\xa1\xf3" => 8, "\xa2\xf3" => 8,
 269         # zenkaku space
 270         "\xa1\xa1" => 9,
 271 };
 272
 273 $Default{PreShift}{EUC} = {
 274         # begin paren
 275         "\xa1\xc6" => 500, "\xa1\xc8" => 500, "\xa1\xca" => 500, "\xa1\xcc" => 500,
 276         "\xa1\xce" => 500, "\xa1\xd0" => 500, "\xa1\xd2" => 500, "\xa1\xd4" => 500,
 277         "\xa1\xd6" => 500, "\xa1\xd8" => 500, "\xa1\xda" => 500,
 278         # dot
 279         "\xa1\xa6" => 250, "\xa1\xa7" => 250, "\xa1\xa8" => 250,
 280 };
 281
 282 $Default{PostShift}{EUC} = {
 283         # end paren
 284         "\xa1\xa2" => 500, "\xa1\xa4" => 500,
 285         "\xa1\xc7" => 500, "\xa1\xc9" => 500, "\xa1\xcb" => 500, "\xa1\xcd" => 500,
 286         "\xa1\xcf" => 500, "\xa1\xd1" => 500, "\xa1\xd3" => 500, "\xa1\xd5" => 500,
 287         "\xa1\xd7" => 500, "\xa1\xd9" => 500, "\xa1\xdb" => 500,
 288         # dot
 289         "\xa1\xa6" => 250, "\xa1\xa7" => 250, "\xa1\xa8" => 250,
 290         # punc
 291         "\xa1\xa3" => 500, "\xa1\xa5" => 500,
 292         # post unit
 293         "\xa1\xeb" => 500, "\xa1\xec" => 500, "\xa1\xed" => 500, "\xa1\xf1" => 500,
 294 };
 295
 296 # glue width
 297 # each element means [min, normal, max, preference]
 298 # ruby overlap feature is omitted
 299 sub GlueNon { [0, 0, 0] }
 300 sub Glue004 { [0, 0, 250] }
 301 sub Glue0443 { [0, 250, 250, 3] }
 302 sub Glue0223 { [0, 500, 500, 3] }
 303 sub Glue0222 { [0, 500, 500, 2] }
 304 sub Glue222 { [500, 500, 500] }
 305 sub Glue844 { [125, 250, 250] }
 306 sub Glue8421 { [125, 250, 500, 1] }
 307 sub Glue266 { [500, 750, 750] }
 308
 309 $Default{Glue} = [
 310         # 0: begin paren
 311         [
 312                 GlueNon,      # 0: begin paren
 313                 GlueNon,      # 1: end paren
 314                 GlueNon,      # 2: not at top of line
 315                 GlueNon,      # 3: ?!
 316                 Glue0443,      # 4: dot
 317                 GlueNon,      # 5: punc
 318                 GlueNon,      # 6: leader
 319                 GlueNon,      # 7: pre unit
 320                 GlueNon,      # 8: post unit
 321                 GlueNon,      # 9: zenkaku space
 322                 GlueNon,      # 10: hirakana
 323                 GlueNon,      # 11: japanese
 324                 GlueNon,      # 12: suffixed
 325                 GlueNon,      # 13: rubied
 326                 GlueNon,      # 14: number
 327                 GlueNon,      # 15: unit
 328                 Glue004,      # 16: space
 329                 GlueNon,      # 17: ascii
 330         ],
 331         # 1: end paren
 332         [
 333                 Glue0222,      # 0: begin paren
 334                 GlueNon,      # 1: end paren
 335                 Glue0222,      # 2: not at top of line
 336                 Glue0222,      # 3: ?!
 337                 Glue0443,      # 4: dot
 338                 GlueNon,      # 5: punc
 339                 Glue0222,      # 6: leader
 340                 Glue0222,      # 7: pre unit
 341                 Glue0222,      # 8: post unit
 342                 GlueNon,      # 9: zenkaku space
 343                 Glue0222,      # 10: hirakana
 344                 Glue0222,      # 11: japanese
 345                 Glue0222,      # 12: suffixed
 346                 Glue0222,      # 13: rubied
 347                 Glue0222,      # 14: number
 348                 Glue0222,      # 15: unit
 349                 Glue0222,      # 16: space
 350                 Glue0222,      # 17: ascii
 351         ],
 352         # 2: not at top of line
 353         [
 354                 Glue0222,      # 0: begin paren
 355                 GlueNon,      # 1: end paren
 356                 Glue004,      # 2: not at top of line
 357                 GlueNon,      # 3: ?!
 358                 Glue0443,      # 4: dot
 359                 GlueNon,      # 5: punc
 360                 Glue004,      # 6: leader
 361                 Glue004,      # 7: pre unit
 362                 Glue004,      # 8: post unit
 363                 GlueNon,      # 9: zenkaku space
 364                 Glue004,      # 10: hirakana
 365                 Glue004,      # 11: japanese
 366                 Glue8421,      # 12: suffixed
 367                 Glue004,      # 13: rubied
 368                 Glue8421,      # 14: number
 369                 Glue8421,      # 15: unit
 370                 Glue004,      # 16: space
 371                 Glue8421,      # 17: ascii
 372         ],
 373         # 3: ?!
 374         [
 375                 Glue0222,      # 0: begin paren
 376                 GlueNon,      # 1: end paren
 377                 GlueNon,      # 2: not at top of line
 378                 GlueNon,      # 3: ?!
 379                 Glue0443,      # 4: dot
 380                 GlueNon,      # 5: punc
 381                 GlueNon,      # 6: leader
 382                 GlueNon,      # 7: pre unit
 383                 GlueNon,      # 8: post unit
 384                 GlueNon,      # 9: zenkaku space
 385                 GlueNon,      # 10: hirakana
 386                 GlueNon,      # 11: japanese
 387                 Glue8421,      # 12: suffixed
 388                 GlueNon,      # 13: rubied
 389                 Glue8421,      # 14: number
 390                 Glue8421,      # 15: unit
 391                 Glue004,      # 16: space
 392                 Glue8421,      # 17: ascii
 393         ],
 394         # 4: dot
 395         [
 396                 Glue0443,      # 0: begin paren
 397                 Glue0443,      # 1: end paren
 398                 Glue0443,      # 2: not at top of line
 399                 Glue0443,      # 3: ?!
 400                 Glue0223,      # 4: dot
 401                 Glue0443,      # 5: punc
 402                 Glue0443,      # 6: leader
 403                 Glue0443,      # 7: pre unit
 404                 Glue0443,      # 8: post unit
 405                 Glue0443,      # 9: zenkaku space
 406                 Glue0443,      # 10: hirakana
 407                 Glue0443,      # 11: japanese
 408                 Glue0443,      # 12: suffixed
 409                 Glue0443,      # 13: rubied
 410                 Glue0443,      # 14: number
 411                 Glue0443,      # 15: unit
 412                 Glue0443,      # 16: space
 413                 Glue0443,      # 17: ascii
 414         ],
 415         # 5: punc
 416         [
 417                 Glue222,      # 0: begin paren
 418                 GlueNon,      # 1: end paren
 419                 Glue222,      # 2: not at top of line
 420                 Glue222,      # 3: ?!
 421                 Glue266,      # 4: dot
 422                 GlueNon,      # 5: punc
 423                 Glue222,      # 6: leader
 424                 Glue222,      # 7: pre unit
 425                 Glue222,      # 8: post unit
 426                 Glue222,      # 9: zenkaku space
 427                 Glue222,      # 10: hirakana
 428                 Glue222,      # 11: japanese
 429                 Glue222,      # 12: suffixed
 430                 Glue222,      # 13: rubied
 431                 Glue222,      # 14: number
 432                 Glue222,      # 15: unit
 433                 Glue222,      # 16: space
 434                 Glue222,      # 17: ascii
 435         ],
 436         # 6: leader
 437         [
 438                 Glue0222,      # 0: begin paren
 439                 GlueNon,      # 1: end paren
 440                 Glue004,      # 2: not at top of line
 441                 GlueNon,      # 3: ?!
 442                 Glue0443,      # 4: dot
 443                 GlueNon,      # 5: punc
 444                 GlueNon,      # 6: leader
 445                 Glue004,      # 7: pre unit
 446                 Glue004,      # 8: post unit
 447                 GlueNon,      # 9: zenkaku space
 448                 Glue004,      # 10: hirakana
 449                 Glue004,      # 11: japanese
 450                 Glue004,      # 12: suffixed
 451                 Glue004,      # 13: rubied
 452                 Glue004,      # 14: number
 453                 Glue004,      # 15: unit
 454                 Glue004,      # 16: space
 455                 Glue004,      # 17: ascii
 456         ],
 457         # 7: pre unit
 458         [
 459                 Glue0222,      # 0: begin paren
 460                 GlueNon,      # 1: end paren
 461                 Glue004,      # 2: not at top of line
 462                 GlueNon,      # 3: ?!
 463                 Glue0443,      # 4: dot
 464                 GlueNon,      # 5: punc
 465                 Glue004,      # 6: leader
 466                 Glue004,      # 7: pre unit
 467                 Glue004,      # 8: post unit
 468                 GlueNon,      # 9: zenkaku space
 469                 Glue004,      # 10: hirakana
 470                 Glue004,      # 11: japanese
 471                 Glue004,      # 12: suffixed
 472                 Glue004,      # 13: rubied
 473                 GlueNon,      # 14: number
 474                 Glue004,      # 15: unit
 475                 Glue004,      # 16: space
 476                 Glue004,      # 17: ascii
 477         ],
 478         # 8: post unit
 479         [
 480                 Glue0222,      # 0: begin paren
 481                 GlueNon,      # 1: end paren
 482                 Glue004,      # 2: not at top of line
 483                 GlueNon,      # 3: ?!
 484                 Glue0443,      # 4: dot
 485                 GlueNon,      # 5: punc
 486                 Glue004,      # 6: leader
 487                 Glue004,      # 7: pre unit
 488                 Glue004,      # 8: post unit
 489                 GlueNon,      # 9: zenkaku space
 490                 Glue004,      # 10: hirakana
 491                 Glue004,      # 11: japanese
 492                 Glue004,      # 12: suffixed
 493                 Glue004,      # 13: rubied
 494                 Glue004,      # 14: number
 495                 Glue004,      # 15: unit
 496                 Glue004,      # 16: space
 497                 Glue004,      # 17: ascii
 498         ],
 499         # 9: zenkaku space
 500         [
 501                 GlueNon,      # 0: begin paren
 502                 GlueNon,      # 1: end paren
 503                 GlueNon,      # 2: not at top of line
 504                 GlueNon,      # 3: ?!
 505                 Glue0443,      # 4: dot
 506                 GlueNon,      # 5: punc
 507                 GlueNon,      # 6: leader
 508                 GlueNon,      # 7: pre unit
 509                 GlueNon,      # 8: post unit
 510                 GlueNon,      # 9: zenkaku space
 511                 GlueNon,      # 10: hirakana
 512                 GlueNon,      # 11: japanese
 513                 GlueNon,      # 12: suffixed
 514                 GlueNon,      # 13: rubied
 515                 GlueNon,      # 14: number
 516                 GlueNon,      # 15: unit
 517                 Glue004,      # 16: space
 518                 GlueNon,      # 17: ascii
 519         ],
 520         # 10: hirakana
 521         [
 522                 Glue0222,      # 0: begin paren
 523                 GlueNon,      # 1: end paren
 524                 Glue004,      # 2: not at top of line
 525                 GlueNon,      # 3: ?!
 526                 Glue0443,      # 4: dot
 527                 GlueNon,      # 5: punc
 528                 Glue004,      # 6: leader
 529                 Glue004,      # 7: pre unit
 530                 Glue004,      # 8: post unit
 531                 GlueNon,      # 9: zenkaku space
 532                 Glue004,      # 10: hirakana
 533                 Glue004,      # 11: japanese
 534                 Glue8421,      # 12: suffixed
 535                 Glue004,      # 13: rubied
 536                 Glue8421,      # 14: number
 537                 Glue8421,      # 15: unit
 538                 Glue004,      # 16: space
 539                 Glue8421,      # 17: ascii
 540         ],
 541         # 11: japanese
 542         [
 543                 Glue0222,      # 0: begin paren
 544                 GlueNon,      # 1: end paren
 545                 Glue004,      # 2: not at top of line
 546                 GlueNon,      # 3: ?!
 547                 Glue0443,      # 4: dot
 548                 GlueNon,      # 5: punc
 549                 Glue004,      # 6: leader
 550                 Glue004,      # 7: pre unit
 551                 Glue004,      # 8: post unit
 552                 GlueNon,      # 9: zenkaku space
 553                 Glue004,      # 10: hirakana
 554                 Glue004,      # 11: japanese
 555                 Glue8421,      # 12: suffixed
 556                 Glue004,      # 13: rubied
 557                 Glue8421,      # 14: number
 558                 Glue8421,      # 15: unit
 559                 Glue004,      # 16: space
 560                 Glue8421,      # 17: ascii
 561         ],
 562         # 12: suffixed
 563         [
 564                 Glue0222,      # 0: begin paren
 565                 GlueNon,      # 1: end paren
 566                 Glue004,      # 2: not at top of line
 567                 GlueNon,      # 3: ?!
 568                 Glue0443,      # 4: dot
 569                 GlueNon,      # 5: punc
 570                 Glue004,      # 6: leader
 571                 Glue004,      # 7: pre unit
 572                 Glue004,      # 8: post unit
 573                 GlueNon,      # 9: zenkaku space
 574                 Glue8421,      # 10: hirakana
 575                 Glue8421,      # 11: japanese
 576                 GlueNon,      # 12: suffixed
 577                 Glue8421,      # 13: rubied
 578                 Glue004,      # 14: number
 579                 Glue004,      # 15: unit
 580                 Glue004,      # 16: space
 581                 Glue844,      # 17: ascii
 582         ],
 583         # 13: rubied
 584         [
 585                 Glue0222,      # 0: begin paren
 586                 GlueNon,      # 1: end paren
 587                 Glue004,      # 2: not at top of line
 588                 GlueNon,      # 3: ?!
 589                 Glue0443,      # 4: dot
 590                 GlueNon,      # 5: punc
 591                 Glue004,      # 6: leader
 592                 Glue004,      # 7: pre unit
 593                 Glue004,      # 8: post unit
 594                 GlueNon,      # 9: zenkaku space
 595                 Glue004,      # 10: hirakana
 596                 Glue004,      # 11: japanese
 597                 Glue8421,      # 12: suffixed
 598                 GlueNon,      # 13: rubied
 599                 Glue8421,      # 14: number
 600                 Glue8421,      # 15: unit
 601                 Glue004,      # 16: space
 602                 Glue8421,      # 17: ascii
 603         ],
 604         # 14: number
 605         [
 606                 Glue0222,      # 0: begin paren
 607                 GlueNon,      # 1: end paren
 608                 GlueNon,      # 2: not at top of line
 609                 GlueNon,      # 3: ?!
 610                 Glue0443,      # 4: dot
 611                 GlueNon,      # 5: punc
 612                 Glue004,      # 6: leader
 613                 Glue004,      # 7: pre unit
 614                 GlueNon,      # 8: post unit
 615                 GlueNon,      # 9: zenkaku space
 616                 Glue8421,      # 10: hirakana
 617                 Glue8421,      # 11: japanese
 618                 Glue004,      # 12: suffixed
 619                 Glue8421,      # 13: rubied
 620                 GlueNon,      # 14: number
 621                 Glue8421,      # 15: unit
 622                 Glue004,      # 16: space
 623                 GlueNon,      # 17: ascii
 624         ],
 625         # 15: unit
 626         [
 627                 Glue0222,      # 0: begin paren
 628                 GlueNon,      # 1: end paren
 629                 GlueNon,      # 2: not at top of line
 630                 GlueNon,      # 3: ?!
 631                 Glue0443,      # 4: dot
 632                 GlueNon,      # 5: punc
 633                 Glue004,      # 6: leader
 634                 Glue004,      # 7: pre unit
 635                 Glue004,      # 8: post unit
 636                 GlueNon,      # 9: zenkaku space
 637                 Glue8421,      # 10: hirakana
 638                 Glue8421,      # 11: japanese
 639                 Glue004,      # 12: suffixed
 640                 Glue8421,      # 13: rubied
 641                 Glue8421,      # 14: number
 642                 GlueNon,      # 15: unit
 643                 Glue004,      # 16: space
 644                 GlueNon,      # 17: ascii
 645         ],
 646         # 16: space
 647         [
 648                 Glue0222,      # 0: begin paren
 649                 Glue004,      # 1: end paren
 650                 Glue004,      # 2: not at top of line
 651                 Glue004,      # 3: ?!
 652                 Glue0443,      # 4: dot
 653                 Glue004,      # 5: punc
 654                 Glue004,      # 6: leader
 655                 Glue004,      # 7: pre unit
 656                 Glue004,      # 8: post unit
 657                 Glue004,      # 9: zenkaku space
 658                 Glue004,      # 10: hirakana
 659                 Glue004,      # 11: japanese
 660                 Glue004,      # 12: suffixed
 661                 Glue004,      # 13: rubied
 662                 Glue004,      # 14: number
 663                 Glue004,      # 15: unit
 664                 Glue004,      # 16: space
 665                 Glue004,      # 17: ascii
 666         ],
 667         # 17: ascii
 668         [
 669                 Glue0222,      # 0: begin paren
 670                 GlueNon,      # 1: end paren
 671                 GlueNon,      # 2: not at top of line
 672                 GlueNon,      # 3: ?!
 673                 Glue0443,      # 4: dot
 674                 GlueNon,      # 5: punc
 675                 Glue004,      # 6: leader
 676                 Glue004,      # 7: pre unit
 677                 Glue004,      # 8: post unit
 678                 GlueNon,      # 9: zenkaku space
 679                 Glue8421,      # 10: hirakana
 680                 Glue8421,      # 11: japanese
 681                 Glue844,      # 12: suffixed
 682                 Glue8421,      # 13: rubied
 683                 GlueNon,      # 14: number
 684                 GlueNon,      # 15: unit
 685                 Glue004,      # 16: space
 686                 GlueNon,      # 17: ascii
 687         ],
 688 ];
 689
 690 $Default{Splittable} = [
 691         [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0],
 692         [1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1],
 693         [1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1],
 694         [1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1],
 695         [1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1],
 696         [1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1],
 697         [1, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1],
 698         [1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1],
 699         [1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1],
 700         [1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1],
 701         [1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1],
 702         [1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1],
 703         [1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1],
 704         [1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1],
 705         [1, 0, 0, 0, 0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 0, 1, 1, 1],
 706         [1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 0],
 707         [1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1],
 708         [1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 0],
 709 ];
 710
 711 # 1 if not at begin of line
 712 $Default{NoBOL} =
 713         [0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0];
 714
 715 # 1 if not at end of line
 716 $Default{NoEOL} =
 717         [1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0];
 718
 719
 720 #--------------------------------------------------------------------------
 721 package PDFJ::Util;
 722 use Carp;
 723 use FileHandle;
 724 use strict;
 725
 726 my $TeXHyphenObj;
 727
 728 sub hyphenate {
 729         my($word) = @_;
 730         require TeX::Hyphen;
 731         $TeXHyphenObj = TeX::Hyphen->new unless $TeXHyphenObj;
 732         $TeXHyphenObj->hyphenate($word);
 733 }
 734
 735 sub uriencode {
 736         my($str) = @_;
 737         $str =~ s/([^;\/?:@&=+\$,A-Za-z0-9\-_.!~*'()])/sprintf("%%%02X",ord($1))/ge
 738                 unless $str =~ /%[0-9a-fA-F]{2}/;
 739         $str;
 740 }
 741
 742 my $SubsetTag;
 743 sub subsettag {
 744         unless( $SubsetTag ) {
 745                 for(1..6) {
 746                         $SubsetTag .= chr(ord('A') + int(rand(26)));
 747                 }
 748         }
 749         $SubsetTag++;
 750 }
 751
 752 sub ttfopen {
 753         my($ttffile, $encoding) = @_;
 754         require PDFJ::TTF;
 755         my $ttf;
 756         if( $ttffile =~ /(\.ttc):(\d)$/i ) {
 757                 my $ttcfile = $`.$1;
 758                 my $num = $2;
 759                 my $ttc = new PDFJ::TTC $ttcfile;
 760                 $ttf = $ttc->select($num);
 761         } else {
 762                 $ttf = new PDFJ::TTF $ttffile;
 763         }
 764         croak "cannot open $ttffile" unless $ttf;
 765         $ttf->read_table(':all');
 766         $ttf;
 767 }
 768
 769 sub deflate {
 770         my($src) = @_;
 771         my $reader = reader($src) or return;
 772         eval { require Compress::Zlib; };
 773         #return if $@;
 774         croak $@ if $@;
 775         my $OK = Compress::Zlib::Z_OK();
 776         my $d = Compress::Zlib::deflateInit() or return;
 777         my($len, $data, $result);
 778         while( $len = &$reader($data, 1024) ) {
 779                 my($deflated, $status) = $d->deflate($data);
 780                 return unless $status == $OK;
 781                 $result .= $deflated;
 782         }
 783         my($deflated, $status) = $d->flush();
 784         return unless $status == $OK;
 785         $result .= $deflated;
 786         $result;
 787 }
 788
 789 sub deflate_ascii85encode {
 790         my($src) = @_;
 791         my($result, $deflated);
 792         my $temp = deflate($src);
 793         if( $temp ) {
 794                 $result = ascii85encode(\$temp);
 795                 $deflated = 1;
 796         } else {
 797                 $result = ascii85encode($src);
 798         }
 799         ($result, $deflated);
 800 }
 801
 802 sub ascii85encode {
 803         my($src) = @_;
 804         my $reader = reader($src) or return;
 805         my($len, $data, $result);
 806         while( $len = &$reader($data, 4) ) {
 807                 if( $len == 4 ) {
 808                         my $resultchunk = ascii85chunk($data);
 809                         $resultchunk = 'z' if $resultchunk eq '!!!!!';
 810                         $result .= $resultchunk;
 811                 } else {
 812                         for( my $j = 4; $j > $len; $j-- ) {
 813                                 $data .= "\000";
 814                         }
 815                         $result .= substr ascii85chunk($data), 0, $len + 1;
 816                         last;
 817                 }
 818         }
 819         $result .= '~>';
 820         $result;
 821 }
 822
 823 sub ascii85chunk {
 824         my($chunk) = @_;
 825         $chunk = unpack("N", $chunk);
 826         my $resultchunk;
 827         $resultchunk .= chr(int($chunk / (85 ** 4)) + 33);
 828         $chunk = $chunk % (85 ** 4);
 829         $resultchunk .= chr(int($chunk / (85 ** 3)) + 33);
 830         $chunk = $chunk % (85 ** 3);
 831         $resultchunk .= chr(int($chunk / (85 ** 2)) + 33);
 832         $chunk = $chunk % (85 ** 2);
 833         $resultchunk .= chr(int($chunk / 85) + 33);
 834         $chunk = $chunk % 85;
 835         $resultchunk .= chr($chunk + 33);
 836         $resultchunk;
 837 }
 838
 839 sub tounicode {
 840         my($str, $init) = @_;
 841         require PDFJ::Unicode;
 842         my $result = $init ? "\xfe\xff" : "";
 843         if( $PDFJ::Default{Jcode} eq 'SJIS' ) {
 844                 $result .= PDFJ::Unicode::sjistounicode($str);
 845         } elsif( $PDFJ::Default{Jcode} eq 'EUC' ) {
 846                 $result .= PDFJ::Unicode::euctounicode($str);
 847         }
 848         $result;
 849 }
 850
 851 sub reader {
 852         my($src) = @_;
 853         if( ref($src) eq 'SCALAR' ) {
 854                 my $pos = 0;
 855                 return sub {
 856                         $_[0] = substr $$src, $pos, $_[1];
 857                         my $len = length $_[0];
 858                         $pos += $len;
 859                         $len;
 860                 };
 861         } else {
 862                 my $handle = FileHandle->new($src) or return;
 863                 binmode $handle;
 864                 return sub {
 865                         read $handle, $_[0], $_[1];
 866                 };
 867         }
 868 }
 869
 870 #--------------------------------------------------------------------------
 871 package PDFJ::Doc;
 872 use strict;
 873 use Carp;
 874 use FileHandle;
 875 use PDFJ::Object;
 876
 877 sub new {
 878         my($class, $version, $pagewidth, $pageheight) = @_;
 879         my $objtable = PDFJ::ObjTable->new;
 880         my $self = bless {
 881                 version => $version,
 882                 objtable => $objtable,
 883                 pagewidth => $pagewidth,
 884                 pageheight => $pageheight,
 885                 pagelist => [],
 886                 pageobjlist => [],
 887                 fontlist => {},
 888                 imagelist => {},
 889                 jcidsysteminfo => undef,
 890                 jfontdescriptor => {},
 891                 filter => 'f', # a:ascii85, f:flate, af:both
 892                 subsettag => PDFJ::Util::subsettag(),
 893                 }, $class;
 894         $self->{pagetree} = $self->indirect(dictionary({
 895                 Type => name('Pages'),
 896                 Kids => [],
 897                 Count => 0,
 898                 }));
 899         $self->{catalog} = $self->indirect(dictionary({
 900                 Type => name('Catalog'),
 901                 Pages => $self->{pagetree},
 902                 }));
 903         $self;
 904 }
 905
 906 sub filter {
 907         my($self, $flag) = @_;
 908         if( defined $flag ) {
 909                 $self->{filter} = $flag; # a:ascii85, f:flate, af:both
 910         }
 911         $self->{filter};
 912 }
 913
 914 sub _add_outline {
 915         my($self, $title, $dest, $parent) = @_;
 916         $title = PDFJ::Util::tounicode($title, 1) if $title =~ /[\x80-\xff]/;
 917         my $lastitem = $parent->get('Last');
 918         my $newitem;
 919         if( $lastitem ) {
 920                 $newitem = $self->indirect(dictionary({
 921                         Title => string($title),
 922                         Parent => $parent,
 923                         Prev => $lastitem,
 924                         Count => 0,
 925                         }));
 926                 $newitem->set('Dest', $dest) if $dest;
 927                 $lastitem->set('Next', $newitem);
 928                 $parent->set('Last', $newitem);
 929         } else {
 930                 $newitem = $self->indirect(dictionary({
 931                         Title => string($title),
 932                         Parent => $parent,
 933                         Count => 0,
 934                         }));
 935                 $newitem->set('Dest', $dest) if $dest;
 936                 $parent->set('First', $newitem);
 937                 $parent->set('Last', $newitem);
 938         }
 939         while( $parent ) {
 940                 $parent->get('Count')->add(1);
 941                 $parent = $parent->get('Parent');
 942         }
 943         $newitem;
 944 }
 945
 946 sub add_outline {
 947         my($self, $title, $dest, $level) = @_;
 948         unless( $self->{outline} ) {
 949                 $self->{outline} = $self->indirect(dictionary({
 950                         Type => name('Outlines'),
 951                         Count => 0,
 952                         }));
 953                 $self->{catalog}->set('Outlines', $self->{outline});
 954                 $self->{catalog}->set('PageMode', name('UseOutlines'));
 955         }
 956         my $parent = $self->{outline};
 957         while( $level-- ) {
 958                 $parent = $parent->get('Last') ?
 959                         $parent->get('Last') :
 960                         $self->_add_outline('', undef, $parent);
 961         }
 962         $self->_add_outline($title, $dest, $parent);
 963 }
 964
 965 sub add_dest {
 966         my($self, $name, $dest) = @_;
 967         $self->{dest}{$name} = $dest;
 968 }
 969
 970 sub dest {
 971         my($self, $name) = @_;
 972         $self->{dest}{$name};
 973 }
 974
 975 sub indirect {
 976         my($self, $obj) = @_;
 977         $obj->indirect($self->{objtable});
 978 }
 979
 980 sub print {
 981         my($self, $filename) = @_;
 982         $self->_solve_link;
 983         $self->_complete_subsetfont;
 984         my $handle = FileHandle->new(">$filename");
 985         return unless $handle;
 986         my $fobj = PDFJ::File->new($self->{version}, $handle, $self->{objtable},
 987                 $self->{catalog});
 988         $fobj->print;
 989         close $handle;
 990 }
 991
 992 sub new_page {
 993         my $self = shift;
 994         PDFJ::Page->new($self, @_);
 995 }
 996
 997 sub get_page {
 998         my($self, $idx) = @_;
 999         $self->{pageobjlist}->[$idx];
1000 }
1001
1002 sub get_lastpagenum {
1003         my $self = shift;
1004         scalar @{$self->{pagelist}};
1005 }
1006
1007 sub new_font {
1008         if( @_ > 3 ) {
1009                 &new_combofont;
1010         } else {
1011                 &new_singlefont;
1012         }
1013 }
1014
1015 sub new_singlefont {
1016         my($self, $basefont, $encoding) = @_;
1017         $basefont ||= $PDFJ::Default{BaseAFont};
1018         my $type = $PDFJ::Default{Fonts}{$basefont};
1019         if( $type eq 'a' ) {
1020                 new_afont($self, $basefont, $encoding);
1021         } elsif( $type eq 'j' ) {
1022                 new_jfont($self, $basefont, $encoding);
1023         } elsif( $basefont =~ /\.ttf$/i || $basefont =~ /\.ttc:\d$/i ) {
1024                 if( $PDFJ::Default{Encodings}{$encoding} eq 'a' ) {
1025                         new_afont($self, $basefont, $encoding);
1026                 } else {
1027                         new_jfont($self, $basefont, $encoding);
1028                 }
1029         } else {
1030                 croak "unknown font: $basefont";
1031         }
1032 }
1033
1034 sub new_combofont {
1035         my($self, $zbase, $zenc, $hbase, $henc) = @_;
1036         my $hfont = UNIVERSAL::isa($hbase, "PDFJ::AFont") ? $hbase :
1037                 new_afont($self, $hbase, $henc);
1038         new_jfont($self, $zbase, $zenc, $hfont);
1039 }
1040
1041 sub new_afont {
1042         my($self, $basefont, $encoding) = @_;
1043         $basefont ||= $PDFJ::Default{BaseAFont};
1044         $encoding ||= $PDFJ::Default{AFontEncoding};
1045         croak "encoding type mismatch"
1046                 unless $PDFJ::Default{Encodings}{$encoding} eq 'a';
1047         if( $basefont =~ /\.ttf$/i || $basefont =~ /\.ttc:\d$/i ) {
1048                 PDFJ::AFont->new_ttf($self, $basefont, $encoding);
1049         } else {
1050                 PDFJ::AFont->new_std($self, $basefont, $encoding);
1051         }
1052 }
1053
1054 sub new_jfont {
1055         my($self, $basefont, $encoding, $hfont) = @_;
1056         $basefont ||= $PDFJ::Default{BaseJFont};
1057         $encoding ||= $PDFJ::Default{JFontEncoding};
1058         croak "encoding type mismatch"
1059                 unless $PDFJ::Default{Encodings}{$encoding} eq
1060                         ($PDFJ::Default{Jcode} eq 'SJIS' ? 'js' : 'je');
1061         if( $basefont =~ /\.ttf$/i || $basefont =~ /\.ttc:\d$/i ) {
1062                 PDFJ::JFont->new_ttf($self, $basefont, $encoding, $hfont);
1063         } else {
1064                 PDFJ::JFont->new_std($self, $basefont, $encoding, $hfont);
1065         }
1066 }
1067
1068 sub new_image {
1069         my($self, $src, $pxwidth, $pxheight, $width, $height, $padding, $colorspace)
1070                 = @_;
1071         PDFJ::Image->new($self, $src, $pxwidth, $pxheight, $width, $height,
1072                 $padding, $colorspace);
1073 }
1074
1075 sub italic {
1076         my($self, @args) = @_;
1077         $self->_deco('italic', @args);
1078 }
1079
1080 sub bold {
1081         my($self, @args) = @_;
1082         $self->_deco('bold', @args);
1083 }
1084
1085 # internal methods
1086 sub _deco {
1087         my($self, $style, @args) = @_; # $style: italic, bold
1088         croak "arguments must be even" if @args % 2;
1089         while( @args ) {
1090                 my $base = shift @args;
1091                 my $deco = shift @args;
1092                 if( $base->isa("PDFJ::AFont") ) {
1093                         croak "font type mismatch" unless $deco->isa("PDFJ::AFont");
1094                         $self->{$style}{$base->{name}} = $deco->{name};
1095                 } elsif( $base->isa("PDFJ::JFont") ) {
1096                         croak "font type mismatch" unless $deco->isa("PDFJ::JFont");
1097                         if( $base->{combo} ) {
1098                                 croak "font combo type mismatch" unless $deco->{combo};
1099                                 $self->{$style}{$base->{zname}, $base->{hname}} =
1100                                         join($;, $deco->{zname}, $deco->{hname});
1101                         } else {
1102                                 croak "font combo type mismatch" if $deco->{combo};
1103                                 $self->{$style}{$base->{zname}} = $deco->{zname};
1104                         }
1105                 }
1106         }
1107 }
1108
1109 sub _bolditalicname {
1110         my($self, $name, $style) = @_; # $style: PDFJ::TStyle object
1111         my $dname = $name;
1112         $dname = $self->{italic}{$dname} || $dname if $style->{italic};
1113         $dname = $self->{bold}{$dname} || $dname if $style->{bold};
1114         $dname;
1115 }
1116
1117 sub _bold {
1118         my($self, $name) = @_;
1119         $self->{fontlist}{$self->{bold}{$name}}
1120 }
1121
1122 sub _solve_link {
1123         my $self = shift;
1124         for my $pageobj(@{$self->{pageobjlist}}) {
1125                 $pageobj->solve_link;
1126         }
1127 }
1128
1129 sub _complete_subsetfont {
1130         my $self = shift;
1131         for my $name(keys %{$self->{subsetttf}}) {
1132                 my $sttf = $self->{subsetttf}{$name};
1133                 my $ttf = $sttf->{ttf};
1134                 my $direction = $sttf->{direction};
1135                 my @unicodes = sort keys %{$sttf->{subset_unicodes}};
1136                 my $font = $self->{fontlist}{$name};
1137                 my($subset, $c2g, $cidset) = $ttf->subset($direction, @unicodes);
1138                 my $size = length $subset;
1139                 my($encoded, $filter) = $self->_makestream(\$subset);
1140                 croak "cannot encode ttf subset data" unless $encoded;
1141                 $font->get('DescendantFonts')->get(0)->get('FontDescriptor')->set(
1142                         FontFile2 => $self->indirect(stream(dictionary => {
1143                                 Filter  => $filter,
1144                                 Length  => length($encoded),
1145                                 Length1 => $size,
1146                         }, stream => $encoded)));
1147                 ($encoded, $filter) = $self->_makestream(\$c2g);
1148                 croak "cannot encode ttf subset cidtogidmap" unless $encoded;
1149                 $font->get('DescendantFonts')->get(0)->set(
1150                         CIDToGIDMap => $self->indirect(stream(dictionary => {
1151                                 Filter  => $filter,
1152                                 Length  => length($encoded),
1153                         }, stream => $encoded)));
1154 if(0) {
1155                 ($encoded, $filter) = $self->_makestream(\$cidset);
1156                 croak "cannot encode ttf subset cidset" unless $encoded;
1157                 $font->get('DescendantFonts')->get(0)->get('FontDescriptor')->set(
1158                         CIDSet => $self->indirect(stream(dictionary => {
1159                                 Filter  => $filter,
1160                                 Length  => length($encoded),
1161                         }, stream => $encoded)));
1162 }
1163         }
1164 }
1165
1166 sub _makestream {
1167         my($self, $src, @addfilters) = @_;
1168         my($encoded, $deflated, @filters);
1169         if( $self->filter =~ /af/ ) {
1170                 ($encoded, $deflated) = PDFJ::Util::deflate_ascii85encode($src);
1171                 return unless $encoded;
1172                 @filters = $deflated ? qw(ASCII85Decode FlateDecode) :
1173                         qw(ASCII85Decode);
1174         } elsif( $self->filter =~ /f/ ) {
1175                 $encoded = PDFJ::Util::deflate($src) or return;
1176                 @filters = qw(FlateDecode);
1177         } elsif( $self->filter =~ /a/ ) {
1178                 $encoded = PDFJ::Util::ascii85encode($src) or return;
1179                 @filters = qw(ASCII85Decode);
1180         } else {
1181                 return;
1182         }
1183         push @filters, @addfilters if @addfilters;
1184         my $filter = @filters > 1 ? [map {name($_)} @filters] : name($filters[0]);
1185         ($encoded, $filter);
1186 }
1187
1188 sub _nextsubsettag {
1189         my $self = shift;
1190         $self->{subsettag}++;
1191 }
1192
1193 sub _nextfontnum {
1194         my $self = shift;
1195         1 + scalar keys %{$self->{fontlist}};
1196 }
1197
1198 sub _registfont {
1199         my($self, $fontobj) = @_;
1200         my $baseorttf = $fontobj->{ttffile} || $fontobj->{basefont};
1201         my $encoding = $fontobj->{encoding};
1202         my $name = $fontobj->{name} || $fontobj->{zname};
1203         my $font = $fontobj->{font} || $fontobj->{zfont};
1204         $self->{fontname}{$baseorttf, $encoding} = $name;
1205         $self->{fontlist}{$name} = $font;
1206         if( $fontobj->{combo} ) {
1207                 $self->{fontobjlist}{$name, $fontobj->{hname}} = $fontobj;
1208         } else {
1209                 $self->{fontobjlist}{$name} = $fontobj;
1210         }
1211 }
1212
1213 sub _registsubset {
1214         my($self, %args) = @_;
1215         $args{subset_unicodes} = {};
1216         $self->{subsetttf}{$args{name}} = \%args;
1217 }
1218
1219 sub _subsetttf {
1220         my($self, $name) = @_;
1221         $self->{subsetttf}{$name};
1222 }
1223
1224 sub _fontname {
1225         my($self, $baseorttf, $encoding) = @_;
1226         $self->{fontname}{$baseorttf, $encoding};
1227 }
1228
1229 sub _font {
1230         my($self, $name) = @_;
1231         $self->{fontlist}{$name};
1232 }
1233
1234 sub _fontobj {
1235         my($self, $name, $hname) = @_;
1236         $hname ?
1237                 $self->{fontobjlist}{$name, $hname} :
1238                 $self->{fontobjlist}{$name};
1239 }
1240
1241 sub _jcidsysteminfo {
1242         my $self = shift;
1243         unless( $self->{jcidsysteminfo} ) {
1244                 $self->{jcidsysteminfo} = $self->indirect(dictionary({
1245                         Registry => 'Adobe',
1246                         Ordering => 'Japan1',
1247                         Supplement => 2,
1248                 }));
1249         }
1250         $self->{jcidsysteminfo};
1251 }
1252
1253 sub _jfontdescriptor {
1254         my($self, $basefont) = @_;
1255         unless( $self->{jfontdescriptor}->{$basefont} ) {
1256                 $self->{jfontdescriptor}->{$basefont} =
1257                         $self->indirect($PDFJ::Default{JFD}{$basefont});
1258         }
1259         $self->{jfontdescriptor}->{$basefont};
1260 }
1261
1262 sub _nextimagenum {
1263         my $self = shift;
1264         1 + scalar keys %{$self->{imagelist}};
1265 }
1266
1267 sub _registimage {
1268         my($self, $name, $image) = @_;
1269         $self->{imagelist}->{$name} = $image;
1270 }
1271
1272 #--------------------------------------------------------------------------
1273 package PDFJ::Font;
1274 use strict;
1275
1276 #--------------------------------------------------------------------------
1277 package PDFJ::AFont;
1278 use strict;
1279 use Carp;
1280 use SelfLoader;
1281 use PDFJ::Object;
1282 use vars qw(@ISA);
1283 @ISA = qw(PDFJ::Font);
1284
1285 sub new_std {
1286         my($class, $docobj, $basefont, $encoding) = @_;
1287         croak "illegal ascii font name: $basefont"
1288                 unless $PDFJ::Default{Fonts}{$basefont} eq 'a';
1289         my $name = $docobj->_fontname($basefont, $encoding);
1290         return $docobj->_fontobj($name) if $name;
1291         $name = "F".$docobj->_nextfontnum;
1292         my $font = $docobj->indirect(dictionary({
1293                 Type => name('Font'),
1294                 Name => name($name),
1295                 BaseFont => name($basefont),
1296                 Subtype => name('Type1'),
1297                 Encoding => name($encoding),
1298         }));
1299         my $width = fontwidth($basefont);
1300         my $self = bless {docobj => $docobj, basefont => $basefont,
1301                 encoding => $encoding, font => $font, name => $name, width => $width,
1302                 direction => 'H'}, $class;
1303         $docobj->_registfont($self);
1304         $self;
1305 }
1306
1307 sub new_ttf {
1308         my($class, $docobj, $ttffile, $encoding) = @_;
1309         my $name = $docobj->_fontname($ttffile, $encoding);
1310         return $docobj->_fontobj($name) if $name;
1311         $name = "F".$docobj->_nextfontnum;
1312         my $ttf = PDFJ::Util::ttfopen($ttffile);
1313         my $info = $ttf->pdf_info_ascii($encoding);
1314         croak "'$ttffile' embedding inhibited"
1315                 if $info->{EmbedFlag} == 2 || $info->{EmbedFlag} & 0x200;
1316         my $size = -s $ttffile;
1317         my($encoded, $filter) = $docobj->_makestream($ttffile);
1318         my $basefont = $info->{BaseFont};
1319         my @widths = @{$info->{Widths}};
1320         my $font = $docobj->indirect(dictionary({
1321                 Type => name('Font'),
1322                 Name => name($name),
1323                 BaseFont => name($basefont),
1324                 Subtype => name('TrueType'),
1325                 Encoding => name($info->{Encoding}),
1326                 FirstChar => $info->{FirstChar},
1327                 LastChar => $info->{LastChar},
1328                 Widths => $docobj->indirect(array(\@widths)),
1329                 FontDescriptor => $docobj->indirect(dictionary({
1330                         Type => name('FontDescriptor'),
1331                         Ascent => $info->{Ascent},
1332                         CapHeight => $info->{CapHeight},
1333                         Descent => $info->{Descent},
1334                         Flags => $info->{Flags},
1335                         FontBBox => $info->{FontBBox},
1336                         FontName => name($info->{FontName}),
1337                         ItalicAngle => $info->{ItalicAngle},
1338                         StemV => 0, # OK?
1339                         FontFile2 => $docobj->indirect(stream(dictionary => {
1340                                 Filter  => $filter,
1341                                 Length  => length($encoded),
1342                                 Length1 => $size,
1343                         }, stream => $encoded)),
1344                 })),
1345         }));
1346         my $self = bless {docobj => $docobj, # basefont => $basefont,
1347                 encoding => $encoding, ttffile => $ttffile,
1348                 font => $font, name => $name, width => $info->{Widths},
1349                 direction => 'H'}, $class;
1350         $docobj->_registfont($self);
1351         $self;
1352 }
1353
1354 sub selectname {
1355         my($self, $style) = @_;
1356         my $docobj = $self->{docobj};
1357         $docobj->_bolditalicname($self->{name}, $style);
1358 }
1359
1360 sub hash {
1361         my $self = shift;
1362         ($self->{name}, $self->{font});
1363 }
1364
1365 sub string_fontwidth {
1366         my($self, $string) = @_;
1367         my $fontwidth = $self->{width};
1368         my $width = 0;
1369         for my $c(split '', $string) {
1370                 $width += $fontwidth->[ord $c];
1371         }
1372         $width / 1000;
1373 }
1374
1375 sub astring_fontwidth {
1376         &string_fontwidth;
1377 }
1378
1379 # NOT method
1380 my %FontWidth;
1381 sub fontwidth {
1382         my($basefont) = @_;
1383         $basefont =~ s/-/_/g;
1384         return $FontWidth{$basefont} if $FontWidth{$basefont};
1385         my $func = "fontwidth_$basefont";
1386         my $result = eval { no strict 'refs'; &$func(); };
1387         croak $@ if $@;
1388         $FontWidth{$basefont} = $result if $result;
1389         $result;
1390 }
1391
1392 #--------------------------------------------------------------------------
1393 package PDFJ::JFont;
1394 use strict;
1395 use Carp;
1396 use PDFJ::Object;
1397 use vars qw(@ISA);
1398 @ISA = qw(PDFJ::Font);
1399
1400 sub new_std {
1401         my($class, $docobj, $basefont, $encoding, $hfontobj) = @_;
1402         croak "illegal japanese font name: $basefont"
1403                 unless $PDFJ::Default{Fonts}{$basefont} eq 'j';
1404         croak "ascii font type mismatch"
1405                 if $hfontobj && !UNIVERSAL::isa($hfontobj, "PDFJ::AFont");
1406         my $name = $docobj->_fontname($basefont, $encoding);
1407         my $hname = $hfontobj ? $hfontobj->{name} : undef;
1408         return $docobj->_fontobj($name, $hname)
1409                 if $name && $docobj->_fontobj($name, $hname);
1410         # Zenkaku font
1411         my $code = $PDFJ::Default{Jcode};
1412         my($direction) = $encoding =~ /-(\w+)$/;
1413         my($zname, $zfont);
1414         if( $name ) {
1415                 $zname = $name;
1416                 $zfont = $docobj->_font($name);
1417         } else {
1418                 my $jcidsi = $docobj->_jcidsysteminfo;
1419                 my $jfd = $docobj->_jfontdescriptor($basefont);
1420                 $zname = "F".$docobj->_nextfontnum;
1421                 $zfont = $docobj->indirect(dictionary({
1422                         Name => name($zname),
1423                         Type => name("Font"),
1424                         Subtype => name('Type0'),
1425                         Encoding => name($encoding),
1426                         BaseFont => name("$basefont-$encoding"),
1427                         DescendantFonts => [{
1428                                 Type => name('Font'),
1429                                 Subtype => name('CIDFontType0'),
1430                                 BaseFont => name($basefont),
1431                                 CIDSystemInfo => $jcidsi,
1432                                 DW => 1000,
1433                                 W => [231, 389, 500, 631, [500]],
1434                                 FontDescriptor => $jfd,
1435                         }],
1436                 }));
1437         }
1438         # Hankaku font
1439         my($combo, $hfont);
1440         if( $hfontobj ) {
1441                 $combo = 1;
1442                 $hname = $hfontobj->{name};
1443                 $hfont = $hfontobj->{font};
1444         } else {
1445                 $combo = 0;
1446                 $hname = $zname;
1447                 $hfont = $zfont;
1448         }
1449         my $self = bless {
1450                 docobj => $docobj,
1451                 basefont => $basefont,
1452                 encoding => $encoding,
1453                 zfont => $zfont,
1454                 hfont => $hfont,
1455                 zname => $zname,
1456                 hname => $hname,
1457                 direction => $direction,
1458                 code => $code,
1459                 combo => $combo,
1460                 hfontobj => $hfontobj,
1461         }, $class;
1462         $docobj->_registfont($self);
1463         $self;
1464 }
1465
1466 sub new_ttf {
1467         my($class, $docobj, $ttffile, $encoding, $hfontobj) = @_;
1468         croak "TrueType subset embedding requires PDF version 1.3 or above"
1469                 if $docobj->{version} < 1.3;
1470         croak "ascii font type mismatch"
1471                 if $hfontobj && !UNIVERSAL::isa($hfontobj, "PDFJ::AFont");
1472         my $name = $docobj->_fontname($ttffile, $encoding);
1473         my $hname = $hfontobj ? $hfontobj->{name} : undef;
1474         return $docobj->_fontobj($name, $hname)
1475                 if $name && $docobj->_fontobj($name, $hname);
1476         # Zenkaku font
1477         my $code = $PDFJ::Default{Jcode};
1478         my($direction) = $encoding =~ /-(\w+)$/;
1479         my($zname, $zfont);
1480         if( $name ) {
1481                 $zname = $name;
1482                 $zfont = $docobj->_font($name);
1483         } else {
1484                 my $ttf = PDFJ::Util::ttfopen($ttffile);
1485                 my $info = $ttf->pdf_info_japan($encoding);
1486                 croak "'$ttffile' embedding inhibited ($info->{EmbedFlag})"
1487                         if $info->{EmbedFlag} == 2 || $info->{EmbedFlag} & 0x100 ||
1488                                 $info->{EmbedFlag} & 0x200;
1489                 my $subsetname = $docobj->_nextsubsettag . '+' . $info->{BaseFont};
1490                 my $basefont = $info->{BaseFont};
1491                 my $jcidsi = $docobj->_jcidsysteminfo;
1492                 $zname = "F".$docobj->_nextfontnum;
1493                 $zfont = $docobj->indirect(dictionary({
1494                         Name => name($zname),
1495                         Type => name("Font"),
1496                         Subtype => name('Type0'),
1497                         Encoding => name($encoding),
1498                         BaseFont => name($subsetname),
1499                         DescendantFonts => [$docobj->indirect(dictionary({
1500                                 Type => name('Font'),
1501                                 Subtype => name('CIDFontType2'), # TrueType
1502                                 BaseFont => name($basefont),
1503                                 CIDSystemInfo => $jcidsi,
1504                                 DW => 1000,
1505                                 W => [231, 389, 500, 631, [500]],
1506                                 FontDescriptor => $docobj->indirect(dictionary({
1507                                         Type => name('FontDescriptor'),
1508                                         Ascent => $info->{Ascent},
1509                                         CapHeight => $info->{CapHeight},
1510                                         Descent => $info->{Descent},
1511                                         Flags => $info->{Flags},
1512                                         FontBBox => $info->{FontBBox},
1513                                         FontName => name($subsetname),
1514                                         ItalicAngle => $info->{ItalicAngle},
1515                                         StemV => 0, # OK?
1516                                         # FontFile2 added later
1517                                 })),
1518                                 # CIDToGIDMap added later
1519                         }))],
1520                 }));
1521                 $docobj->_registsubset(
1522                         name => $zname, ttf => $ttf, direction => $direction);
1523         }
1524         my $subset_unicodes = $docobj->_subsetttf($zname)->{subset_unicodes};
1525         # Hankaku font
1526         my($combo, $hfont);
1527         if( $hfontobj ) {
1528                 $combo = 1;
1529                 $hname = $hfontobj->{name};
1530                 $hfont = $hfontobj->{font};
1531         } else {
1532                 $combo = 0;
1533                 $hname = $zname;
1534                 $hfont = $zfont;
1535         }
1536         my $self = bless {
1537                 docobj => $docobj,
1538                 #basefont => $basefont,
1539                 encoding => $encoding,
1540                 ttffile => $ttffile,
1541                 zfont => $zfont,
1542                 hfont => $hfont,
1543                 zname => $zname,
1544                 hname => $hname,
1545                 direction => $direction,
1546                 code => $code,
1547                 combo => $combo,
1548                 hfontobj => $hfontobj,
1549                 subset_unicodes => $subset_unicodes,
1550         }, $class;
1551         $docobj->_registfont($self);
1552         $self;
1553 }
1554
1555 sub selectname {
1556         my($self, $style, $mode) = @_;
1557         my $docobj = $self->{docobj};
1558         if( $self->{combo} ) {
1559                 split $;, $docobj->_bolditalicname(
1560                         join($;, $self->{zname}, $self->{hname}), $style);
1561         } else {
1562                 $docobj->_bolditalicname($self->{zname}, $style);
1563         }
1564 }
1565
1566 sub hash {
1567         my $self = shift;
1568         ($self->{zname}, $self->{zfont}, $self->{hname}, $self->{hfont});
1569 }
1570
1571 sub astring_fontwidth {
1572         my($self, $string) = @_;
1573         my $combo = $self->{combo};
1574         my $hfont = $self->{hfontobj};
1575         if( $combo ) {
1576                 $hfont->string_fontwidth($string);
1577         } else {
1578                 length($string) / 2;
1579         }
1580 }
1581
1582 #--------------------------------------------------------------------------
1583 package PDFJ::BlockElement;
1584 use Carp;
1585 use strict;
1586
1587 sub size { 0 }
1588 sub preskip { 0 }
1589 sub postskip { 0 }
1590 sub postnobreak { 0 }
1591 sub breakable { 0 }
1592 sub float { "" }
1593
1594 #--------------------------------------------------------------------------
1595 package PDFJ::Showable;
1596 use Carp;
1597 use strict;
1598 use vars qw(@ISA);
1599 @ISA = qw(PDFJ::BlockElement);
1600
1601 sub show {
1602         my($self, $page, $x, $y, $align, $transtype, @args) = @_;
1603         if( $transtype ) {
1604                 if( $transtype eq 'magnify' ) {
1605                         my($xmag, $ymag) = @args;
1606                         $page->addcontents("q $xmag 0 0 $ymag $x $y cm");
1607                 } elsif( $transtype eq 'rotate' ) {
1608                         my($rad) = @args;
1609                         my $sin = sin($rad);
1610                         my $cos = cos($rad);
1611                         my $msin = -$sin;
1612                         $page->addcontents("q $cos $sin $msin $cos $x $y cm");
1613                 } elsif( $transtype eq 'distort' ) {
1614                         my($xtan, $ytan) = @args;
1615                         $page->addcontents("q 1 $xtan $ytan 1 $x $y cm");
1616                 } else {
1617                         croak "unknown transformation type";
1618                 }
1619                 ($x, $y) = (0, 0);
1620         }
1621         if( $align ) {
1622                 if( $align =~ /l/ ) {
1623                         $x -= $self->left;
1624                 } elsif( $align =~ /r/ ) {
1625                         $x -= $self->right;
1626                 } elsif( $align =~ /c/ ) {
1627                         $x -= ($self->left + $self->right) / 2;
1628                 }
1629                 if( $align =~ /t/ ) {
1630                         $y -= $self->top;
1631                 } elsif( $align =~ /b/ ) {
1632                         $y -= $self->bottom;
1633                 } elsif( $align =~ /m/ ) {
1634                         $y -= ($self->top + $self->bottom) / 2;
1635                 }
1636         }
1637         $self->_show($page, $x, $y);
1638         if( $transtype ) {
1639                 $page->addcontents("Q");
1640         }
1641 }
1642
1643 #--------------------------------------------------------------------------
1644 package PDFJ::Style;
1645 use strict;
1646 use Carp;
1647
1648 sub new {
1649         my($class, @args) = @_;
1650         if( ref($class) ) {
1651                 $class = ref($class);
1652         }
1653         my $self;
1654         if( @args == 1 && ref($args[0]) eq 'HASH' ) {
1655                 %$self = %{$args[0]};
1656         } else {
1657                 %$self = @args;
1658         }
1659         bless $self, $class;
1660 }
1661
1662 sub clone {
1663         my($self, @args) = @_;
1664         my $clone = $self->new(%$self);
1665         if( @args ) {
1666                 my %args;
1667                 if( @args == 1 && ref($args[0]) eq 'HASH' ) {
1668                         %args = %{$args[0]};
1669                 } else {
1670                         %args = @args;
1671                 }
1672                 for my $key(keys %args) {
1673                         $clone->{$key} = $args{$key};
1674                 }
1675         }
1676         $clone;
1677 }
1678
1679 sub merge {
1680         my($self, $from) = @_;
1681         for my $key(keys %$from) {
1682                 $self->{$key} = $from->{$key} unless exists $self->{$key};
1683         }
1684         $self;
1685 }
1686
1687 #--------------------------------------------------------------------------
1688 package PDFJ::TextStyle;
1689 use strict;
1690 use Carp;
1691 use vars qw(@ISA);
1692 @ISA = qw(PDFJ::Style);
1693
1694 sub TStyle { PDFJ::TextStyle->new(@_) }
1695
1696 sub merge {
1697         my($self, $from) = @_;
1698         if( $self->{suffix} ) {
1699                 $self->{fontsize} = $from->{fontsize} *
1700                         $PDFJ::Default{SuffixSize};
1701                 $self->{rise} =
1702                         $self->{suffix} eq 'u' ? $from->{fontsize} *
1703                                 $PDFJ::Default{USuffixRise} :
1704                         $self->{suffix} eq 'l' ? $from->{fontsize} *
1705                                 $PDFJ::Default{LSuffixRise} :
1706                         0;
1707         }
1708         $self->SUPER::merge($from);
1709 }
1710
1711 sub selectfontname {
1712         my($self, $mode) = @_;
1713         my $font = $self->{font} or return;
1714         $font->selectname($self, $mode);
1715 }
1716
1717 #--------------------------------------------------------------------------
1718 package PDFJ::TextSpec;
1719 use strict;
1720 use Carp;
1721
1722 sub new {
1723         my($class, @args) = @_;
1724         my $self = bless {}, $class;
1725         $self->set(@args) if @args;
1726         $self;
1727 }
1728
1729 # for debug
1730 sub print {
1731         my($self) = @_;
1732         for my $key(qw(fontsize render rise mode)) {
1733                 print "$key => $self->{$key}, ";
1734         }
1735         print "\n";
1736 }
1737
1738 sub set {
1739         my($self, $style, $fontname) = @_;
1740         %$self = ();
1741         for my $key(qw(fontsize render rise shapestyle)) {
1742                 if( exists $style->{$key} ) {
1743                         $self->{$key} = $style->{$key};
1744                 }
1745         }
1746         $self->{fontname} = $fontname;
1747 }
1748
1749 sub copy {
1750         my($self, $from) = @_;
1751         %$self = %$from;
1752 }
1753
1754 sub equal {
1755         my($self, $other) = @_;
1756         for my $key(qw(fontname fontsize render rise shapestyle)) {
1757                 return 0 if ($self->{$key} || "") ne ($other->{$key} || "");
1758         }
1759         return 1;
1760 }
1761
1762 sub pdf {
1763         my($self) = @_;
1764         croak "no fontsize specification" unless $self->{fontsize};
1765         my $fontname = $self->{fontname};
1766         my $fontsize = $self->{fontsize};
1767         my $rise = $self->{rise} || 0;
1768         my $render = $self->{render} || 0;
1769         my $shapepdf = $self->{shapestyle} ? $self->{shapestyle}->pdf : "";
1770         my $pdf = "q ";
1771         $pdf .= "$shapepdf " if $shapepdf;
1772         $pdf .= "BT /$fontname $fontsize Tf $rise Ts $render Tr ";
1773         $pdf;
1774 }
1775
1776 #--------------------------------------------------------------------------
1777 package PDFJ::NewLine;
1778 use Carp;
1779 use strict;
1780
1781 sub NewLine { PDFJ::NewLine->new(@_) }
1782
1783 sub new {
1784         my($class) = @_;
1785         bless \$class, $class;
1786 }
1787
1788 #--------------------------------------------------------------------------
1789 package PDFJ::Outline;
1790 use Carp;
1791 use strict;
1792
1793 sub Outline { PDFJ::Outline->new(@_) }
1794
1795 sub new {
1796         my($class, $title, $level) = @_;
1797         bless {outlinetitle => $title, outlinelevel => $level}, $class;
1798 }
1799
1800 #--------------------------------------------------------------------------
1801 package PDFJ::Dest;
1802 use Carp;
1803 use strict;
1804
1805 sub Dest { PDFJ::Dest->new(@_) }
1806
1807 sub new {
1808         my($class, $name) = @_;
1809         bless {destname => $name}, $class;
1810 }
1811
1812 #--------------------------------------------------------------------------
1813 package PDFJ::Text;
1814 use Carp;
1815 use strict;
1816 use vars qw(@ISA);
1817 @ISA = qw(PDFJ::Showable);
1818
1819 sub Text { PDFJ::Text->new(@_) }
1820
1821 sub new {
1822         my $class = shift;
1823         my $style = pop; # not shift
1824         if( UNIVERSAL::isa($style, 'PDFJ::TextStyle') ) {
1825                 $style = $style->clone;
1826         } elsif( ref($style) eq 'HASH' ) {
1827                 $style = PDFJ::TextStyle->new($style);
1828         } else {
1829                 croak "style argument must be a PDFJ::TextStyle object or HASHref";
1830         }
1831         my @texts = @_;
1832         my $texts = (@texts == 1 && ref($texts[0]) eq 'ARRAY') ? $texts[0] : \@texts;
1833         my $self = bless { texts => $texts, style => $style }, $class;
1834         $self->mergestyle;
1835         # $self->print;
1836         $self->makechunks;
1837         $self->makerubytext;
1838         $self;
1839 }
1840
1841 sub mergestyle {
1842         my($self) = @_;
1843         my $style = $self->style;
1844         return unless $style->{font};
1845         for my $text(@{$self->texts}) {
1846                 if( UNIVERSAL::isa($text, 'PDFJ::Text') ) {
1847                         $text->style->merge($style);
1848                         $text->mergestyle;
1849                 }
1850         }
1851 }
1852
1853 # for debug
1854 sub print {
1855         my($self, $indent) = @_;
1856         my $style = $self->style;
1857         print $indent,join(',',%$style),"\n";
1858         for my $text(@{$self->texts}) {
1859                 if( UNIVERSAL::isa($text, 'PDFJ::Text') ) {
1860                         $text->print("$indent  ");
1861                 } else {
1862                         print "$indent\[$text]\n";
1863                 }
1864         }
1865 }
1866
1867 sub makechunks {
1868         my($self) = @_;
1869         my $style = $self->style;
1870         return unless $style->{font};
1871         $self->{chunks} = [];
1872         $self->{lines} = [];
1873         for my $text(@{$self->texts}) {
1874                 if( UNIVERSAL::isa($text, 'PDFJ::Text') ) {
1875                         $text->makechunks unless $text->chunks;
1876                         $self->catchunks($text->chunks);
1877                 } elsif( UNIVERSAL::isa($text, 'PDFJ::Showable') ) {
1878                         $self->catchunks([_objchunk($text, $self->style)]);
1879 #               } elsif( UNIVERSAL::isa($text, 'PDFJ::Image') ) {
1880 #                       $self->catchunks([_imagechunk($text, $self->style)]);
1881 #               } elsif( UNIVERSAL::isa($text, 'PDFJ::Shape') ) {
1882 #                       $self->catchunks([_shapechunk($text, $self->style)]);
1883                 } elsif( UNIVERSAL::isa($text, 'PDFJ::NewLine') ) {
1884                         $self->catchunks([_newlinechunk($self->style)]);
1885                 } elsif( UNIVERSAL::isa($text, 'PDFJ::Outline') ) {
1886                         $self->catchunks([_outlinechunk($text, $self->style)]);
1887                 } elsif( UNIVERSAL::isa($text, 'PDFJ::Dest') ) {
1888                         $self->catchunks([_destchunk($text, $self->style)]);
1889                 } else {
1890                         $self->catchunks($self->splittext($text));
1891                 }
1892         }
1893 }
1894
1895 sub makerubytext {
1896         my($self) = @_;
1897         return unless $self->style->{font};
1898         for my $chunk(@{$self->chunks}) {
1899                 my $style = $chunk->{Style};
1900                 if( $style->{ruby} ) {
1901                         croak "ruby class mismatch"
1902                                 unless $chunk->{Class} == 11 || $chunk->{Class} == 17;
1903                         my $rubystyle = $style->clone;
1904                         delete $rubystyle->{ruby};
1905                         delete $rubystyle->{withbox};
1906                         delete $rubystyle->{withline};
1907                         $rubystyle->{fontsize} /= 2;
1908                         my $rubytext = PDFJ::Text->new($style->{ruby}, $rubystyle);
1909                         my $rubysize = $rubytext->size;
1910                         my $chunksize = _chunksize($chunk, 1);
1911                         if( $rubysize < $chunksize ) {
1912                                 my $alt = PDFJ::Paragraph->new($rubytext,
1913                                         PDFJ::ParagraphStyle->new(size => $chunksize,
1914                                                 align => 'ruby', linefeed => 0));
1915                                 $chunk->{RubyText} = $alt;
1916                         } elsif( $rubysize > $chunksize ) {
1917                                 my $altstyle = $style->clone;
1918                                 delete $altstyle->{ruby};
1919                                 delete $altstyle->{withbox};
1920                                 delete $altstyle->{withline};
1921                                 my $alt = PDFJ::Paragraph->new(
1922                                         PDFJ::Text->new($chunk->{String}, $altstyle),
1923                                         PDFJ::ParagraphStyle->new(size => $rubysize,
1924                                                 align => 'ruby', linefeed => 0));
1925                                 $chunk->{AltObj} = $alt;
1926                                 $chunk->{RubyText} = $rubytext;
1927                         } else {
1928                                 $chunk->{RubyText} = $rubytext;
1929                         }
1930                 }
1931         }
1932 }
1933
1934 sub texts { $_[0]->{texts} }
1935 sub chunks { $_[0]->{chunks} }
1936 sub chunksnum { scalar(@{$_[0]->{chunks}}) }
1937 sub chunk { $_[0]->{chunks}[$_[1]] }
1938 sub style { $_[0]->{style} }
1939 sub direction { $_[0]->{style}{font}{direction} }
1940 sub fontsize { $_[0]->{style}{fontsize} }
1941
1942 sub width {
1943         my($self) = @_;
1944         $self->direction eq 'H' ?
1945                 _chunkssize($self->{chunks}) :
1946                 $self->fontsize;
1947 }
1948
1949 sub height {
1950         my($self) = @_;
1951         $self->direction eq 'H' ?
1952                 $self->fontsize :
1953                 _chunkssize($self->{chunks});
1954 }
1955
1956 sub left {
1957         my($self) = @_;
1958         $self->direction eq 'H' ?
1959                 0 :
1960                 - ($self->fontsize / 2);
1961 }
1962
1963 sub right {
1964         my($self) = @_;
1965         $self->direction eq 'H' ?
1966                 _chunkssize($self->{chunks}) :
1967                 $self->fontsize / 2;
1968 }
1969
1970 sub top {
1971         my($self) = @_;
1972         $self->direction eq 'H' ?
1973                 $self->fontsize * (1 - $PDFJ::Default{HBaseShift}) :
1974                 0;
1975 }
1976
1977 sub bottom {
1978         my($self) = @_;
1979         $self->direction eq 'H' ?
1980                 $self->fontsize * (- $PDFJ::Default{HBaseShift}) :
1981                 _chunkssize($self->{chunks});
1982 }
1983
1984 sub size {
1985         my($self, $direction) = @_; # neglect $direction
1986         _chunkssize($self->{chunks});
1987 }
1988
1989 sub fixsize {
1990         my($self, $start, $count, $fixedglues) = @_;
1991         _chunksfixsize($self->{chunks}, $start, $count, $fixedglues);
1992 }
1993
1994 sub count {
1995         my($self) = @_;
1996         _chunkscount($self->{chunks});
1997 }
1998
1999 sub dehyphen {
2000         my($self) = @_;
2001         return unless $self->{hyphened};
2002         my $chunks = $self->chunks;
2003         for( my $j = 0; $j < @$chunks; $j++ ) {
2004                 my $chunk = $chunks->[$j];
2005                 my $hyphened = $chunk->{Hyphened};
2006                 if( $hyphened && $j < @$chunks - 1 ) {
2007                         $chunk->{String} =~ s/-$// if $hyphened == 2;
2008                         $chunk->{String} .= $chunks->[$j + 1]->{String};
2009                         $chunk->{Count} = length $chunk->{String};
2010                         $chunk->{Hyphened} = 0;
2011                         splice @$chunks, $j + 1, 1;
2012                 }
2013         }
2014         $self->{hyphened} = 0;
2015 }
2016
2017 my %TextLineIndex = (
2018         Start => 1,
2019         Count => 2,
2020         Shift => 3,
2021         FixedGlues => 4,
2022 );
2023
2024 sub _fold {
2025         my($self, $linesize, $align) = @_;
2026         my $chunks = $self->chunks;
2027         return unless @$chunks;
2028         $self->dehyphen;
2029         my @lines;
2030         my @linesizes = ref($linesize) eq 'ARRAY' ? @$linesize : ($linesize);
2031         my $lastlinesize = $linesizes[$#linesizes];
2032         my $rubyshift;
2033         if( $align eq 'ruby' ) {
2034                 $rubyshift = ($linesizes[0] - _chunkssize($chunks)) / $self->count;
2035                 $linesizes[0] -= $rubyshift;
2036                 $rubyshift /= 2;
2037                 $align = 'W';
2038         }
2039         my $start = 0;
2040         while( $start < @$chunks ) {
2041                 $linesize = @linesizes ? shift(@linesizes) : $lastlinesize;
2042                 croak "not enough paragraph size" if $linesize < 0;
2043                 my $size = 0;
2044                 my $decsize = 0;
2045                 my $foldpos = $start;
2046                 my $canpos = $start;
2047                 my $forced;
2048                 for( my $j = $start; $j < @$chunks; $j++ ) {
2049                         my $chunk = $chunks->[$j];
2050                         if( $chunk->{Splittable} == 2 ) {
2051                                 $foldpos = $j + 1;
2052                                 $forced = 1;
2053                                 last;
2054                         }
2055                         my($chunksize, $decchunksize) = _chunksize($chunk, ($j == $start));
2056                         $size += $chunksize;
2057                         $decsize += $decchunksize unless $j == $start;
2058                         my $k = $j + 1;
2059                         if( $k == @$chunks || ($chunks->[$k]{Splittable} &&
2060                                 !_isnoeol($chunks, $k) && !_isnobol($chunks, $k)) ) {
2061                                 if( $size == $linesize ) {
2062                                         $foldpos = $k;
2063                                         last;
2064                                 } elsif( $size < $linesize ) {
2065                                         $canpos = $k;
2066                                 } else { # $size > $linesize
2067                                         my $hyphenpos = 0;
2068                                         if( $align =~ /w/i &&
2069                                                 $size - $decsize <= $linesize ) {
2070                                                 $foldpos = $k;
2071                                         } elsif( ($hyphenpos =
2072                                                 _hyphenpos($chunks->[$j], $size - $linesize)) ) {
2073                                                 _inshyphen($chunks, $j, $hyphenpos);
2074                                                 $self->{hyphened} = 1;
2075                                                 $foldpos = $k;
2076                                         } elsif( $k == $start + 1 ) {
2077                                                 $foldpos = $k;
2078                                         } else {
2079                                                 $foldpos = $canpos;
2080                                         }
2081                                         last;
2082                                 }
2083                         }
2084 #print "$j:$start:($chunk->{Splittable})[$chunk->{String}] $chunksize(-$decchunksize) $size(-$decsize) $canpos\n";
2085                 }
2086                 if( $foldpos == $start && $size > $linesize &&
2087                                 !($align =~ /w/i && $size - $decsize <= $linesize) ) {
2088                         $foldpos =  $canpos;
2089                 }
2090                 $foldpos = @$chunks if $foldpos == $start;
2091                 my $nextpos = $foldpos;
2092                 unless( $forced ) {
2093                         while( $nextpos < @$chunks && $chunks->[$nextpos]{Class} eq 16 ) {
2094                                 $nextpos++;
2095                         }
2096                 }
2097                 while( $foldpos > 0 && ($chunks->[$foldpos - 1]{Class} eq 16 ||
2098                                 $chunks->[$foldpos - 1]{Splittable} == 2) ) {
2099                         $foldpos--;
2100                 }
2101                 my $count = $foldpos - $start;
2102                 $size = _chunkssize($chunks, $start, $count);
2103                 my $shift = 0;
2104                 my $fixedglues = [];
2105                 if( $align eq 'e' ) {
2106                         $shift = $linesize - $size;
2107                 } elsif( $align eq 'm' ) {
2108                         $shift = ($linesize - $size) / 2;
2109                 } elsif( $align eq 'W' || ($align eq 'w' && $count &&
2110                         (($nextpos < @$chunks && $chunks->[$foldpos]{Splittable} != 2)
2111                         || $size > $linesize)) ) {
2112                         $fixedglues = $self->fixglue($start, $count, $linesize - $size);
2113                         if( $rubyshift ) {
2114                                 $shift = $rubyshift + ($linesize -
2115                                         $self->fixsize($start, $count, $fixedglues)) / 2;
2116                         }
2117                 }
2118                 push @lines, [\%TextLineIndex, $start, $count, $shift, $fixedglues];
2119                 $start = $nextpos;
2120         }
2121         @lines;
2122 }
2123
2124 sub _hyphenpos {
2125         my($chunk, $decsize) = @_;
2126         return unless $chunk->{Class} == 17 && !$chunk->{Style}{nohyphen} &&
2127                 !$chunk->{Style}{ruby};
2128         my $string = $chunk->{String};
2129 #print "$string, $decsize\n";
2130         my($can, $canleft, $pre, $word);
2131         if( $string =~ /([A-Za-z]-)([A-Za-z])/ ) {
2132                 $can = $`.$1;
2133                 $canleft = $2.$';
2134         } elsif( $string =~ /[A-Za-z]{5,}/ ) {
2135                 $pre = $`;
2136                 $word = $&;
2137         }
2138         return unless $can || $word;
2139         my $fontobj = $chunk->{Style}{font};
2140         my $fontsize = $chunk->{Style}{fontsize};
2141         $decsize /= $fontsize;
2142         if( $can ) {
2143                 if( $fontobj->astring_fontwidth($canleft) >= $decsize ) {
2144                         return length($can);
2145                 } else {
2146                         return;
2147                 }
2148         }
2149         my $size = $fontobj->astring_fontwidth($word);
2150         return if $size <= $decsize;
2151         my $maxsize = $size - $decsize;
2152         for my $pos(reverse PDFJ::Util::hyphenate($word)) {
2153                 return length($pre) + $pos
2154                         if $fontobj->astring_fontwidth($pre.substr($word, 0, $pos).'-')
2155                                 <= $maxsize;
2156         }
2157         return;
2158 }
2159
2160 sub _inshyphen {
2161         my($chunks, $idx, $hyphenpos) = @_;
2162         my $chunk = $chunks->[$idx];
2163         my $string = $chunk->{String};
2164         my $inschunk;
2165         @$inschunk = @$chunk;
2166         my $work = substr $string, 0, $hyphenpos;
2167         if( $work =~ /-$/ ) {
2168                 $chunk->{Hyphened} = 1;
2169         } else {
2170                 $chunk->{Hyphened} = 2;
2171                 $work .= '-';
2172         }
2173         $chunk->{String} = $work;
2174         $chunk->{Count} = length $chunk->{String};
2175         $inschunk->{String} = substr $string, $hyphenpos;
2176         $inschunk->{Count} = length $inschunk->{String};
2177         splice @$chunks, $idx + 1, 0, $inschunk;
2178 }
2179
2180 sub _chunkssize {
2181         my($chunks, $start, $count) = @_;
2182         $start += 0;
2183         $start = 0 if $start < 0;
2184         $count ||= @$chunks - $start;
2185         my $result;
2186         for(my $j = 0; $j < $count && $start + $j < @$chunks; $j++ ) {
2187                 $result += _chunksize($chunks->[$start + $j], ($j == 0));
2188         }
2189         $result;
2190 }
2191
2192 sub _chunksfixsize {
2193         my($chunks, $start, $count, $fixedglues) = @_;
2194         $start += 0;
2195         $start = 0 if $start < 0;
2196         $count ||= @$chunks - $start;
2197         my $result;
2198         for(my $j = 0; $j < $count && $start + $j < @$chunks; $j++ ) {
2199                 $result += _chunkfixsize($chunks->[$start + $j], $fixedglues->[$j]);
2200         }
2201         $result;
2202 }
2203
2204 sub _chunkscount {
2205         my($chunks, $start, $count) = @_;
2206         $start += 0;
2207         $start = 0 if $start < 0;
2208         $count ||= @$chunks - $start;
2209         my $result;
2210         for(my $j = 0; $j < $count && $start + $j < @$chunks; $j++ ) {
2211                 $result += _chunkcount($chunks->[$start + $j]);
2212         }
2213         $result;
2214 }
2215
2216 # check if last chunk is NoEOL
2217 sub _isnoeol {
2218         my($chunks, $pos) = @_;
2219         while( $pos > 0 && $chunks->[$pos - 1]{Class} == 16 ) {
2220                 $pos--;
2221         }
2222         return unless $pos > 0;
2223         $PDFJ::Default{NoEOL}[$chunks->[$pos - 1]{Class}];
2224 }
2225
2226 # check if next chunk is NoBOL
2227 sub _isnobol {
2228         my($chunks, $pos) = @_;
2229         while( $pos < @$chunks && $chunks->[$pos]{Class} == 16 ) {
2230                 $pos++;
2231         }
2232         return unless $pos < @$chunks;
2233         $PDFJ::Default{NoBOL}[$chunks->[$pos]{Class}];
2234 }
2235
2236 sub _chunkcount {
2237         my($chunk) = @_;
2238         $chunk->{Count};
2239 }
2240
2241 sub _chunksize {
2242         my($chunk, $noglue) = @_;
2243         my $fontobj = $chunk->{Style}{font};
2244         my $fontsize = $chunk->{Style}{fontsize};
2245         my $direction = $fontobj->{direction};
2246         my $size = $direction eq 'H' ?
2247                 _chunkfontsizeH($fontobj, $fontsize, $chunk) :
2248                 _chunkfontsizeV($fontobj, $fontsize, $chunk);
2249         $size += $fontsize * (($noglue ? 0 : $chunk->{Glue}) -
2250                 $chunk->{PreShift} - $chunk->{PostShift});
2251         if( wantarray ) {
2252                 my $decsize = $chunk->{GlueDec} * $fontsize;
2253                 my $incsize = $chunk->{GlueInc} * $fontsize;
2254                 ($size, $decsize, $incsize);
2255         } else {
2256                 $size;
2257         }
2258 }
2259
2260 sub _chunkfixsize {
2261         my($chunk, $fixedglue) = @_;
2262         $fixedglue ||= 0;
2263         my $fontobj = $chunk->{Style}{font};
2264         my $fontsize = $chunk->{Style}{fontsize};
2265         my $direction = $fontobj->{direction};
2266         my $size = $direction eq 'H' ?
2267                 _chunkfontsizeH($fontobj, $fontsize, $chunk) :
2268                 _chunkfontsizeV($fontobj, $fontsize, $chunk);
2269         $size += $fontsize * ($fixedglue -
2270                 $chunk->{PreShift} - $chunk->{PostShift});
2271         $size;
2272 }
2273
2274 sub _chunkfontsizeH {
2275         my($fontobj, $fontsize, $chunk) = @_;
2276         return $chunk->{AltObj}->size('H') if $chunk->{AltObj};
2277         my $size = 0;
2278         if( UNIVERSAL::isa($fontobj, "PDFJ::JFont") ) {
2279                 my $combo = $fontobj->{combo};
2280                 my $hfont = $fontobj->{hfontobj};
2281                 my $mode = $chunk->{Mode};
2282                 if( $mode eq 'z' ) {
2283                         $size = $chunk->{Count};
2284                 } elsif( $mode eq 'h' ) {
2285                         $size = $chunk->{Count} / 2;
2286                 } elsif( $combo ) {
2287                         $size = $hfont->string_fontwidth($chunk->{String});
2288                 } else {
2289                         $size = $chunk->{Count} / 2;
2290                 }
2291         } elsif( UNIVERSAL::isa($fontobj, "PDFJ::AFont") ) {
2292                 $size = $fontobj->string_fontwidth($chunk->{String});
2293         } else {
2294                 croak "internal error: missing font object";
2295         }
2296         $size *= $fontsize;
2297         $size;
2298 }
2299
2300 sub _chunkfontsizeV {
2301         my($fontobj, $fontsize, $chunk) = @_;
2302         return $chunk->{AltObj}->size('V') if $chunk->{AltObj};
2303         my $size = 0;
2304         if( UNIVERSAL::isa($fontobj, "PDFJ::JFont") ) {
2305                 my $combo = $fontobj->{combo};
2306                 my $hfont = $fontobj->{hfontobj};
2307                 my $mode = $chunk->{Mode};
2308                 if( $mode eq 'z' ) {
2309                         $size = $chunk->{Count};
2310                 } elsif( $mode eq 'h' ) {
2311                         $size = $chunk->{Count};
2312                 } elsif( $combo ) {
2313                         $size = $chunk->{Class} == 11 ? 1 :
2314                                 $hfont->string_fontwidth($chunk->{String});
2315                 } else {
2316                         $size = $chunk->{Count};
2317                 }
2318         } elsif( UNIVERSAL::isa($fontobj, "PDFJ::AFont") ) {
2319                 $size = $fontobj->string_fontwidth($chunk->{String});
2320         } else {
2321                 croak "internal error: missing font object";
2322         }
2323         $size *= $fontsize;
2324         $size;
2325 }
2326
2327
2328 sub fixglue {
2329         my($self, $start, $count, $incsize) = @_;
2330         return unless $incsize;
2331         if( $incsize > 0 ) {
2332                 &fixglueinc;
2333         } else {
2334                 &fixgluedec;
2335         }
2336 }
2337
2338 sub fixglueinc {
2339         my($self, $start, $count, $incsize) = @_;
2340         my @fixedglues;
2341         my %incgluesum;
2342         my $chunksnum = $self->chunksnum;
2343         # start counter is not 0 but 1 because first chunk glue is not used
2344         for( my $j = 1; $j < $count && $start + $j < $chunksnum; $j++ ) {
2345                 my $chunk = $self->chunk($start + $j);
2346                 if( $chunk->{GlueInc} ) {
2347                         $incgluesum{$chunk->{GluePref} + 0} +=
2348                                 $chunk->{GlueInc} * $chunk->{Style}{fontsize};
2349                 }
2350         }
2351         for my $pref(reverse sort keys %incgluesum) {
2352                 last if $incsize <= 0;
2353                 my $incgluesum = $incgluesum{$pref};
2354                 my $ratio = $incgluesum > $incsize ? $incsize / $incgluesum : 1;
2355                 for( my $j = 1; $j < $count && $start + $j < $chunksnum; $j++ ) {
2356                         my $chunk = $self->chunk($start + $j);
2357                         if( $chunk->{GlueInc} && $chunk->{GluePref} == $pref ) {
2358                                 #$chunk->{GlueFix} = $chunk->{GlueInc} * $ratio;
2359                                 $fixedglues[$j] = $chunk->{GlueInc} * $ratio;
2360                         }
2361                 }
2362                 #$incsize -= $incgluesum * $ratio;
2363                 $incsize -= $incgluesum;
2364         }
2365         if( $incsize > 0 ) {
2366                 my $splittables = 0;
2367                 for( my $j = 1; $j < $count && $start + $j < $chunksnum; $j++ ) {
2368                         $splittables++ if $self->chunk($start + $j)->{Splittable};
2369                 }
2370                 if( $splittables ) {
2371                         for( my $j = 1; $j < $count && $start + $j < $chunksnum; $j++ ) {
2372                                 my $chunk = $self->chunk($start + $j);
2373                                 if( $chunk->{Splittable} ) {
2374                                         #$chunk->{GlueFix} += $incsize / $chunk->{Style}{fontsize} /
2375                                         #       $splittables;
2376                                         $fixedglues[$j] += $incsize / $chunk->{Style}{fontsize} /
2377                                                 $splittables;
2378                                 }
2379                         }
2380                 }
2381         }
2382         \@fixedglues;
2383 }
2384
2385 sub fixgluedec {
2386         my($self, $start, $count, $incsize) = @_;
2387         my $decsize = -$incsize;
2388         my @fixedglues;
2389         my %decgluesum;
2390         my $chunksnum = $self->chunksnum;
2391         # start counter is not 0 but 1 because first chunk glue is not used
2392         for( my $j = 1; $j < $count && $start + $j < $chunksnum; $j++ ) {
2393                 my $chunk = $self->chunk($start + $j);
2394                 if( $chunk->{GlueDec} ) {
2395                         $decgluesum{$chunk->{GluePref} + 0} +=
2396                                 $chunk->{GlueDec} * $chunk->{Style}{fontsize};
2397                 }
2398         }
2399         for my $pref(reverse sort keys %decgluesum) {
2400                 last if $decsize <= 0;
2401                 my $decgluesum = $decgluesum{$pref};
2402                 my $ratio = $decgluesum > $decsize ? $decsize / $decgluesum : 1;
2403                 for( my $j = 1; $j < $count && $start + $j < $chunksnum; $j++ ) {
2404                         my $chunk = $self->chunk($start + $j);
2405                         if( $chunk->{GlueDec} && $chunk->{GluePref} == $pref ) {
2406                                 #$chunk->{GlueFix} = -$chunk->{GlueDec} * $ratio;
2407                                 $fixedglues[$j] = -$chunk->{GlueDec} * $ratio;
2408                         }
2409                 }
2410                 #$decsize -= $decgluesum * $ratio;
2411                 $decsize -= $decgluesum;
2412         }
2413         \@fixedglues;
2414 }
2415
2416 sub _show {
2417         my($self, $page, $x, $y) = @_;
2418         $self->_showpart($page, $x, $y, 0, $self->chunksnum);
2419 }
2420
2421 # This mega subroutine is too complex and patchy, needs refactering!
2422 sub _showpart {
2423         my($self, $page, $x, $y, $start, $count, $fixedglues) = @_;
2424         my $docobj = $page->docobj;
2425         my $chunksnum = $self->chunksnum;
2426         my %usefontname;
2427         my($tj, $dotpdf, $shapepdf) = ("") x 3;
2428         my $lasttextspec = PDFJ::TextSpec->new;
2429         my($ulx, $uly, $bxx, $bxy);
2430         my($lastfontsize, $postshift, $slant, $lastfrx, $lastfry, $va) = (0) x 6;
2431         my($lastfontname, $withlinestyle, $withbox, $withboxstyle) = ("") x 4;
2432         for( my $j = 0; $j < $count && $start + $j < $chunksnum; $j++ ) {
2433                 my $chunk = $self->chunk($start + $j);
2434                 my $mode = $chunk->{Mode};
2435                 my $class = $chunk->{Class};
2436                 # my $style = $chunk->{Style};
2437                 my $style = $chunk->{Style}->clone;
2438                 my $direction = $style->{font}->{direction};
2439                 my($fontname, $hname) = $style->selectfontname($mode);
2440                 my $fontobj = $style->{font} = $docobj->_fontobj($fontname, $hname);
2441                 my $combo = $fontobj->{combo};
2442                 my $usefname = $mode eq 'a' && $hname ? $hname : $fontname;
2443                 $usefontname{$usefname}++;
2444                 my $fontsize = $style->{fontsize};
2445                 $postshift *= $lastfontsize / $fontsize;
2446                 $style->{slant} = 1 if $mode eq 'z' && $style->{italic};
2447                 my $textspec = PDFJ::TextSpec->new($style, $usefname);
2448                 if( $direction eq 'V' && $combo && $mode eq 'a' ) {
2449                         if( $va != $class ) {
2450                                 my($vax, $vay) = $class == 11 ?
2451                                         ($x - _chunkfontsizeH($fontobj, $fontsize, $chunk) / 2,
2452                                         $y - $fontsize * $PDFJ::Default{VHShift}) :
2453                                         ($x + $fontsize * $PDFJ::Default{VAShift}, $y);
2454                                 $tj .= "] TJ ET Q " if $tj;
2455                                 $tj .= $class == 11 ?
2456                                         $textspec->pdf."$vax $vay Td  [" :
2457                                         $textspec->pdf."0 -1 1 0 $vax $vay Tm [";
2458                                 $lasttextspec->copy($textspec);
2459                                 $va = $class;
2460                         }
2461                 } elsif( $va ) {
2462                         $tj .= "] TJ ET Q " if $tj;
2463                         $tj .= $textspec->pdf."$x $y Td [";
2464                         $lasttextspec->copy($textspec);
2465                         $va = 0;
2466                 }
2467                 if( $style->{slant} ) {
2468                         #croak "slant style for ascii not allowed"
2469                         #       if $mode eq 'a';
2470                         unless( $slant ) {
2471                                 my($sx, $sy) = $direction eq 'H' ?
2472                                         (0, $PDFJ::Default{SlantRatio}) :
2473                                         ($PDFJ::Default{SlantRatio}, 0);
2474                                 $tj .= "] TJ ET Q " if $tj;
2475                                 $tj .= $textspec->pdf."1 $sx $sy 1 $x $y Tm [";
2476                                 $lasttextspec->copy($textspec);
2477                                 $slant = 1;
2478                         }
2479                 } elsif( $slant ) {
2480                         $tj .= "] TJ ET Q " if $tj;
2481                         $tj .= $textspec->pdf."$x $y Td [";
2482                         $lasttextspec->copy($textspec);
2483                         $slant = 0;
2484                 }
2485                 unless( $lasttextspec->equal($textspec) ) {
2486                         $tj .= "] TJ ET Q " if $tj;
2487                         $tj .= $textspec->pdf."$x $y Td [";
2488                         $lasttextspec->copy($textspec);
2489                 }
2490                 my $shift = $va == 11 ? 0 : $j == 0 ? $chunk->{PreShift} :
2491                         $postshift + $chunk->{PreShift} -
2492                         ($fixedglues ? $chunk->{Glue} + ($fixedglues->[$j] || 0):
2493                         $chunk->{Glue});
2494                 $shift = -$shift if $direction eq 'V';
2495                 $shift *= 1000;
2496                 if( $shift ) {
2497                         my $vs = $va ? -$shift : $shift;
2498                         $tj .= "$vs "
2499                 }
2500                 my($flx, $fly) = ($x, $y);
2501                 my($frx, $fry) = ($x, $y);
2502                 my($fcx, $fcy) = ($x, $y);
2503                 if( $direction eq 'H' ) {
2504                         $flx -= ($postshift - ($j == 0 ? 0 :
2505                                 ($fixedglues ? $chunk->{Glue} + ($fixedglues->[$j] || 0):
2506                                 $chunk->{Glue}))) * $fontsize;
2507                         $frx = $flx + (_chunkfontsizeH($fontobj, $fontsize, $chunk) -
2508                                 ($chunk->{PreShift} + $chunk->{PostShift}) * $fontsize);
2509                         $fcx = $flx + (_chunkfontsizeH($fontobj, $fontsize, $chunk) -
2510                                 ($chunk->{PreShift} + $chunk->{PostShift}) * $fontsize) /
2511                                  2;
2512                 } else {
2513                         $fly += ($postshift - ($j == 0 ? 0 :
2514                                 ($fixedglues ? $chunk->{Glue} + ($fixedglues->[$j] || 0):
2515                                 $chunk->{Glue}))) * $fontsize;
2516                         $fry = $fly - (_chunkfontsizeV($fontobj, $fontsize, $chunk) -
2517                                 ($chunk->{PreShift} + $chunk->{PostShift}) * $fontsize);
2518                         $fcy = $fly - (_chunkfontsizeV($fontobj, $fontsize, $chunk) -
2519                                 ($chunk->{PreShift} + $chunk->{PostShift}) * $fontsize) /
2520                                  2;
2521                 }
2522                 if( $mode eq 'O' || $mode eq 'D' ) { # Outline or Dest
2523                         my($ox, $oy) = ($flx, $fly);
2524                         if( $direction eq 'H' ) {
2525                                 $oy += (1 - $PDFJ::Default{HBaseShift}) * $fontsize;
2526                         } else {
2527                                 $ox -= $fontsize / 2;
2528                         }
2529                         if( $mode eq 'O' ) {
2530                                 my $title = $style->{outlinetitle};
2531                                 my $level = $style->{outlinelevel};
2532                                 $docobj->add_outline($title, $page->dest('XYZ', $ox, $oy, 0),
2533                                         $level);
2534                         } elsif( $mode eq 'D' ) {
2535                                 my $name = $style->{destname};
2536                                 $docobj->add_dest($name, $page->dest('XYZ', $ox, $oy, 0));
2537                         }
2538                 }
2539                 if( $chunk->{AltObj} ) {
2540                         my $altobj = $chunk->{AltObj};
2541                         my $altsize = $altobj->size($direction);
2542                         my $objalign = $style->{objalign} || "";
2543                         my $align;
2544                         my($asx, $asy) = (0, 0);
2545                         if( $direction eq 'H' ) {
2546                                 if( $objalign =~ /t/ ) {
2547                                         $align = 'tl';
2548                                         $asy += (1 - $PDFJ::Default{HBaseShift}) * $fontsize;
2549                                 } elsif( $objalign =~ /m/ ) {
2550                                         $align = 'ml';
2551                                         $asy += (0.5 - $PDFJ::Default{HBaseShift}) * $fontsize;
2552                                 } else { # /b/
2553                                         $align = 'bl';
2554                                         $asy += (- $PDFJ::Default{HBaseShift}) * $fontsize;
2555                                 }
2556                         } else {
2557                                 if( $objalign =~ /l/ ) {
2558                                         $align = 'tl';
2559                                         $asx -= $fontsize / 2;
2560                                 } elsif( $objalign =~ /r/ ) {
2561                                         $align = 'tr';
2562                                         $asx += $fontsize / 2;
2563                                 } else { # /c/
2564                                         $align = 'tc';
2565                                 }
2566                         }
2567                         $altsize = $altsize * 1000 / $fontsize;
2568                         $altsize = -$altsize if $direction eq 'H';
2569                         $tj .= "$altsize ";
2570                         $altobj->show($page, $flx + $asx, $fly + $asy, $align);
2571                 } elsif( $chunk->{String} =~ /[^\x20-\x7e]/ ) {
2572                         my $ss = unpack('H*', $chunk->{String});
2573                         $tj .= "<$ss> ";
2574                 } else {
2575                         my $ss = $chunk->{String};
2576                         $ss =~ s/\\/\\\\/g;
2577                         $ss =~ s/\(/\\\(/g;
2578                         $ss =~ s/\)/\\\)/g;
2579                         $tj .= "($ss) ";
2580                 }
2581                 $postshift = $chunk->{PostShift};
2582                 if( $style->{withline} ) {
2583                         ($ulx, $uly) = ($flx, $fly) unless defined $ulx;
2584                         $withlinestyle = $style->{withlinestyle};
2585                         if( $j == $count - 1 || $start + $j == $chunksnum - 1 ) {
2586                                 $shapepdf .= $direction eq 'H' ?
2587                                         _withlinepdf($direction, $ulx, $uly, $frx - $ulx,
2588                                                 $fontsize, $withlinestyle) :
2589                                         _withlinepdf($direction, $ulx, $uly, $fry - $uly,
2590                                                 $fontsize, $withlinestyle);
2591                         }
2592                 } elsif( defined $ulx ) {
2593                         $shapepdf .= $direction eq 'H' ?
2594                                 _withlinepdf($direction, $ulx, $uly, $lastfrx - $ulx,
2595                                         $lastfontsize, $withlinestyle) :
2596                                 _withlinepdf($direction, $ulx, $uly, $lastfry - $uly,
2597                                         $lastfontsize, $withlinestyle);
2598                         undef $ulx;
2599                         undef $uly;
2600                 }
2601                 if( $style->{withbox} ) {
2602                         ($bxx, $bxy) = ($flx, $fly) unless defined $bxx;
2603                         $withbox = $style->{withbox};
2604                         $withboxstyle = $style->{withboxstyle};
2605                         if( $j == $count - 1 || $start + $j == $chunksnum - 1 ) {
2606                                 $shapepdf .= $direction eq 'H' ?
2607                                         _withboxpdf($page, $direction, $bxx, $bxy, $frx - $bxx,
2608                                                 $fontsize, $withbox, $withboxstyle) :
2609                                         _withboxpdf($page, $direction, $bxx, $bxy, $fry - $bxy,
2610                                                 $fontsize, $withbox, $withboxstyle);
2611                         }
2612                 } elsif( defined $bxx ) {
2613                         $shapepdf .= $direction eq 'H' ?
2614                                 _withboxpdf($page, $direction, $bxx, $bxy, $lastfrx - $bxx,
2615                                         $lastfontsize, $withbox, $withboxstyle) :
2616                                 _withboxpdf($page, $direction, $bxx, $bxy, $lastfry - $bxy,
2617                                         $lastfontsize, $withbox, $withboxstyle);
2618                         undef $bxx;
2619                         undef $bxy;
2620                 }
2621                 if( $style->{withdot} ) {
2622                         croak "withdot style needs JFont"
2623                                 unless UNIVERSAL::isa($fontobj, "PDFJ::JFont");
2624                         my($dx, $dy, $ds, $dcode);
2625                         if( $direction eq 'H' ) {
2626                                 ($dx, $dy, $ds) = (
2627                                         $fcx - $fontsize / 2 + $fontsize * $PDFJ::Default{HDotXShift},
2628                                         $fcy + $fontsize * $PDFJ::Default{HDotYShift},
2629                                         $fontsize);
2630                                 $dcode = unpack('H*', $PDFJ::Default{HDot}{$PDFJ::Default{Jcode}})
2631                         } else {
2632                                 ($dx, $dy, $ds) =
2633                                         ($fcx + $fontsize * $PDFJ::Default{VDotXShift},
2634                                         $fcy + $fontsize / 2 + $fontsize * $PDFJ::Default{VDotYShift},
2635                                         $fontsize);
2636                                 $dcode = unpack('H*', $PDFJ::Default{VDot}{$PDFJ::Default{Jcode}})
2637                         }
2638                         my $fontname = $fontobj->{zname};
2639                         $dotpdf .= "BT 0 Ts 0 Tr /$fontname $ds Tf $dx $dy Td <$dcode> Tj ET ";
2640                 }
2641                 if( $chunk->{RubyText} ) {
2642                         my $rubytext = $chunk->{RubyText};
2643                         if( $direction eq 'H' ) {
2644                                 $rubytext->show($page, $flx,
2645                                         $fly + $PDFJ::Default{ORuby} * $fontsize / 1000);
2646                         } else {
2647                                 $rubytext->show($page,
2648                                         $flx + $PDFJ::Default{RRuby} * $fontsize / 1000,
2649                                         $fly);
2650                         }
2651                 }
2652                 if( $style->{withnote} ) {
2653                         my $notetext = $style->{withnote};
2654                         my $notesize = $notetext->size;
2655                         if( $direction eq 'H' ) {
2656                                 $notetext->show($page, $frx - $notesize,
2657                                         $fry + $PDFJ::Default{HNote} * $fontsize / 1000);
2658                         } else {
2659                                 $notetext->show($page,
2660                                         $frx + $PDFJ::Default{VNote} * $fontsize / 1000,
2661                                         $fry + $notesize);
2662                         }
2663                 }
2664                 ($lastfrx, $lastfry) = ($frx, $fry);
2665                 $lastfontsize = $fontsize;
2666                 if( $direction eq 'H' ) {
2667                         $x += _chunkfontsizeH($fontobj, $fontsize, $chunk) -
2668                                 $shift * $fontsize / 1000;
2669                 } else {
2670                         $y -= _chunkfontsizeV($fontobj, $fontsize, $chunk) +
2671                                 $shift * $fontsize / 1000;
2672                 }
2673         }
2674         $tj .= "] TJ ET Q " if $tj;
2675         $tj =~ s/> <//g;
2676         $tj =~ s/\) \(//g;
2677         $page->addcontents($shapepdf);
2678         $page->addcontents($tj);
2679         $page->addcontents($dotpdf);
2680         $page->usefonts(keys %usefontname);
2681 }
2682
2683 sub _withlinepdf {
2684         my($direction, $x, $y, $w, $fontsize, $style) = @_;
2685         my $shape = PDFJ::Shape->new;
2686         if( $direction eq 'H' ) {
2687                 $shape->textuline($x, $y, $w, $fontsize, $style);
2688         } else {
2689                 $shape->textrline($x, $y, $w, $fontsize, $style);
2690         }
2691         $shape->pdf;
2692 }
2693
2694 sub _withboxpdf {
2695         my($page, $direction, $x, $y, $w, $fontsize, $spec, $style) = @_;
2696         my $shape = PDFJ::Shape->new;
2697         $shape->textbox($direction, $x, $y, $w, $fontsize, $spec,
2698                 $style);
2699         $shape->show_link($page);
2700         $shape->pdf;
2701 }
2702
2703 # string splitting
2704
2705 # character classes are
2706 # 0: begin paren
2707 # 1: end paren
2708 # 2: not at top of line
2709 # 3: ?!
2710 # 4: dot
2711 # 5: punc
2712 # 6: leader
2713 # 7: pre unit
2714 # 8: post unit
2715 # 9: zenkaku space
2716 # 10: hirakana
2717 # 11: japanese
2718 # 12: suffixed
2719 # 13: rubied
2720 # 14: number
2721 # 15: unit
2722 # 16: space
2723 # 17: ascii
2724
2725 # modes are
2726 # 'z': zenkaku Japanese
2727 # 'h': hankaku Japanese
2728 # 'a': ascii
2729 # 'S': ShowableObj
2730 # 'N': Newline
2731 # 'O': Outline
2732 # 'D': Destination
2733
2734 # chunk array index
2735 my %ChunkIndex = (
2736         Style => 1,                     # PDFJ::TextStyle object
2737         Mode => 2,                      # description as above
2738         Class => 3,                     # description as above
2739         Splittable => 4,        # 1 for splittable at pre-postion
2740         Glue => 5,                      # normal glue width
2741         GlueDec => 6,           # decrease adjustable glue width
2742         GlueInc => 7,           # increase adjustable glue width
2743         GluePref => 8,          # glue preference
2744         Count => 9,                     # characters count
2745         String => 10,           # characters string
2746         PreShift => 11,         # postion shift at pre-postion
2747         PostShift => 12,        # postion shift at post-postion
2748         GlueFix => 13,          # fixed glue (to be calculated)
2749         Hyphened => 14,         # 1 for splitted, 2 for hyphened
2750         RubyText => 15,         # ruby PDFJ::Text object
2751         AltObj => 16,           # alternative object for String
2752 );
2753
2754 sub _specialchunk {
2755         my($style, $mode, $class, $splittable) = @_;
2756         [\%ChunkIndex, $style, $mode, $class, $splittable,
2757                 0, 0, 0, 0, 0, "", 0, 0];
2758 }
2759
2760 sub _newlinechunk {
2761         my($textstyle) = @_;
2762         _specialchunk($textstyle, 'N', 11, 2);
2763 }
2764
2765 sub _outlinechunk {
2766         my($outlineobj, $textstyle) = @_;
2767         my $style = $textstyle->clone(%$outlineobj);
2768         _specialchunk($style, 'O', 11, 1);
2769 }
2770
2771 sub _destchunk {
2772         my($destobj, $textstyle) = @_;
2773         my $style = $textstyle->clone(%$destobj);
2774         _specialchunk($style, 'D', 11, 1);
2775 }
2776
2777 sub _objchunk {
2778         my($obj, $textstyle) = @_;
2779         my $chunk = _specialchunk($textstyle, 'S', 11, 1);
2780         $chunk->{AltObj} = $obj;
2781         $chunk;
2782 }
2783
2784 # obsolete
2785 sub _imagechunk {
2786         my($img, $textstyle) = @_;
2787         my $chunk = _specialchunk($textstyle, 'I', 11, 1);
2788         $chunk->{AltObj} = $img;
2789         $chunk;
2790 }
2791
2792 # obsolete
2793 sub _shapechunk {
2794         my($shape, $textstyle) = @_;
2795         my $chunk = _specialchunk($textstyle, 'S', 11, 1);
2796         $chunk->{AltObj} = $shape;
2797         my($left, $bottom) = ($shape->left, $shape->bottom);
2798         $chunk;
2799 }
2800
2801 sub catchunks {
2802         my($self, $src) = @_;
2803         my $dest = $self->chunks;
2804         if( @$dest && @$src ) {
2805                 my($splittable, $glue, $gluedec, $glueinc, $gluepref);
2806                 my $lastclass = _lastclass($dest);
2807                 my $lastmode = _lastmode($dest);
2808                 my $fchunk = $src->[0];
2809                 my $class = $fchunk->{Class};
2810                 my $mode = $fchunk->{Mode};
2811                 my $style = $fchunk->{Style};
2812                 $splittable = $fchunk->{Splittable} == 2 ? 2 :
2813                         $style->{suffix} ? 0 :
2814                         $lastmode eq 'O' ? 0 :
2815                         $PDFJ::Default{Splittable}->[$lastclass][$class];
2816                 $glue = ($lastmode =~ /^[ON]$/ || $mode =~ /^[ON]$/) ?
2817                         PDFJ::GlueNon :
2818                         $PDFJ::Default{Glue}->[$lastclass][$class];
2819                 ($glue, $gluedec, $glueinc, $gluepref) = _calcglue($glue);
2820                 $fchunk->{Splittable} = $splittable;
2821                 $fchunk->{Glue} = $glue;
2822                 $fchunk->{GlueDec} = $gluedec;
2823                 $fchunk->{GlueInc} = $glueinc;
2824                 $fchunk->{GluePref} = $gluepref;
2825         }
2826         push @$dest, @$src;
2827 }
2828
2829 sub _appendchunks {
2830         my($chunks, $style, $mode, $class, $char, $preshift, $postshift) = @_;
2831         $preshift ||= 0;
2832         $postshift ||= 0;
2833         my($splittable, $glue, $gluedec, $glueinc, $gluepref) = (0) x 5;
2834         if( exists $style->{font} && exists $style->{font}{subset_unicodes} ) {
2835                 my $unicode = $PDFJ::Default{Jcode} eq 'SJIS' ?
2836                         PDFJ::Unicode::s2u($char) : PDFJ::Unicode::e2u($char);
2837                 $style->{font}{subset_unicodes}{$unicode}++;
2838         }
2839         if( @$chunks ) {
2840                 my $lastchunk = $chunks->[$#$chunks];
2841                 my $lastmode = $lastchunk->{Mode};
2842                 my $lastclass = $lastchunk->{Class};
2843                 my $lastruby = $lastchunk->{Style}{ruby};
2844                 $splittable = $style->{suffix} ? 0 :
2845                         $lastmode eq 'O' ? 0 :
2846                         $PDFJ::Default{Splittable}->[$lastclass][$class];
2847                 $glue = ($lastmode =~ /^[ON]$/ || $mode =~ /^[ON]$/) ?
2848                         PDFJ::GlueNon :
2849                         $PDFJ::Default{Glue}->[$lastclass][$class];
2850                 if( ($mode eq 'a' && $lastmode eq 'a' && $class == $lastclass &&
2851                         ($class == 11 || (!@$glue && !$splittable))) ||
2852                         ($style->{ruby} && $style->{ruby} eq $lastruby &&
2853                         ($class == 11 || $class == 17) && $class == $lastclass)
2854                          ) {
2855                         $lastchunk->{Count}++;
2856                         $lastchunk->{String} .= $char;
2857                         return;
2858                 }
2859                 ($glue, $gluedec, $glueinc, $gluepref) = _calcglue($glue);
2860         }
2861         push @$chunks, [\%ChunkIndex, $style, $mode, $class, $splittable,
2862                 $glue, $gluedec, $glueinc, $gluepref, 1, $char,
2863                 $preshift, $postshift];
2864 }
2865
2866 sub _calcglue {
2867         my($glue) = @_;
2868         my($gluedec, $glueinc, $gluepref) = (0, 0, 0);
2869         if( @$glue ) {
2870                 my($gmin, $gnormal, $gmax, $gpref) = @$glue;
2871                 ($glue, $gluedec, $glueinc) = (
2872                         $gnormal / 1000,
2873                         ($gnormal - $gmin) / 1000,
2874                         ($gmax - $gnormal) / 1000
2875                 );
2876                 $gluepref = $gpref || 0;
2877         } else {
2878                 ($glue, $gluedec, $glueinc, $gluepref) = (0, 0, 0, 0);
2879         }
2880         ($glue, $gluedec, $glueinc, $gluepref);
2881 }
2882
2883 sub _lastclass {
2884         my($chunks) = @_;
2885         @$chunks ? $chunks->[$#$chunks]{Class} : undef;
2886 }
2887
2888 sub _lastmode {
2889         my($chunks) = @_;
2890         @$chunks ? $chunks->[$#$chunks]{Mode} : undef;
2891 }
2892
2893 sub splittext {
2894         my($self, $str) = @_;
2895         if(  UNIVERSAL::isa($self->style->{font}, "PDFJ::AFont") ) {
2896                 &splittext_ASCII;
2897         } elsif( $PDFJ::Default{Jcode} eq 'SJIS' ) {
2898                 &splittext_SJIS;
2899         } else {
2900                 &splittext_EUC;
2901         }
2902 }
2903
2904 sub splittext_ASCII {
2905         my($self, $str) = @_;
2906         my $style = $self->style;
2907         my $result = [];
2908         my @c = split('', $str);
2909         for( my $j = 0; $j <= $#c; $j++ ) {
2910                 my $c = $c[$j];
2911                 if( $c eq " " ) {
2912                         _appendchunks($result, $style, 'a', 16, $c);
2913                 } else {
2914                         if( $style->{vh} ) {
2915                                 _appendchunks($result, $style, 'a', 11, $c);
2916                         } elsif( $c =~ /[0-9]/ ) {
2917                                 _appendchunks($result, $style, 'a', 14, $c);
2918                         } elsif( $c =~ /[,. ]/ && _lastclass($result) == 14 &&
2919                                 $c[$j+1] =~ /[0-9]/ ) {
2920                                 _appendchunks($result, $style, 'a', 14, $c);
2921                         } else {
2922                                 _appendchunks($result, $style, 'a', 17, $c);
2923                         }
2924                 }
2925         }
2926         $result;
2927 }
2928
2929 sub splittext_EUC {
2930         my($self, $str) = @_;
2931         my $style = $self->style;
2932         my $result = [];
2933         my @c = split('', $str);
2934         for( my $j = 0; $j <= $#c; $j++ ) {
2935                 my $c = $c[$j];
2936                 if( $c eq "\x8e" ) {
2937                         _appendchunks($result, $style, 'h', 11, $c.$c[$j+1]);
2938                         $j++;
2939                 } elsif( $c eq "\x8f" ) {
2940                         _appendchunks($result, $style, 'z', 11, $c.$c[$j+1].$c[$j+2]);
2941                         $j += 2;
2942                 } elsif( $c eq " " ) {
2943                         _appendchunks($result, $style, 'a', 16, $c);
2944                 } elsif( $c lt "\xa0" ) {
2945                         if( $style->{vh} ) {
2946                                 _appendchunks($result, $style, 'a', 11, $c);
2947                         } elsif( $c =~ /[0-9]/ ) {
2948                                 _appendchunks($result, $style, 'a', 14, $c);
2949                         } elsif( $c =~ /[,. ]/ && _lastclass($result) == 14 &&
2950                                 $c[$j+1] =~ /[0-9]/ ) {
2951                                 _appendchunks($result, $style, 'a', 14, $c);
2952                         } else {
2953                                 _appendchunks($result, $style, 'a', 17, $c);
2954                         }
2955                 } else {
2956                         my $k = $c.$c[$j+1];
2957                         $j++;
2958                         my $class = $PDFJ::Default{Class}{EUC}{$k};
2959                         unless( defined $class ) {
2960                                 if( $k ge "\xa4\xa1" && $k le "\xa4\xf3" ) {
2961                                         $class = 10;
2962                                 } else {
2963                                         $class = 11;
2964                                 }
2965                         }
2966                         my $preshift = ($PDFJ::Default{PreShift}{EUC}{$k} || 0) / 1000;
2967                         my $postshift = ($PDFJ::Default{PostShift}{EUC}{$k} || 0) / 1000;
2968                         _appendchunks($result, $style, 'z', $class, $k, $preshift, $postshift);
2969                 }
2970         }
2971         $result;
2972 }
2973
2974 sub splittext_SJIS {
2975         my($self, $str) = @_;
2976         my $style = $self->style;
2977         my $result = [];
2978         my @c = split('', $str);
2979         for( my $j = 0; $j <= $#c; $j++ ) {
2980                 my $c = $c[$j];
2981                 if( $c ge "\x81" && $c le "\x9f" || $c ge "\xe0" && $c le "\xfc" ) {
2982                         my $k = $c.$c[$j+1];
2983                         $j++;
2984                         my $class = $PDFJ::Default{Class}{SJIS}{$k};
2985                         unless( defined $class ) {
2986                                 if( $k ge "\x82\x9f" && $k le "\x82\xf1" ) {
2987                                         $class = 10;
2988                                 } else {
2989                                         $class = 11;
2990                                 }
2991                         }
2992                         my $preshift = ($PDFJ::Default{PreShift}{SJIS}{$k} || 0) / 1000;
2993                         my $postshift = ($PDFJ::Default{PostShift}{SJIS}{$k} || 0) / 1000;
2994                         _appendchunks($result, $style, 'z', $class, $k, $preshift, $postshift);
2995                 } elsif( $c eq " " ) {
2996                         _appendchunks($result, $style, 'a', 16, $c);
2997                 } elsif( $c ge "\xa1" && $c le "\xdf" ) {
2998                         _appendchunks($result, $style, 'h', 11, $c);
2999                 } else {
3000                         if( $style->{vh} ) {
3001                                 _appendchunks($result, $style, 'a', 11, $c);
3002                         } elsif( $c =~ /[0-9]/ ) {
3003                                 _appendchunks($result, $style, 'a', 14, $c);
3004                         } elsif( $c =~ /[,. ]/ && _lastclass($result) == 14 &&
3005                                 defined $c[$j+1] && $c[$j+1] =~ /[0-9]/ ) {
3006                                 _appendchunks($result, $style, 'a', 14, $c);
3007                         } else {
3008                                 _appendchunks($result, $style, 'a', 17, $c);
3009                         }
3010                 }
3011         }
3012         $result;
3013 }
3014
3015 #--------------------------------------------------------------------------
3016 package PDFJ::ParagraphStyle;
3017 use Carp;
3018 use strict;
3019 use vars qw(@ISA);
3020 @ISA = qw(PDFJ::Style);
3021
3022 sub PStyle { PDFJ::ParagraphStyle->new(@_) }
3023
3024 #--------------------------------------------------------------------------
3025 package PDFJ::Paragraph;
3026 use Carp;
3027 use strict;
3028 use vars qw(@ISA);
3029 @ISA = qw(PDFJ::Showable);
3030
3031 sub Paragraph { PDFJ::Paragraph->new(@_) }
3032
3033 sub new {
3034         my($class, $text, $style) = @_;
3035         croak "paragraph text argument must be a PDFJ::Text object"
3036                 unless UNIVERSAL::isa($text, 'PDFJ::Text');
3037         croak "paragraph style argument must be a PDFJ::ParagraphStyle object"
3038                 unless UNIVERSAL::isa($style, 'PDFJ::ParagraphStyle');
3039         croak "size specification missing" unless $style->{size};
3040         croak "linefeed specification missing" unless exists $style->{linefeed};
3041         croak "align specification missing" unless $style->{align};
3042         my $self = bless { text => $text, style => $style }, $class;
3043         $self->{linefeed} = $style->{linefeed} =~ /(\d+)%/ ?
3044                 $text->fontsize * $1 / 100 : $style->{linefeed};
3045         my $lineskip = $self->{linefeed} - $text->fontsize;
3046         $lineskip = 0 if $lineskip < 0;
3047         $self->{preskip} = exists $style->{preskip} ?
3048                 $style->{preskip} : $lineskip * $PDFJ::Default{ParaPreSkipRatio};
3049         $self->{postskip} = exists $style->{postskip} ?
3050                 $style->{postskip} : $lineskip * $PDFJ::Default{ParaPostSkipRatio};
3051         my $labeltext = $style->{labeltext};
3052         my $firstminindent = 0;
3053         if( $labeltext ) {
3054                 if( UNIVERSAL::isa($labeltext, 'PDFJ::Showable') ) {
3055                         $self->{labelobj} = $labeltext;
3056                 } elsif( ref($labeltext) eq 'CODE' ) {
3057                         $self->{labelobj} = &$labeltext();
3058                 } elsif( ref($labeltext) eq 'ARRAY' &&
3059                         ref($labeltext->[0]) eq 'CODE' ) {
3060                         my($func, @args) = @$labeltext;
3061                         $self->{labelobj} = &$func(@args);
3062                 } elsif( ref($labeltext) ) {
3063                         croak "unknown labeltext type";
3064                 } else {
3065                         $self->{labelobj} = $labeltext;
3066                 }
3067                 $self->{labelobj} = PDFJ::Text->new($self->{labelobj}, $text->style)
3068                         unless ref($self->{labelobj});
3069                 my $labelobjsize = $self->{labelobj}->size($self->text->direction);
3070                 $firstminindent = $labelobjsize + $self->labelskip - $self->labelsize;
3071                 $firstminindent = 0 if $firstminindent < 0;
3072         }
3073         $self->{beginindent} =
3074                 exists $style->{beginindent} ?
3075                         ref($style->{beginindent}) eq 'ARRAY' ?
3076                                 [@{$style->{beginindent}}] :
3077                                 [$style->{beginindent}] :
3078                         [0];
3079         if( $self->{beginindent}[0] < $firstminindent ) {
3080                 $self->{beginindent}[1] = $self->{beginindent}[0]
3081                         if @{$self->{beginindent}} == 1;
3082                 $self->{beginindent}[0] = $firstminindent;
3083         }
3084         $self->{endindent} =
3085                 exists $style->{endindent} ?
3086                         ref($style->{endindent}) eq 'ARRAY' ?
3087                                 [@{$style->{endindent}}] :
3088                                 [$style->{endindent}] :
3089                         [0];
3090         my @lines = $text->_fold($self->linesizes, $style->{align});
3091         $self->{lines} = \@lines;
3092         $self;
3093 }
3094
3095 sub text { $_[0]->{text} }
3096 sub linesnum { scalar(@{$_[0]->{lines}}) }
3097 sub line { $_[0]->{lines}->[$_[1]] }
3098 sub labelsize { $_[0]->{style}->{labelsize} || 0 }
3099 sub labelskip { $_[0]->{style}->{labelskip} || 0 }
3100 sub beginpadding { $_[0]->{style}->{beginpadding} || 0 }
3101 sub beginindents { scalar @{$_[0]->{beginindent}} }
3102 sub beginindent {
3103         my($self, $idx) = @_;
3104         my $count = @{$self->{beginindent}};
3105         if( $idx < $count ) {
3106                 $self->{beginindent}[$idx];
3107         } else {
3108                 $self->{beginindent}[$count - 1];
3109         }
3110 }
3111 sub endindents { scalar @{$_[0]->{endindent}} }
3112 sub endindent {
3113         my($self, $idx) = @_;
3114         my $count = @{$self->{endindent}};
3115         if( $idx < $count ) {
3116                 $self->{endindent}[$idx];
3117         } else {
3118                 $self->{endindent}[$count - 1];
3119         }
3120 }
3121 sub _size { $_[0]->{style}{size} }
3122 sub linesizes {
3123         my($self) = @_;
3124         my @linesizes;
3125         my $count = $self->beginindents > $self->endindents ?
3126                 $self->beginindents :
3127                 $self->endindents;
3128         for( my $j = 0; $j < $count; $j++ ) {
3129                 push @linesizes, $self->_size - $self->beginpadding - $self->labelsize -
3130                         $self->beginindent($j) - $self->endindent($j);
3131         }
3132         \@linesizes;
3133 }
3134 sub linefeed { $_[0]->{linefeed} }
3135 sub preskip { $_[0]->{preskip} || 0 }
3136 sub postskip { $_[0]->{postskip} || 0 }
3137 sub nobreak { $_[0]->{style}->{nobreak} }
3138 sub postnobreak { $_[0]->{style}->{postnobreak} }
3139 sub float { $_[0]->{style}->{float} || "" }
3140 sub breakable {
3141         my($self, $blockdirection) = @_;
3142         return 0 if $self->nobreak;
3143         my $direction = $self->text->direction;
3144         if( $direction eq 'H' ) {
3145                 $blockdirection eq 'V' ? 1 : 0;
3146         } else {
3147                 $blockdirection eq 'V' ? 0 : 1;
3148         }
3149 }
3150
3151 sub _linessize {
3152         my($self) = @_;
3153         $self->linesnum ?
3154                 $self->text->fontsize + ($self->linesnum - 1) * $self->linefeed : 0;
3155 }
3156
3157 sub break {
3158         my($self, @sizes) = @_;
3159         my $unbreakable = $self->nobreak;
3160         my $lastsize = $sizes[$#sizes];
3161         my @result;
3162         my @lines = @{$self->{lines}};
3163         my @beginindents = @{$self->{beginindent}};
3164         my @endindents = @{$self->{endindent}};
3165         my $second;
3166         while( @lines ) {
3167                 my $size = @sizes ? shift(@sizes) : $lastsize;
3168                 my $count = $unbreakable ?
3169                         ($size < $self->_linessize ? 0 : scalar(@lines)) :
3170                         ($size < $self->text->fontsize ? 0 :
3171                         int(($size - $self->text->fontsize) / $self->linefeed) + 1);
3172                 return if !$count && !@sizes;
3173                 my @blines = splice @lines, 0, $count;
3174                 my @bbi = splice @beginindents, 0, $count;
3175                 @beginindents = ($bbi[$#bbi]) unless @beginindents;
3176                 my @bei = splice @endindents, 0, $count;
3177                 @endindents = ($bei[$#bei]) unless @endindents;
3178                 my $bpara = bless {text => $self->{text},
3179                                 style => $self->{style},
3180                                 linefeed => $self->{linefeed}, preskip => $self->{preskip},
3181                                 postskip => $self->{postskip},
3182                                 beginindent => \@bbi, endindent => \@bei,
3183                                 labelobj => ($second ? undef : $self->{labelobj}),
3184                                 lines => \@blines}, ref($self);
3185                 $second = 1 if @blines;
3186                 push @result, $bpara;
3187         }
3188         @result;
3189 }
3190
3191 sub width {
3192         my($self) = @_;
3193         $self->text->direction eq 'H' ?
3194                 $self->_size :
3195                 $self->_linessize;
3196 }
3197
3198 sub height {
3199         my($self) = @_;
3200         $self->text->direction eq 'H' ?
3201                 $self->_linessize :
3202                 $self->_size;
3203 }
3204
3205 sub left {
3206         my($self) = @_;
3207         $self->text->direction eq 'H' ?
3208                 0 :
3209                 - ($self->_linessize - $self->text->fontsize / 2);
3210 }
3211
3212 sub right {
3213         my($self) = @_;
3214         $self->text->direction eq 'H' ?
3215                 $self->_size :
3216                 $self->text->fontsize / 2;
3217 }
3218
3219 sub top {
3220         my($self) = @_;
3221         $self->text->direction eq 'H' ?
3222                 $self->text->fontsize * $PDFJ::Default{HBaseHeight} :
3223                 0;
3224 }
3225
3226 sub bottom {
3227         my($self) = @_;
3228         $self->text->direction eq 'H' ?
3229                 - ($self->_linessize -
3230                 $self->text->fontsize * $PDFJ::Default{HBaseHeight}) :
3231                 $self->_size;
3232 }
3233
3234 sub size {
3235         my($self, $direction) = @_;
3236         if( $direction eq 'H' ) {
3237                 $self->width;
3238         } elsif( $direction eq 'V' ) {
3239                 $self->height;
3240         } else {
3241                 $self->_size;
3242         }
3243 }
3244
3245 sub _show {
3246         my($self, $page, $x, $y) = @_;
3247         for( my $j = 0; $j < $self->linesnum; $j++ ) {
3248                 ($x, $y) = $self->_showline($page, $x, $y, $j);
3249         }
3250         ($x, $y);
3251 }
3252
3253 sub _showline {
3254         my($self, $page, $x, $y, $line) = @_;
3255         return unless $line < $self->linesnum;
3256         my $style = $self->{style};
3257         my $start = $self->line($line)->{Start};
3258         my $count = $self->line($line)->{Count};
3259         my $fixedglues = $self->line($line)->{FixedGlues};
3260         my $shift = $self->line($line)->{Shift} + $self->beginpadding +
3261                 $self->labelsize + $self->beginindent($line);
3262         my $linefeed = $self->linefeed;
3263         my $text = $self->text;
3264         my $tstyle = $text->style;
3265         croak "no font specification" unless exists $tstyle->{font};
3266         my $direction = $tstyle->{font}{direction};
3267         if( $line == 0 && $self->{labelobj} ) {
3268                 my($lx, $ly) = $direction eq 'H' ? ($x + $self->beginpadding, $y) :
3269                         ($x, $y - $self->beginpadding);
3270                 $self->{labelobj}->show($page, $lx, $ly);
3271         }
3272         my($nextx, $nexty);
3273         if( $direction eq 'H' ) {
3274                 ($nextx, $nexty) = ($x, $y - $linefeed);
3275                 $x += $shift;
3276         } else {
3277                 ($nextx, $nexty) = ($x - $linefeed, $y);
3278                 $y -= $shift;
3279         }
3280         $text->_showpart($page, $x, $y, $start, $count, $fixedglues);
3281         ($nextx, $nexty);
3282 }
3283
3284 #--------------------------------------------------------------------------
3285 package PDFJ::NewBlock;
3286 use Carp;
3287 use strict;
3288 use vars qw(@ISA);
3289 @ISA = qw(PDFJ::BlockElement);
3290
3291 sub NewBlock { PDFJ::NewBlock->new(@_) }
3292
3293 sub new {
3294         my($class) = @_;
3295         bless \$class, $class;
3296 }
3297
3298 #--------------------------------------------------------------------------
3299 package PDFJ::BlockSkip;
3300 use Carp;
3301 use strict;
3302 use vars qw(@ISA);
3303 @ISA = qw(PDFJ::BlockElement);
3304
3305 sub new {
3306         my($class, $skip) = @_;
3307         bless {skip => $skip}, $class;
3308 }
3309
3310 sub size { $_[0]->{skip} || 0 }
3311
3312 #--------------------------------------------------------------------------
3313 package PDFJ::BlockStyle;
3314 use Carp;
3315 use strict;
3316 use vars qw(@ISA);
3317 @ISA = qw(PDFJ::Style);
3318
3319 sub BStyle { PDFJ::BlockStyle->new(@_) }
3320
3321 #--------------------------------------------------------------------------
3322 package PDFJ::Block;
3323 use Carp;
3324 use strict;
3325 use vars qw(@ISA);
3326 @ISA = qw(PDFJ::Showable);
3327
3328 sub Block { PDFJ::Block->new(@_); }
3329
3330 sub new {
3331         my $class = shift;
3332         my $direction = shift;
3333         my $style = pop; # not shift
3334         croak "block direction argument must be H or V or R"
3335                 unless $direction =~ /^H|V|R$/;
3336         croak "block style argument must be a PDFJ::BlockStyle object"
3337                 unless UNIVERSAL::isa($style, 'PDFJ::BlockStyle');
3338         my @objects = (@_ == 1 && ref($_[0]) eq 'ARRAY') ? @{$_[0]} : @_;
3339         for( my $j = 0; $j < @objects; $j++ ) {
3340                 if( UNIVERSAL::isa($objects[$j], 'PDFJ::BlockElement') ) {
3341                         # OK
3342                 } elsif( $objects[$j] =~ /^\d+$/ ) {
3343                         $objects[$j] = PDFJ::BlockSkip->new($objects[$j]);
3344                 } else {
3345                         croak "illegal Block element: $objects[$j]"
3346                 }
3347         }
3348         my $self = bless { direction => $direction, objects => \@objects,
3349                 xpreshift => 0, xpostshift => 0, ypreshift => 0, ypostshift => 0,
3350                 style => $style }, $class;
3351         $self->_calcsize;
3352         $self->adjustwidth($style->{width}) if $style->{width};
3353         $self->adjustheight($style->{height}) if $style->{height};
3354         $self;
3355 }
3356
3357 sub break {
3358         my($self, @sizes) = @_;
3359         my $unbreakable = $self->nobreak;
3360         my $nofirstfloat = $self->nofirstfloat;
3361         my $repeatheader = $self->repeatheader;
3362         my $lastsize = $sizes[$#sizes];
3363         my $direction = $self->{direction} eq 'V' ? 'V' : 'H';
3364         my @result;
3365         my @objects = @{$self->{objects}};
3366         my @repeatheader = $repeatheader ?
3367                         @objects[0..($repeatheader - 1)] : ();
3368         my @reserve;
3369         while( @objects || @reserve ) {
3370                 my $size = @sizes ? shift(@sizes) : $lastsize;
3371                 unshift @objects, splice(@reserve);
3372                 my @bobjects;
3373                 if( $unbreakable ) {
3374                         @bobjects = splice @objects if $size >= $self->size($direction);
3375                 } else {
3376                         my $bsize = $self->padding * 2;
3377                         while( $bsize < $size && @objects ) {
3378                                 my $obj = $objects[0];
3379                                 my $float = $obj->float;
3380                                 if( $float && @reserve ) {
3381                                         push @reserve, shift(@objects);
3382                                         next;
3383                                 }
3384                                 if( $float eq 'b' && $nofirstfloat && !@result ) {
3385                                         push @reserve, shift(@objects);
3386                                         next;
3387                                 }
3388                                 my $inspos = _inspos(\@bobjects, $float);
3389                                 my $skipsize = 0;
3390                                 if( $inspos == 0 ) {
3391                                         $skipsize = $obj->postskip + $bobjects[$inspos]->preskip
3392                                                 if @bobjects;
3393                                 } elsif( $inspos == @bobjects ) {
3394                                         $skipsize = $bobjects[$inspos - 1]->postskip + $obj->preskip;
3395                                 } else {
3396                                         $skipsize = $obj->preskip + $obj->postskip;
3397                                 }
3398                                 my $osize = $obj->size($direction);
3399                                 if( UNIVERSAL::isa($obj, 'PDFJ::NewBlock') ) {
3400                                         shift(@objects);
3401                                         last;
3402                                 } elsif( $bsize + $skipsize + $osize <= $size ) {
3403                                         splice @bobjects, $inspos, 0, shift(@objects);
3404                                         $bsize += $skipsize + $osize;
3405                                 } elsif( $obj->breakable($self->{direction}) ) {
3406                                         my @bsizes = ($size - $bsize - $skipsize,
3407                                                 map {$_ - $self->padding * 2}
3408                                                 (@sizes ? (@sizes) : ($lastsize)));
3409                                         my @parts = $obj->break(@bsizes);
3410                                         if( @parts ) {
3411                                                 $obj = $parts[0];
3412                                                 my $osize = $obj->size($direction);
3413                                                 if( $osize ) {
3414                                                         $bsize += $skipsize + $osize;
3415                                                         shift @objects;
3416                                                         unshift @objects, @parts;
3417                                                         splice @bobjects, $inspos, 0, shift(@objects);
3418                                                 } else {
3419                                                         shift @parts;
3420                                                         shift @objects;
3421                                                         unshift @objects, @parts;
3422                                                 }
3423                                                 last;
3424                                         } else {
3425                                                 return;
3426                                         }
3427                                 } else {
3428                                         if( $float ) {
3429                                                 push @reserve, shift(@objects);
3430                                         } else {
3431                                                 last;
3432                                         }
3433                                 }
3434                         }
3435                 }
3436                 while( @bobjects && $bobjects[$#bobjects]->postnobreak && @objects ) {
3437                         unshift @objects, pop(@bobjects);
3438                 }
3439                 return if !@bobjects && !@sizes;
3440                 if( $repeatheader && (@bobjects >= $repeatheader) && @objects ) {
3441                         unshift @objects, @repeatheader;
3442                 }
3443                 my $bobj;
3444                 %$bobj = %$self;
3445                 $bobj->{objects} = \@bobjects;
3446                 delete $bobj->{indents};
3447                 bless $bobj, ref($self);
3448                 $bobj->_calcsize;
3449                 push @result, $bobj;
3450         }
3451         @result;
3452 }
3453
3454 sub _inspos { # NOT method
3455         my($objects, $float) = @_;
3456         my $inspos;
3457         if( $float eq 'b' ) {
3458                 $inspos = 0;
3459                 while( $inspos < @$objects && $objects->[$inspos]->float eq 'b' ) {
3460                         $inspos++;
3461                 }
3462         } elsif( $float eq 'e' ) {
3463                 $inspos = @$objects;
3464         } else {
3465                 $inspos = @$objects;
3466                 while( $inspos > 0 && $objects->[$inspos - 1]->float eq 'e' ) {
3467                         $inspos--;
3468                 }
3469         }
3470         $inspos;
3471 }
3472
3473 sub _calcsize {
3474         my($self) = @_;
3475         my($width, $height) = (0, 0);
3476         my $objnum = @{$self->{objects}};
3477         my $adjust = $self->{style}{adjust};
3478         my $align = $self->align;
3479         if( $self->{direction} eq 'V' ) {
3480                 for( my $j = 0; $j < $objnum; $j++ ) {
3481                         my $obj = $self->{objects}->[$j];
3482                         if( $j > 0 ) {
3483                                 $height += $self->{objects}->[$j-1]->postskip + $obj->preskip;
3484                         }
3485                         if( UNIVERSAL::isa($obj, 'PDFJ::Showable') ) {
3486                                 $width = $width < $obj->width ? $obj->width : $width;
3487                                 $height += $obj->height;
3488                         } elsif( UNIVERSAL::isa($obj, 'PDFJ::BlockElement') ) {
3489                                 $height += $obj->size($self->{direction});
3490                         } else {
3491                                 croak "illegal block element";
3492                         }
3493                 }
3494                 if( $adjust ) {
3495                         for my $obj(@{$self->{objects}}) {
3496                                 $obj->adjustwidth($width) if UNIVERSAL::isa($obj, 'PDFJ::Block');
3497                         }
3498                 }
3499                 my @indents;
3500                 if( $align =~ /c/ ) {
3501                         for( my $j = 0; $j < $objnum; $j++ ) {
3502                                 my $obj = $self->{objects}->[$j];
3503                                 if( UNIVERSAL::isa($obj, 'PDFJ::Showable') ) {
3504                                         $indents[$j] = ($width - $obj->width) / 2;
3505                                 }
3506                         }
3507                 } elsif( $align =~ /r/ ) {
3508                         for( my $j = 0; $j < $objnum; $j++ ) {
3509                                 my $obj = $self->{objects}->[$j];
3510                                 if( UNIVERSAL::isa($obj, 'PDFJ::Showable') ) {
3511                                         $indents[$j] = $width - $obj->width;
3512                                 }
3513                         }
3514                 }
3515                 $self->{indents} = \@indents;
3516         } else {
3517                 for( my $j = 0; $j < $objnum; $j++ ) {
3518                         my $obj = $self->{objects}->[$j];
3519                         if( $j > 0 ) {
3520                                 $width += $self->{objects}->[$j-1]->postskip + $obj->preskip;
3521                         }
3522                         if( UNIVERSAL::isa($obj, 'PDFJ::Showable') ) {
3523                                 $height = $height < $obj->height ? $obj->height : $height;
3524                                 $width += $obj->width;
3525                         } elsif( UNIVERSAL::isa($obj, 'PDFJ::BlockElement') ) {
3526                                 $width += $obj->size($self->{direction});
3527                         } else {
3528                                 croak "illegal block element";
3529                         }
3530                 }
3531                 if( $adjust ) {
3532                         for my $obj(@{$self->{objects}}) {
3533                                 $obj->adjustheight($height)
3534                                         if UNIVERSAL::isa($obj, 'PDFJ::Block');
3535                         }
3536                 }
3537                 my @indents;
3538                 if( $align =~ /m/ ) {
3539                         for( my $j = 0; $j < $objnum; $j++ ) {
3540                                 my $obj = $self->{objects}->[$j];
3541                                 if( UNIVERSAL::isa($obj, 'PDFJ::Showable') ) {
3542                                         $indents[$j] = ($height - $obj->height) / 2;
3543                                 }
3544                         }
3545                 } elsif( $align =~ /b/ ) {
3546                         for( my $j = 0; $j < $objnum; $j++ ) {
3547                                 my $obj = $self->{objects}->[$j];
3548                                 if( UNIVERSAL::isa($obj, 'PDFJ::Showable') ) {
3549                                         $indents[$j] = $height - $obj->height;
3550                                 }
3551                         }
3552                 }
3553                 $self->{indents} = \@indents;
3554         }
3555         $self->{width} = $width;
3556         $self->{height} = $height;
3557 }
3558
3559 sub padding { $_[0]->{style}{padding} || 0 }
3560
3561 sub width {
3562         my($self) = @_;
3563         $self->{width} + $self->padding * 2
3564                 + $self->{xpreshift} + $self->{xpostshift}
3565                 + ($self->direction eq 'H' ? 0 : $self->beginpadding);
3566 }
3567 sub height {
3568         my($self) = @_;
3569         $self->{height} + $self->padding * 2
3570                 + $self->{ypreshift} + $self->{ypostshift}
3571                 + ($self->direction eq 'H' ? $self->beginpadding : 0);
3572 }
3573 sub size {
3574         my($self, $direction) = @_;
3575         if( $direction eq 'H' ) {
3576                 $self->width;
3577         } else {
3578                 $self->height;
3579         }
3580 }
3581 sub left { 0 }
3582 sub right { $_[0]->width }
3583 sub top { 0 }
3584 sub bottom { - $_[0]->height }
3585 sub preskip { $_[0]->{style}{preskip} || 0 }
3586 sub postskip { $_[0]->{style}{postskip} || 0 }
3587 sub align { $_[0]->{style}{align} || "" }
3588 sub nobreak { $_[0]->{style}{nobreak} }
3589 sub postnobreak { $_[0]->{style}{postnobreak} }
3590 sub repeatheader { $_[0]->{style}{repeatheader} || 0 }
3591 sub float { $_[0]->{style}->{float} || "" }
3592 sub nofirstfloat { $_[0]->{style}{nofirstfloat} }
3593 sub beginpadding { $_[0]->{style}{beginpadding} || 0 }
3594 sub direction { $_[0]->{direction} }
3595 sub breakable {
3596         my($self, $blockdirection) = @_;
3597         $self->nobreak ? 0 :
3598                 $blockdirection eq $self->{direction} ? 1 :
3599                 0;
3600 }
3601
3602 sub adjustwidth {
3603         my($self, $size) = @_;
3604         return unless $size;
3605         my $align = $self->align;
3606         return $self if $self->width >= $size;
3607         $size -= $self->width;
3608         if( $align =~ /r/ ) {
3609                 $self->{xpreshift} = $size;
3610         } elsif( $align =~ /c/ ) {
3611                 $self->{xpreshift} = $size / 2;
3612                 $self->{xpostshift} = $size / 2;
3613         } else { # l
3614                 $self->{xpostshift} = $size;
3615         }
3616         $self;
3617 }
3618
3619 sub adjustheight {
3620         my($self, $size) = @_;
3621         return unless $size;
3622         my $align = $self->align;
3623         return $self if $self->height >= $size;
3624         $size -= $self->height;
3625         if( $align =~ /b/ ) {
3626                 $self->{ypreshift} = $size;
3627         } elsif( $align =~ /m/ ) {
3628                 $self->{ypreshift} = $size / 2;
3629                 $self->{ypostshift} = $size / 2;
3630         } else { # t
3631                 $self->{ypostshift} = $size;
3632         }
3633         $self;
3634 }
3635
3636 sub _show {
3637         my($self, $page, $x, $y) = @_;
3638         if( $self->direction eq 'H' ) {
3639                 $y -= $self->beginpadding;
3640         } else {
3641                 $x += $self->beginpadding;
3642         }
3643         my $style = $self->{style};
3644         if( $style->{withbox} ) {
3645                 my $withbox = $style->{withbox};
3646                 my $withboxstyle = $style->{withboxstyle};
3647                 my $shape = PDFJ::Shape->new;
3648                 $shape->box(0, 0, $self->width, - $self->height, $withbox,
3649                         $withboxstyle);
3650                 $shape->show($page, $x, $y);
3651         }
3652         $x += $self->padding + $self->{xpreshift};
3653         $y -= $self->padding + $self->{ypreshift};
3654         my $objnum = @{$self->{objects}};
3655         if( $self->{direction} eq 'V' ) {
3656                 for( my $j = 0; $j < $objnum; $j++ ) {
3657                         my $obj = $self->{objects}->[$j];
3658                         my $indent = $self->{indents}->[$j] || 0;
3659                         if( $j > 0 ) {
3660                                 $y -= $self->{objects}->[$j-1]->postskip + $obj->preskip;
3661                         }
3662                         if( UNIVERSAL::isa($obj, 'PDFJ::Showable') ) {
3663                                 $obj->show($page, $x + $indent, $y, 'tl');
3664                                 $y -= $obj->height;
3665                         } elsif( UNIVERSAL::isa($obj, 'PDFJ::BlockElement') ) {
3666                                 $y -= $obj->size($self->{direction});
3667                         } elsif( $obj =~ /^\d+$/ ) {
3668                                 $y -= $obj;
3669                         } else {
3670                                 croak "illegal block element";
3671                         }
3672                 }
3673         } elsif( $self->{direction} eq 'H' ) {
3674                 for( my $j = 0; $j < $objnum; $j++ ) {
3675                         my $obj = $self->{objects}->[$j];
3676                         my $indent = $self->{indents}->[$j] || 0;
3677                         if( $j > 0 ) {
3678                                 $x += $self->{objects}->[$j-1]->postskip + $obj->preskip;
3679                         }
3680                         if( UNIVERSAL::isa($obj, 'PDFJ::Showable') ) {
3681                                 $obj->show($page, $x, $y - $indent, 'tl');
3682                                 $x += $obj->width;
3683                         } elsif( UNIVERSAL::isa($obj, 'PDFJ::BlockElement') ) {
3684                                 $x += $obj->size($self->{direction});
3685                         } else {
3686                                 croak "illegal block element";
3687                         }
3688                 }
3689         } elsif( $self->{direction} eq 'R' ) {
3690                 $x += $self->{width};
3691                 for( my $j = 0; $j < $objnum; $j++ ) {
3692                         my $obj = $self->{objects}->[$j];
3693                         my $indent = $self->{indents}->[$j] || 0;
3694                         if( $j > 0 ) {
3695                                 $x -= $self->{objects}->[$j-1]->postskip + $obj->preskip;
3696                         }
3697                         if( UNIVERSAL::isa($obj, 'PDFJ::Showable') ) {
3698                                 $obj->show($page, $x, $y - $indent, 'tr');
3699                                 $x -= $obj->width;
3700                         } elsif( UNIVERSAL::isa($obj, 'PDFJ::BlockElement') ) {
3701                                 $x -= $obj->size($self->{direction});
3702                         } else {
3703                                 croak "illegal block element";
3704                         }
3705                 }
3706         }
3707 }
3708
3709 #--------------------------------------------------------------------------
3710 package PDFJ::Image;
3711 use PDFJ::Object;
3712 use Carp;
3713 use strict;
3714 use vars qw(@ISA);
3715 @ISA = qw(PDFJ::Showable);
3716
3717 sub new {
3718         my($class, $docobj, $src, $pxwidth, $pxheight, $width, $height, $padding,
3719                 $colorspace) = @_;
3720         my($ext) = $src =~ /([^\.]+)$/;
3721 #       croak "unknown image file extention: $ext"
3722 #               unless $ext =~ /^jpe?g$/i;
3723         if( $src =~ /^http:/i ) {
3724                 new_url($class, $docobj, $src, $pxwidth, $pxheight, $width,
3725                         $height, $padding, $colorspace);
3726         } else {
3727                 new_file($class, $docobj, $src, $pxwidth, $pxheight, $width,
3728                         $height, $padding, $colorspace);
3729         }
3730 }
3731
3732 sub new_url {
3733         my($class, $docobj, $url, $pxwidth, $pxheight, $width, $height, $padding,
3734                 $colorspace) = @_;
3735         $width ||= $pxwidth;
3736         $height ||= $pxheight;
3737         $colorspace ||= 'DeviceRGB';
3738         $colorspace = $colorspace =~ /^rgb$/i ? 'DeviceRGB' :
3739                 $colorspace =~ /^gray$/i ? 'DeviceGray' :
3740                 $colorspace =~ /^cmyk$/i ? 'DeviceCMYK' :
3741                 'DeviceRGB';
3742         my $num = $docobj->_nextimagenum;
3743         my $name = "I$num";
3744         my $image = $docobj->indirect(stream(dictionary => {
3745                 Name     => name($name),
3746                 Type     => name("XObject"),
3747                 Subtype  => name("Image"),
3748                 Width    => number($pxwidth),
3749                 Height   => number($pxheight),
3750                 BitsPerComponent => 8,
3751                 ColorSpace => name($colorspace),
3752                 FFilter  => name("DCTDecode"),
3753                 F        => {
3754                         FS => name("URL"),
3755                         F  => string($url),
3756                 },
3757                 Length   => 0,
3758                 # No Data
3759         }, stream => ''));
3760         $docobj->_registimage($name, $image);
3761         bless { name => $name, image => $image, width => $width,
3762                 height => $height, padding => $padding }, $class;
3763 }
3764
3765 sub new_file {
3766         my($class, $docobj, $file, $pxwidth, $pxheight, $width, $height, $padding,
3767                 $colorspace) = @_;
3768         $width ||= $pxwidth;
3769         $height ||= $pxheight;
3770         $colorspace ||= 'DeviceRGB';
3771         $colorspace = $colorspace =~ /^rgb$/i ? 'DeviceRGB' :
3772                 $colorspace =~ /^gray$/i ? 'DeviceGray' :
3773                 $colorspace =~ /^cmyk$/i ? 'DeviceCMYK' :
3774                 'DeviceRGB';
3775         my $num = $docobj->_nextimagenum;
3776         my $name = "I$num";
3777         my($encoded, $filter) = $docobj->_makestream($file, "DCTDecode");
3778         my $image = $docobj->indirect(stream(dictionary => {
3779                 Name     => name($name),
3780                 Type     => name("XObject"),
3781                 Subtype  => name("Image"),
3782                 Width    => number($pxwidth),
3783                 Height   => number($pxheight),
3784                 BitsPerComponent => 8,
3785                 ColorSpace => name($colorspace),
3786                 Filter  => $filter,
3787                 Length   => length($encoded),
3788         }, stream => $encoded));
3789         $docobj->_registimage($name, $image);
3790         bless { name => $name, image => $image, width => $width,
3791                 height => $height, padding => $padding }, $class;
3792 }
3793
3794 sub image { $_[0]->{image} }
3795 sub width { $_[0]->{width} + $_[0]->padding * 2 }
3796 sub height { $_[0]->{height} + $_[0]->padding * 2 }
3797 sub padding { $_[0]->{padding} || 0 }
3798 sub left { 0 }
3799 sub right { $_[0]->width }
3800 sub top { $_[0]->height }
3801 sub bottom { 0 }
3802
3803 sub size {
3804         my($self, $direction) = @_;
3805         $direction eq 'H' ? $self->width : $self->height;
3806 }
3807
3808 sub setsize {
3809         my($self, $width, $height) = @_;
3810         $self->{width} = $width;
3811         $self->{height} = $height;
3812         $self;
3813 }
3814
3815 sub setpadding {
3816         my($self, $padding) = @_;
3817         $self->{padding} = $padding;
3818 }
3819
3820 sub _show {
3821         my($self, $page, $x, $y) = @_;
3822         $x += $self->padding;
3823         $y += $self->padding;
3824         my $width = $self->{width};
3825         my $height = $self->{height};
3826         my $name = $self->{name};
3827         $page->addcontents("q $width 0 0 $height $x $y cm /$name Do Q");
3828         $page->useimage($self);
3829 }
3830
3831 #--------------------------------------------------------------------------
3832 package PDFJ::Color;
3833 use Carp;
3834 use strict;
3835
3836 sub Color { PDFJ::Color->new(@_) }
3837
3838 sub new {
3839         my $class = shift;
3840         my $self;
3841         if( @_ == 1 ) {
3842                 my $value = $_[0];
3843                 if( $value =~ /^#([A-Fa-f0-9]{2})([A-Fa-f0-9]{2})([A-Fa-f0-9]{2})$/ ) {
3844                         my(@rgb) = map {oct("0x$_")/256} ($1,$2,$3);
3845                         $self = bless { type => 'rgb', value => \@rgb }, $class;
3846                 } else {
3847                         $self = bless { type => 'gray', value => $value }, $class;
3848                 }
3849         } elsif( @_ == 3 ) {
3850                 my @rgb = @_;
3851                 $self = bless { type => 'rgb', value => \@rgb }, $class;
3852         } else {
3853                 croak "Color arguments must be one or three";
3854         }
3855         $self;
3856 }
3857
3858 sub fill {
3859         my($self) = @_;
3860         if( $self->{type} eq 'gray' ) {
3861                 "$self->{value} g ";
3862         } else { # 'rgb'
3863                 my @rgb = @{$self->{value}};
3864                 "@rgb rg ";
3865         }
3866 }
3867
3868 sub stroke {
3869         my($self) = @_;
3870         if( $self->{type} eq 'gray' ) {
3871                 "$self->{value} G ";
3872         } else { # 'rgb'
3873                 my @rgb = @{$self->{value}};
3874                 "@rgb RG ";
3875         }
3876 }
3877
3878 #--------------------------------------------------------------------------
3879 package PDFJ::ShapeStyle;
3880 use strict;
3881 use Carp;
3882 use vars qw(@ISA);
3883 @ISA = qw(PDFJ::Style);
3884
3885 sub SStyle { PDFJ::ShapeStyle->new(@_) }
3886
3887 sub pdf {
3888         my($self) = @_;
3889         my $result = "";
3890         $result .= $self->{fillcolor}->fill if $self->{fillcolor};
3891         $result .= $self->{strokecolor}->stroke if $self->{strokecolor};
3892         $result .= "$self->{linewidth} w " if $self->{linewidth};
3893         if( $self->{linedash} ) {
3894                 my($dash, $gap, $phase) = @{$self->{linedash}};
3895                 $phase ||= 0;
3896                 $result .= "[$dash $gap] $phase d ";
3897         }
3898         $result;
3899 }
3900
3901 #--------------------------------------------------------------------------
3902 package PDFJ::Shape;
3903 use Carp;
3904 use strict;
3905 use vars qw(@ISA);
3906 @ISA = qw(PDFJ::Showable);
3907
3908 sub Shape { PDFJ::Shape->new(@_) }
3909
3910 sub new {
3911         my($class, $style) = @_;
3912         my $self = bless
3913                 { left => 0, top => 0, right => 0, bottom => 0, pdf => "" }, $class;
3914         $self->style($style) if $style;
3915         $self;
3916 }
3917
3918 sub padding { $_[0]->{style}{padding} || 0 }
3919 sub left { $_[0]->{left} - $_[0]->padding }
3920 sub right { $_[0]->{right} + $_[0]->padding }
3921 sub top { $_[0]->{top} + $_[0]->padding }
3922 sub bottom { $_[0]->{bottom} - $_[0]->padding }
3923 sub width { $_[0]->{right} - $_[0]->{left} + $_[0]->padding * 2 }
3924 sub height { $_[0]->{top} - $_[0]->{bottom} + $_[0]->padding * 2 }
3925 sub preskip { $_[0]->{style}{preskip} || 0 }
3926 sub postskip { $_[0]->{style}{postskip} || 0 }
3927 sub postnobreak { $_[0]->{style}{postnobreak} }
3928 sub float { $_[0]->{style}->{float} || "" }
3929 sub pdf { $_[0]->{pdf} }
3930
3931 sub size {
3932         my($self, $direction) = @_;
3933         $direction eq 'H' ? $self->width : $self->height;
3934 }
3935
3936 sub setboundary {
3937         my($self, $x, $y) = @_;
3938         if( $x < $self->{left} ) {
3939                 $self->{left} = $x;
3940         } elsif( $x > $self->{right} ) {
3941                 $self->{right} = $x;
3942         }
3943         if( $y < $self->{bottom} ) {
3944                 $self->{bottom} = $y;
3945         } elsif( $y > $self->{top} ) {
3946                 $self->{top} = $y;
3947         }
3948 }
3949
3950 sub appendpdf {
3951         my($self, $pdf) = @_;
3952         $pdf .= " " unless $pdf =~ / $/;
3953         $self->{pdf} .= $pdf;
3954         $self;
3955 }
3956
3957 sub appendobj {
3958         my($self, $obj, @args) = @_;
3959         push @{$self->{objects}}, [$obj, @args];
3960         $self;
3961 }
3962
3963 sub add_link {
3964         my($self, $rect, $name) = @_;
3965         $self->{link}{join(',', @$rect)} = $name;
3966 }
3967
3968 sub show_link {
3969         my($self, $page, $x, $y) = @_;
3970         $x ||= 0;
3971         $y ||= 0;
3972         for my $rect(keys %{$self->{link}}) {
3973                 my $name = $self->{link}{$rect};
3974                 my @rect = split(',', $rect);
3975                 $rect[0] += $x;
3976                 $rect[1] += $y;
3977                 $rect[2] += $x;
3978                 $rect[3] += $y;
3979                 $page->add_link(\@rect, $name);
3980         }
3981 }
3982
3983 sub _show {
3984         my($self, $page, $x, $y) = @_;
3985         $x += $self->padding;
3986         $y += $self->padding;
3987         my $stylepdf = "";
3988         if( $self->{style} ) {
3989                 $stylepdf = $self->{style}->pdf if UNIVERSAL::can($self->{style}, 'pdf');
3990         }
3991         $page->addcontents("q 1 0 0 1 $x $y cm $stylepdf $self->{pdf}");
3992         if( $self->{objects} ) {
3993                 for my $objspec(@{$self->{objects}}) {
3994                         my($obj, @args) = @$objspec;
3995                         $obj->show($page, @args);
3996                 }
3997         }
3998         $page->addcontents("Q");
3999         $self->show_link($page, $x, $y);
4000 }
4001
4002 sub style {
4003         my($self, $style) = @_;
4004         croak "shape style argument must be a PDFJ::ShapeStyle object"
4005                 unless UNIVERSAL::isa($style, 'PDFJ::ShapeStyle');
4006         $self->{style} = $style;
4007         $self;
4008 }
4009
4010 # General Graphic State operators
4011
4012 sub gstatepush {
4013         my($self) = @_;
4014         $self->appendpdf("q");
4015 }
4016
4017 sub gstatepop {
4018         my($self) = @_;
4019         $self->appendpdf("Q");
4020 }
4021
4022 sub linewidth {
4023         my($self, $w) = @_;
4024         $self->appendpdf("$w w");
4025 }
4026
4027 sub linedash {
4028         my($self, $dash, $gap, $phase) = @_;
4029         $phase ||= 0;
4030         $self->appendpdf("[$dash $gap] $phase d");
4031 }
4032
4033 sub ctm {
4034         my($self, @array) = @_;
4035         croak "ctm array must have 6 elements" unless @array == 6;
4036         $self->appendpdf("@array cm");
4037 }
4038
4039 # Color operators
4040
4041 sub fillcolor {
4042         my($self, $color) = @_;
4043         croak "color argument must be a PDFJ::Color object"
4044                 unless UNIVERSAL::isa($color, 'PDFJ::Color');
4045         $self->appendpdf($color->fill);
4046 }
4047
4048 sub strokecolor {
4049         my($self, $color) = @_;
4050         croak "color argument must be a PDFJ::Color object"
4051                 unless UNIVERSAL::isa($color, 'PDFJ::Color');
4052         $self->appendpdf($color->stroke);
4053 }
4054
4055 sub fillgray {
4056         my($self, $g) = @_;
4057         $self->appendpdf("$g g");
4058 }
4059
4060 sub strokegray {
4061         my($self, $g) = @_;
4062         $self->appendpdf("$g G");
4063 }
4064
4065 sub fillrgb {
4066         my($self, $r, $g, $b) = @_;
4067         $self->appendpdf("$r $g $b rg");
4068 }
4069
4070 sub strokergb {
4071         my($self, $r, $g, $b) = @_;
4072         $self->appendpdf("$r $g $b RG");
4073 }
4074
4075 # Path segment operators
4076
4077 # moves the current point to (x, y), omitting any connecting line segment
4078 sub moveto {
4079         my($self, $x, $y) = @_;
4080         $self->setboundary($x, $y);
4081         $self->appendpdf("$x $y m");
4082 }
4083
4084 # appends a straight line segment from the current point to (x, y).
4085 # The current point becomes (x, y).
4086 sub lineto {
4087         my($self, $x, $y) = @_;
4088         $self->setboundary($x, $y);
4089         $self->appendpdf("$x $y l");
4090 }
4091
4092 # appends a Bezier curve to the path. The curve extends
4093 # from the current point to (x3 ,y3) using (x1 ,y1) and (x2 ,y2)
4094 # as the Bezier control points.
4095 # The current point becomes (x3 ,y3).
4096 sub curveto {
4097         my($self, $x1, $y1, $x2, $y2, $x3, $y3) = @_;
4098         $self->setboundary($x1, $y1);
4099         $self->setboundary($x2, $y2);
4100         $self->setboundary($x3, $y3);
4101         $self->appendpdf("$x1 $y1 $x2 $y2 $x3 $y3 c");
4102 }
4103
4104 # omit 'v' and 'y'
4105
4106 # adds a rectangle to the current path
4107 sub rectangle {
4108         my($self, $x, $y, $w, $h) = @_;
4109         $self->setboundary($x, $y);
4110         $self->setboundary($x + $w, $y + $h);
4111         $self->appendpdf("$x $y $w $h re");
4112 }
4113
4114 # closes the current subpath by appending a straight line segment
4115 # from the current point to the starting point of the subpath.
4116 sub closepath {
4117         my $self = shift;
4118         $self->appendpdf("h");
4119 }
4120
4121 # ends the path without filling or stroking it
4122 sub newpath {
4123         my $self = shift;
4124         $self->appendpdf("n");
4125 }
4126
4127 # strokes the path
4128 sub stroke {
4129         my $self = shift;
4130         $self->appendpdf("S");
4131 }
4132
4133 # closes and strokes the path
4134 sub closestroke {
4135         my $self = shift;
4136         $self->appendpdf("s");
4137 }
4138
4139 # fills the path using the non-zero winding number rule
4140 sub fill {
4141         my $self = shift;
4142         $self->appendpdf("f");
4143 }
4144
4145 # fills the path using the even-odd rule
4146 sub fill2 {
4147         my $self = shift;
4148         $self->appendpdf("f*");
4149 }
4150
4151 # Path macro
4152
4153 sub line {
4154         my($self, $x, $y, $w, $h, $style) = @_;
4155         my $stylepdf;
4156         $stylepdf = $style->pdf if $style;
4157         my($x1, $y1, $x2, $y2) = ($x, $y, $x + $w, $y + $h);
4158         $self->setboundary($x1, $y1);
4159         $self->setboundary($x2, $y2);
4160         $self->appendpdf("q $stylepdf") if $stylepdf;
4161         $self->appendpdf("$x1 $y1 m $x2 $y2 l S");
4162         $self->appendpdf("Q") if $stylepdf;
4163         $self;
4164 }
4165
4166 sub textuline {
4167         my($self, $x, $y, $size, $fontsize, $style) = @_;
4168         my $yshift = $PDFJ::Default{ULine} * $fontsize / 1000;
4169         $self->line($x, $y + $yshift, $size, 0, $style);
4170 }
4171
4172 sub textoline {
4173         my($self, $x, $y, $size, $fontsize, $style) = @_;
4174         my $yshift = $PDFJ::Default{OLine} * $fontsize / 1000;
4175         $self->line($x, $y + $yshift, $size, 0, $style);
4176 }
4177
4178 sub textlline {
4179         my($self, $x, $y, $size, $fontsize, $style) = @_;
4180         my $xshift = $PDFJ::Default{LLine} * $fontsize / 1000;
4181         $self->line($x + $xshift, $y, 0, $size, $style);
4182 }
4183
4184 sub textrline {
4185         my($self, $x, $y, $size, $fontsize, $style) = @_;
4186         my $xshift = $PDFJ::Default{RLine} * $fontsize / 1000;
4187         $self->line($x + $xshift, $y, 0, $size, $style);
4188 }
4189
4190 sub box {
4191         my($self, $x, $y, $w, $h, $spec, $style) = @_;
4192         $spec = "s" unless $spec;
4193         my $stylepdf;
4194         $stylepdf = $style->pdf if $style;
4195         my($r);
4196         if( $spec =~ s/r(\d+)// ) {
4197                 $r = $1;
4198                 croak "too big radius for round box"
4199                         if $r * 2 > abs($w) || $r * 2 > abs($h);
4200         }
4201         if( $w < 0 ) {
4202                 $x += $w; $w = -$w;
4203         }
4204         if( $h < 0 ) {
4205                 $y += $h; $h = -$h;
4206         }
4207         $self->setboundary($x, $y);
4208         $self->setboundary($x + $w, $y + $h);
4209         if( $spec ne 'n' ) {
4210                 $self->appendpdf("q $stylepdf") if $stylepdf;
4211                 if( $r ) {
4212                         my $bz = $r * 0.55228475;
4213                         my @work = (
4214                                 $x+$w,        $y+$h-$r,      'm',
4215                                 $x+$w,        $y+$h-$r+$bz,
4216                                 $x+$w-$r+$bz, $y+$h,
4217                                 $x+$w-$r,     $y+$h,         'c',
4218                                 $x+$r,        $y+$h,         'l',
4219                                 $x+$r-$bz,    $y+$h,
4220                                 $x,           $y+$h-$r+$bz,
4221                                 $x,           $y+$h-$r,      'c',
4222                                 $x,           $y+$r,         'l',
4223                                 $x,           $y+$r-$bz,
4224                                 $x+$r-$bz,    $y,
4225                                 $x+$r,        $y,            'c',
4226                                 $x+$w-$r,     $y,            'l',
4227                                 $x+$w-$r+$bz, $y,
4228                                 $x+$w,        $y+$r-$bz,
4229                                 $x+$w,        $y+$r,         'c',
4230                                 $x+$w,        $y+$h-$r,      'l'
4231                         );
4232                         $self->appendpdf("@work ");
4233                 } else {
4234                         $self->appendpdf("$x $y m $x $y $w $h re ");
4235                 }
4236                 if( $spec eq 'sf' ) {
4237                         $self->appendpdf("B");
4238                 } elsif( $spec eq 's' ) {
4239                         $self->appendpdf("S");
4240                 } elsif( $spec eq 'f' ) {
4241                         $self->appendpdf("f");
4242                 } elsif( $spec =~ /^([lrtb]+)(f?)$/ ) {
4243                         croak "'lrtb' is inconsistent with 'rX'" if $r;
4244                         my($side, $fill) = ($1, $2);
4245                         if( $fill eq 'f' ) {
4246                                 $self->appendpdf("f");
4247                         } else {
4248                                 $self->appendpdf("n");
4249                         }
4250                         $self->line($x, $y, 0, $h) if $side =~ /l/;
4251                         $self->line($x + $w, $y, 0, $h) if $side =~ /r/;
4252                         $self->line($x, $y + $h, $w, 0) if $side =~ /t/;
4253                         $self->line($x, $y, $w, 0) if $side =~ /b/;
4254                 } elsif( $spec eq 'n' ) {
4255                         $self->appendpdf("n");
4256                 } else {
4257                         croak "illegal strokefill argument: $spec";
4258                 }
4259                 $self->appendpdf("Q") if $stylepdf;
4260         }
4261         if( $style && $style->{link} ) {
4262                 $self->add_link([$x, $y, $x + $w, $y + $h], $style->{link});
4263         }
4264         $self;
4265 }
4266
4267 sub textbox {
4268         my($self, $direction, $x, $y, $size, $fontsize, $spec,
4269                 $style) = @_;
4270         my(@bbox) = @{$PDFJ::Default{"SBox$direction"}};
4271         grep {$_ = $_ * $fontsize / 1000} @bbox;
4272         if( $direction eq 'H' ) {
4273                 $self->box(
4274                         $x + $bbox[0],
4275                         $y + $bbox[1],
4276                         $size + $bbox[2] - $bbox[0] - $fontsize,
4277                         $bbox[3] - $bbox[1],
4278                         $spec, $style
4279                 );
4280         } else {
4281                 $self->box(
4282                         $x + $bbox[0],
4283                         $y,
4284                         $bbox[2] - $bbox[0] ,
4285                         $size + $bbox[3] - $bbox[1] - $fontsize,
4286                         $spec, $style
4287                 );
4288         }
4289 }
4290
4291 sub circle {
4292         my($self, $x, $y, $r, $spec, $arcarea, $style) = @_;
4293         $self->ellipse($x, $y, $r, $r, $spec, $arcarea, $style);
4294 }
4295
4296 sub ellipse {
4297         my($self, $x, $y, $xr, $yr, $spec, $arcarea, $style) = @_;
4298         $spec = "s" unless $spec;
4299         my $stylepdf;
4300         $stylepdf = $style->pdf if $style;
4301         $self->appendpdf("q $stylepdf") if $stylepdf;
4302         my $xbz = $xr * 0.55228475;
4303         my $ybz = $yr * 0.55228475;
4304         my @pt = (
4305                 $x+$xr,  $y,
4306                 $x+$xr,  $y+$ybz, $x+$xbz, $y+$yr,  $x,     $y+$yr,
4307                 $x-$xbz, $y+$yr,  $x-$xr,  $y+$ybz, $x-$xr, $y,
4308                 $x-$xr,  $y-$ybz, $x-$xbz, $y-$yr,  $x,     $y-$yr,
4309                 $x+$xbz, $y-$yr,  $x+$xr,  $y-$ybz, $x+$xr, $y,
4310         );
4311         if( $arcarea ) {
4312                 $arcarea--;
4313                 $arcarea %= 4;
4314                 $self->setboundary(@pt[$arcarea * 6, $arcarea * 6 + 1]);
4315                 $self->setboundary(@pt[$arcarea * 6 + 6, $arcarea * 6 + 7]);
4316                 $self->appendpdf(join(' ',splice(@pt, $arcarea * 6, 2))." m ");
4317                 $self->appendpdf(join(' ',splice(@pt, $arcarea * 6, 6))." c ");
4318         } else {
4319                 $self->setboundary($x - $xr, $y - $yr);
4320                 $self->setboundary($x + $xr, $y + $yr);
4321                 $self->appendpdf(join(' ',splice(@pt, 0, 2))." m ");
4322                 $self->appendpdf(join(' ',splice(@pt, 0, 6))." c ");
4323                 $self->appendpdf(join(' ',splice(@pt, 0, 6))." c ");
4324                 $self->appendpdf(join(' ',splice(@pt, 0, 6))." c ");
4325                 $self->appendpdf(join(' ',splice(@pt, 0, 6))." c ");
4326         }
4327         if( $spec eq 'sf' ) {
4328                 $self->appendpdf("B");
4329         } elsif( $spec eq 's' ) {
4330                 $self->appendpdf("S");
4331         } elsif( $spec eq 'f' ) {
4332                 $self->appendpdf("f");
4333         }
4334         $self->appendpdf("Q") if $stylepdf;
4335         $self;
4336 }
4337
4338 sub polygon {
4339         my($self, $coords, $spec, $style) = @_;
4340         croak "coords argument must be an array ref"
4341                 unless ref($coords) eq 'ARRAY';
4342         croak "coords argument must have even elements"
4343                 if @$coords % 2;
4344         my @work;
4345         for( my $j = 0; $j < @$coords; $j += 2 ) {
4346                 push @work, $coords->[$j], $coords->[$j + 1];
4347                 push @work, ($j == 0) ? 'm' : 'l';
4348         }
4349         my $stylepdf;
4350         $stylepdf = $style->pdf if $style;
4351         $self->appendpdf("q $stylepdf") if $stylepdf;
4352         $self->appendpdf("@work ");
4353         if( $spec eq 'sf' ) {
4354                 $self->appendpdf("B");
4355         } elsif( $spec eq 's' ) {
4356                 $self->appendpdf("S");
4357         } elsif( $spec eq 'f' ) {
4358                 $self->appendpdf("f");
4359         }
4360         $self->appendpdf("Q") if $stylepdf;
4361         $self;
4362 }
4363
4364 sub obj {
4365         my($self, $obj, @showargs) = @_;
4366         $self->appendobj($obj, @showargs);
4367         $self;
4368 }
4369
4370 #--------------------------------------------------------------------------
4371 package PDFJ::Page;
4372 use Carp;
4373 use strict;
4374 use PDFJ::Object;
4375
4376 sub new {
4377         my($class, $docobj, $pagewidth, $pageheight) = @_;
4378         my $pagetree = $docobj->{pagetree};
4379         $pagewidth ||= $docobj->{pagewidth};
4380         $pageheight ||= $docobj->{pageheight};
4381         my $page = $docobj->indirect(dictionary({
4382                 Type => name('Page'),
4383                 Parent => $pagetree,
4384                 Resources => {ProcSet => [name('PDF'), name('Text')], Font => {}},
4385                 MediaBox => [0, 0, $pagewidth, $pageheight],
4386                 Contents => $docobj->indirect(
4387                         contents_stream(dictionary => {}, stream => [])),
4388                 }));
4389         push @{$docobj->{pagelist}}, $page;
4390         my $pagenum = @{$docobj->{pagelist}};
4391         $pagetree->get('Kids')->push($page);
4392         $pagetree->get('Count')->add(1);
4393         my $self = bless {
4394                 page => $page,
4395                 pagenum => $pagenum,
4396                 parent => $pagetree,
4397                 docobj => $docobj,
4398                 layer => 0,
4399         }, $class;
4400         push @{$docobj->{pageobjlist}}, $self;
4401         $self;
4402 }
4403
4404 sub docobj {
4405         my($self) = @_;
4406         $self->{docobj};
4407 }
4408
4409 sub page {
4410         my($self) = @_;
4411         $self->{page};
4412 }
4413
4414 sub pagenum {
4415         my($self) = @_;
4416         $self->{pagenum};
4417 }
4418
4419 sub getlayer {
4420         my($self) = @_;
4421         $self->{layer};
4422 }
4423
4424 sub addcontents {
4425         my($self, $str) = @_;
4426         $str .= " " unless $str =~ / $/;
4427         $self->page->get('Contents')->append($str, $self->getlayer);
4428 }
4429
4430 sub layer {
4431         my($self, $layer) = @_;
4432         $self->{layer} = $layer;
4433         $self;
4434 }
4435
4436 sub usefonts {
4437         my($self, @names) = @_;
4438         my $docobj = $self->docobj;
4439         my $resources = $self->page->get('Resources');
4440         for my $name(@names) {
4441                 $resources->get('Font')->set($name, $docobj->_font($name));
4442         }
4443 }
4444
4445 sub useimage {
4446         my($self, $imageobj) = @_;
4447         my $resources = $self->page->get('Resources');
4448         $resources->get('ProcSet')->add(name('ImageC'));
4449         $resources->set(XObject => {}) unless $resources->exists('XObject');
4450         $resources->get('XObject')->set($imageobj->{name}, $imageobj->{image});
4451 }
4452
4453 sub dest {
4454         my($self, $argtype, @args) = @_;
4455         array([$self->page, name($argtype), map {$_ eq '' ? null : $_} @args]);
4456 }
4457
4458 sub add_link {
4459         my($self, $rect, $name) = @_;
4460         $self->{link}{join(',', @$rect)} = $name;
4461 }
4462
4463 sub add_annot {
4464         my($self, %spec) = @_;
4465         $spec{Type} = name('Annot');
4466         my $docobj = $self->docobj;
4467         unless( $self->page->exists('Annots') ) {
4468                 $self->page->set(Annots => []);
4469         }
4470         $self->page->get('Annots')->push($docobj->indirect(dictionary(\%spec)));
4471 }
4472
4473 sub solve_link {
4474         my($self) = @_;
4475         my $docobj = $self->docobj;
4476         for my $rect(keys %{$self->{link}}) {
4477                 my $name = $self->{link}{$rect};
4478                 my @rect = split(',', $rect);
4479                 if( $name =~ /^URI:(.+)/ ) {
4480                         my $uri = $1;
4481                         $self->add_annot(
4482                                 Subtype => name('Link'),
4483                                 Rect => [@rect],
4484                                 Border => [0,0,0],
4485                                 A => {
4486                                         Type => name('Action'),
4487                                         S => name('URI'),
4488                                         URI => string(PDFJ::Util::uriencode($uri))
4489                                 },
4490                         );
4491                 } else {
4492                         my $dest = $docobj->dest($name)
4493                                 or croak "missing dest '$name'";
4494                         $self->add_annot(
4495                                 Subtype => name('Link'),
4496                                 Rect => [@rect],
4497                                 Border => [0,0,0],
4498                                 Dest => $dest,
4499                         );
4500                 }
4501         }
4502 }
4503
4504 #--------------------------------------------------------------------------
4505 package PDFJ::File;
4506 use strict;
4507 use PDFJ::Object;
4508
4509 sub new {
4510         my($class, $version, $handle, $objtable, $rootobj) = @_;
4511         binmode $handle;
4512         bless {
4513                 version => $version,  # PDF version
4514                 handle => $handle,    # file handle
4515                 objtable => $objtable,  # PDFJ::ObjTable object
4516                 rootobj => $rootobj,  # document catalog object
4517                 objposlist => [],
4518                 xrefpos => 0
4519         }, $class;
4520 }
4521
4522 sub print {
4523         my $self = shift;
4524         $self->print_header;
4525         $self->print_body;
4526         $self->print_xref;
4527         $self->print_trailer;
4528 }
4529
4530 sub print_header {
4531         my $self = shift;
4532         my $handle = $self->{handle};
4533         my $version = $self->{version};
4534         print $handle "%PDF-$version\n";
4535 }
4536
4537 sub print_body {
4538         my $self = shift;
4539         my $handle = $self->{handle};
4540         my $objtable = $self->{objtable};
4541         return unless $objtable->lastobjnum;
4542         for my $objnum(1 .. $objtable->lastobjnum) {
4543                 $self->{objposlist}->[$objnum] = $handle->tell;
4544                 $objtable->get($objnum)->print($handle);
4545         }
4546 }
4547
4548 sub print_xref {
4549         my $self = shift;
4550         my $handle = $self->{handle};
4551         $self->{xrefpos} = $handle->tell;
4552         print $handle "xref\n";
4553         my $objtable = $self->{objtable};
4554         my $lastobjnum = $objtable->lastobjnum;
4555         my $entries = $lastobjnum + 1;
4556         print $handle "0 $entries\n";
4557         print $handle "0000000000 65535 f \n";
4558         if( $lastobjnum ) {
4559                 for my $objnum(1 .. $lastobjnum) {
4560                         printf $handle "%010.10d %05.5d n \n",
4561                                 $self->{objposlist}->[$objnum],
4562                                 $objtable->get($objnum)->{gennum};
4563                 }
4564         }
4565         print $handle "\n";
4566 }
4567
4568 sub print_trailer {
4569         my $self = shift;
4570         my $handle = $self->{handle};
4571         my $xrefpos = $self->{xrefpos};
4572         my $objtable = $self->{objtable};
4573         my $traildic = dictionary({
4574                 Size => $objtable->lastobjnum + 1,
4575                 Root => $self->{rootobj}
4576                 });
4577         print $handle "trailer\n", $traildic->output,
4578                 "\nstartxref\n$xrefpos\n%%EOF\n";
4579 }
4580
4581 #--------------------------------------------------------------------------
4582 package PDFJ::ObjTable;
4583 use strict;
4584
4585 sub new {
4586         my($class) = @_;
4587         bless {objlist => [undef]}, $class;
4588 }
4589
4590 sub lastobjnum {
4591         my $self = shift;
4592         $#{$self->{objlist}};
4593 }
4594
4595 sub get {
4596         my($self, $idx) = @_;
4597         $self->{objlist}->[$idx];
4598 }
4599
4600 sub set {
4601         my($self, $idx, $obj) = @_;
4602         $self->{objlist}->[$idx] = $obj;
4603 }
4604
4605 1;
4606 #--------------------------------------------------------------------------
4607 # for SelfLoader in PDFJ::AFont
4608 package PDFJ::AFont;
4609 __DATA__
4610 sub fontwidth_Courier { [
4611         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4612         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4613         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4614         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4615         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4616         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4617         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4618         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4619         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4620         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4621         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4622         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4623         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4624         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4625         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4626         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4627         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4628         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4629         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4630         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4631         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4632         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4633         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4634         600,  600,  600
4635 ] }
4636 sub fontwidth_Courier_Bold { [
4637         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4638         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4639         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4640         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4641         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4642         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4643         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4644         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4645         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4646         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4647         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4648         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4649         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4650         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4651         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4652         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4653         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4654         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4655         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4656         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4657         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4658         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4659         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4660         600,  600,  600
4661 ] }
4662 sub fontwidth_Courier_BoldOblique { [
4663         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4664         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4665         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4666         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4667         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4668         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4669         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4670         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4671         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4672         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4673         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4674         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4675         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4676         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4677         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4678         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4679         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4680         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4681         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4682         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4683         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4684         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4685         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4686         600,  600,  600
4687 ] }
4688 sub fontwidth_Courier_Oblique { [
4689         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4690         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4691         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4692         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4693         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4694         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4695         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4696         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4697         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4698         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4699         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4700         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4701         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4702         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4703         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4704         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4705         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4706         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4707         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4708         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4709         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4710         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4711         600,  600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
4712         600,  600,  600
4713 ] }
4714 sub fontwidth_Helvetica { [
4715         278,  278,  278,  278,  278,  278,  278,  278,  278,  278,  278,
4716         278,  278,  278,  278,  278,  278,  278,  278,  278,  278,  278,
4717         278,  278,  278,  278,  278,  278,  278,  278,  278,  278,  278,
4718         278,  355,  556,  556,  889,  667,  221,  333,  333,  389,  584,
4719         278,  333,  278,  278,  556,  556,  556,  556,  556,  556,  556,
4720         556,  556,  556,  278,  278,  584,  584,  584,  556, 1015,  667,
4721         667,  722,  722,  667,  611,  778,  722,  278,  500,  667,  556,
4722         833,  722,  778,  667,  778,  722,  667,  611,  722,  667,  944,
4723         667,  667,  611,  278,  278,  278,  469,  556,  222,  556,  556,
4724         500,  556,  556,  278,  556,  556,  222,  222,  500,  222,  833,
4725         556,  556,  556,  556,  333,  500,  278,  556,  500,  722,  500,
4726         500,  500,  334,  260,  334,  584,  278,  278,  278,  278,  278,
4727         278,  278,  278,  278,  278,  278,  278,  278,  278,  278,  278,
4728         278,  278,  278,  278,  278,  278,  278,  278,  278,  278,  278,
4729         278,  278,  278,  278,  278,  278,  278,  333,  556,  556,  167,
4730         556,  556,  556,  556,  191,  333,  556,  333,  333,  500,  500,
4731         278,  556,  556,  556,  278,  278,  537,  350,  222,  333,  333,
4732         556, 1000, 1000,  278,  611,  278,  333,  333,  333,  333,  333,
4733         333,  333,  333,  278,  333,  333,  278,  333,  333,  333, 1000,
4734         278,  278,  278,  278,  278,  278,  278,  278,  278,  278,  278,
4735         278,  278,  278,  278,  278, 1000,  278,  370,  278,  278,  278,
4736         278,  556,  778, 1000,  365,  278,  278,  278,  278,  278,  889,
4737         278,  278,  278,  278,  278,  278,  222,  611,  944,  611,  278,
4738         278,  278,  278
4739 ] }
4740 sub fontwidth_Helvetica_Bold { [
4741         278,  278,  278,  278,  278,  278,  278,  278,  278,  278,  278,
4742         278,  278,  278,  278,  278,  278,  278,  278,  278,  278,  278,
4743         278,  278,  278,  278,  278,  278,  278,  278,  278,  278,  278,
4744         333,  474,  556,  556,  889,  722,  278,  333,  333,  389,  584,
4745         278,  333,  278,  278,  556,  556,  556,  556,  556,  556,  556,
4746         556,  556,  556,  333,  333,  584,  584,  584,  611,  975,  722,
4747         722,  722,  722,  667,  611,  778,  722,  278,  556,  722,  611,
4748         833,  722,  778,  667,  778,  722,  667,  611,  722,  667,  944,
4749         667,  667,  611,  333,  278,  333,  584,  556,  278,  556,  611,
4750         556,  611,  556,  333,  611,  611,  278,  278,  556,  278,  889,
4751         611,  611,  611,  611,  389,  556,  333,  611,  556,  778,  556,
4752         556,  500,  389,  280,  389,  584,  278,  278,  278,  278,  278,
4753         278,  278,  278,  278,  278,  278,  278,  278,  278,  278,  278,
4754         278,  278,  278,  278,  278,  278,  278,  278,  278,  278,  278,
4755         278,  278,  278,  278,  278,  278,  278,  333,  556,  556,  167,
4756         556,  556,  556,  556,  238,  500,  556,  333,  333,  611,  611,
4757         278,  556,  556,  556,  278,  278,  556,  350,  278,  500,  500,
4758         556, 1000, 1000,  278,  611,  278,  333,  333,  333,  333,  333,
4759         333,  333,  333,  278,  333,  333,  278,  333,  333,  333, 1000,
4760         278,  278,  278,  278,  278,  278,  278,  278,  278,  278,  278,
4761         278,  278,  278,  278,  278, 1000,  278,  370,  278,  278,  278,
4762         278,  611,  778, 1000,  365,  278,  278,  278,  278,  278,  889,
4763         278,  278,  278,  278,  278,  278,  278,  611,  944,  611,  278,
4764         278,  278,  278
4765 ] }
4766 sub fontwidth_Helvetica_BoldOblique { [
4767         278,  278,  278,  278,  278,  278,  278,  278,  278,  278,  278,
4768         278,  278,  278,  278,  278,  278,  278,  278,  278,  278,  278,
4769         278,  278,  278,  278,  278,  278,  278,  278,  278,  278,  278,
4770         333,  474,  556,  556,  889,  722,  278,  333,  333,  389,  584,
4771         278,  333,  278,  278,  556,  556,  556,  556,  556,  556,  556,
4772         556,  556,  556,  333,  333,  584,  584,  584,  611,  975,  722,
4773         722,  722,  722,  667,  611,  778,  722,  278,  556,  722,  611,
4774         833,  722,  778,  667,  778,  722,  667,  611,  722,  667,  944,
4775         667,  667,  611,  333,  278,  333,  584,  556,  278,  556,  611,
4776         556,  611,  556,  333,  611,  611,  278,  278,  556,  278,  889,
4777         611,  611,  611,  611,  389,  556,  333,  611,  556,  778,  556,
4778         556,  500,  389,  280,  389,  584,  278,  278,  278,  278,  278,
4779         278,  278,  278,  278,  278,  278,  278,  278,  278,  278,  278,
4780         278,  278,  278,  278,  278,  278,  278,  278,  278,  278,  278,
4781         278,  278,  278,  278,  278,  278,  278,  333,  556,  556,  167,
4782         556,  556,  556,  556,  238,  500,  556,  333,  333,  611,  611,
4783         278,  556,  556,  556,  278,  278,  556,  350,  278,  500,  500,
4784         556, 1000, 1000,  278,  611,  278,  333,  333,  333,  333,  333,
4785         333,  333,  333,  278,  333,  333,  278,  333,  333,  333, 1000,
4786         278,  278,  278,  278,  278,  278,  278,  278,  278,  278,  278,
4787         278,  278,  278,  278,  278, 1000,  278,  370,  278,  278,  278,
4788         278,  611,  778, 1000,  365,  278,  278,  278,  278,  278,  889,
4789         278,  278,  278,  278,  278,  278,  278,  611,  944,  611,  278,
4790         278,  278,  278
4791 ] }
4792 sub fontwidth_Helvetica_Oblique { [
4793         278,  278,  278,  278,  278,  278,  278,  278,  278,  278,  278,
4794         278,  278,  278,  278,  278,  278,  278,  278,  278,  278,  278,
4795         278,  278,  278,  278,  278,  278,  278,  278,  278,  278,  278,
4796         278,  355,  556,  556,  889,  667,  222,  333,  333,  389,  584,
4797         278,  333,  278,  278,  556,  556,  556,  556,  556,  556,  556,
4798         556,  556,  556,  278,  278,  584,  584,  584,  556, 1015,  667,
4799         667,  722,  722,  667,  611,  778,  722,  278,  500,  667,  556,
4800         833,  722,  778,  667,  778,  722,  667,  611,  722,  667,  944,
4801         667,  667,  611,  278,  278,  278,  469,  556,  222,  556,  556,
4802         500,  556,  556,  278,  556,  556,  222,  222,  500,  222,  833,
4803         556,  556,  556,  556,  333,  500,  278,  556,  500,  722,  500,
4804         500,  500,  334,  260,  334,  584,  278,  278,  278,  278,  278,
4805         278,  278,  278,  278,  278,  278,  278,  278,  278,  278,  278,
4806         278,  278,  278,  278,  278,  278,  278,  278,  278,  278,  278,
4807         278,  278,  278,  278,  278,  278,  278,  333,  556,  556,  167,
4808         556,  556,  556,  556,  191,  333,  556,  333,  333,  500,  500,
4809         278,  556,  556,  556,  278,  278,  537,  350,  222,  333,  333,
4810         556, 1000, 1000,  278,  611,  278,  333,  333,  333,  333,  333,
4811         333,  333,  333,  278,  333,  333,  278,  333,  333,  333, 1000,
4812         278,  278,  278,  278,  278,  278,  278,  278,  278,  278,  278,
4813         278,  278,  278,  278,  278, 1000,  278,  370,  278,  278,  278,
4814         278,  556,  778, 1000,  365,  278,  278,  278,  278,  278,  889,
4815         278,  278,  278,  278,  278,  278,  222,  611,  944,  611,  278,
4816         278,  278,  278
4817 ] }
4818 # The chracter #39 (single quote) in Times-* fonts has 333 width
4819 # in afm files. But Acrobat uses a width nallower than it. I use an
4820 # experimental value 222.
4821 sub fontwidth_Times_Bold { [
4822         250,  250,  250,  250,  250,  250,  250,  250,  250,  250,  250,
4823         250,  250,  250,  250,  250,  250,  250,  250,  250,  250,  250,
4824         250,  250,  250,  250,  250,  250,  250,  250,  250,  250,  250,
4825 #       333,  555,  500,  500, 1000,  833,  333,  333,  333,  500,  570,
4826         333,  555,  500,  500, 1000,  833,  222,  333,  333,  500,  570,
4827         250,  333,  250,  278,  500,  500,  500,  500,  500,  500,  500,
4828         500,  500,  500,  333,  333,  570,  570,  570,  500,  930,  722,
4829         667,  722,  722,  667,  611,  778,  778,  389,  500,  778,  667,
4830         944,  722,  778,  611,  778,  722,  556,  667,  722,  722, 1000,
4831         722,  722,  667,  333,  278,  333,  581,  500,  333,  500,  556,
4832         444,  556,  444,  333,  500,  556,  278,  333,  556,  278,  833,
4833         556,  500,  556,  556,  444,  389,  333,  556,  500,  722,  500,
4834         500,  444,  394,  220,  394,  520,  250,  250,  250,  250,  250,
4835         250,  250,  250,  250,  250,  250,  250,  250,  250,  250,  250,
4836         250,  250,  250,  250,  250,  250,  250,  250,  250,  250,  250,
4837         250,  250,  250,  250,  250,  250,  250,  333,  500,  500,  167,
4838         500,  500,  500,  500,  278,  500,  500,  333,  333,  556,  556,
4839         250,  500,  500,  500,  250,  250,  540,  350,  333,  500,  500,
4840         500, 1000, 1000,  250,  500,  250,  333,  333,  333,  333,  333,
4841         333,  333,  333,  250,  333,  333,  250,  333,  333,  333, 1000,
4842         250,  250,  250,  250,  250,  250,  250,  250,  250,  250,  250,
4843         250,  250,  250,  250,  250, 1000,  250,  300,  250,  250,  250,
4844         250,  667,  778, 1000,  330,  250,  250,  250,  250,  250,  722,
4845         250,  250,  250,  278,  250,  250,  278,  500,  722,  556,  250,
4846         250,  250,  250
4847 ] }
4848 sub fontwidth_Times_BoldItalic { [
4849         250,  250,  250,  250,  250,  250,  250,  250,  250,  250,  250,
4850         250,  250,  250,  250,  250,  250,  250,  250,  250,  250,  250,
4851         250,  250,  250,  250,  250,  250,  250,  250,  250,  250,  250,
4852 #       389,  555,  500,  500,  833,  778,  333,  333,  333,  500,  570,
4853         389,  555,  500,  500,  833,  778,  222,  333,  333,  500,  570,
4854         250,  333,  250,  278,  500,  500,  500,  500,  500,  500,  500,
4855         500,  500,  500,  333,  333,  570,  570,  570,  500,  832,  667,
4856         667,  667,  722,  667,  667,  722,  778,  389,  500,  667,  611,
4857         889,  722,  722,  611,  722,  667,  556,  611,  722,  667,  889,
4858         667,  611,  611,  333,  278,  333,  570,  500,  333,  500,  500,
4859         444,  500,  444,  333,  500,  556,  278,  278,  500,  278,  778,
4860         556,  500,  500,  500,  389,  389,  278,  556,  444,  667,  500,
4861         444,  389,  348,  220,  348,  570,  250,  250,  250,  250,  250,
4862         250,  250,  250,  250,  250,  250,  250,  250,  250,  250,  250,
4863         250,  250,  250,  250,  250,  250,  250,  250,  250,  250,  250,
4864         250,  250,  250,  250,  250,  250,  250,  389,  500,  500,  167,
4865         500,  500,  500,  500,  278,  500,  500,  333,  333,  556,  556,
4866         250,  500,  500,  500,  250,  250,  500,  350,  333,  500,  500,
4867         500, 1000, 1000,  250,  500,  250,  333,  333,  333,  333,  333,
4868         333,  333,  333,  250,  333,  333,  250,  333,  333,  333, 1000,
4869         250,  250,  250,  250,  250,  250,  250,  250,  250,  250,  250,
4870         250,  250,  250,  250,  250,  944,  250,  266,  250,  250,  250,
4871         250,  611,  722,  944,  300,  250,  250,  250,  250,  250,  722,
4872         250,  250,  250,  278,  250,  250,  278,  500,  722,  500,  250,
4873         250,  250,  250
4874 ] }
4875 sub fontwidth_Times_Italic { [
4876         250,  250,  250,  250,  250,  250,  250,  250,  250,  250,  250,
4877         250,  250,  250,  250,  250,  250,  250,  250,  250,  250,  250,
4878         250,  250,  250,  250,  250,  250,  250,  250,  250,  250,  250,
4879 #       333,  420,  500,  500,  833,  778,  333,  333,  333,  500,  675,
4880         333,  420,  500,  500,  833,  778,  222,  333,  333,  500,  675,
4881         250,  333,  250,  278,  500,  500,  500,  500,  500,  500,  500,
4882         500,  500,  500,  333,  333,  675,  675,  675,  500,  920,  611,
4883         611,  667,  722,  611,  611,  722,  722,  333,  444,  667,  556,
4884         833,  667,  722,  611,  722,  611,  500,  556,  722,  611,  833,
4885         611,  556,  556,  389,  278,  389,  422,  500,  333,  500,  500,
4886         444,  500,  444,  278,  500,  500,  278,  278,  444,  278,  722,
4887         500,  500,  500,  500,  389,  389,  278,  500,  444,  667,  444,
4888         444,  389,  400,  275,  400,  541,  250,  250,  250,  250,  250,
4889         250,  250,  250,  250,  250,  250,  250,  250,  250,  250,  250,
4890         250,  250,  250,  250,  250,  250,  250,  250,  250,  250,  250,
4891         250,  250,  250,  250,  250,  250,  250,  389,  500,  500,  167,
4892         500,  500,  500,  500,  214,  556,  500,  333,  333,  500,  500,
4893         250,  500,  500,  500,  250,  250,  523,  350,  333,  556,  556,
4894         500,  889, 1000,  250,  500,  250,  333,  333,  333,  333,  333,
4895         333,  333,  333,  250,  333,  333,  250,  333,  333,  333,  889,
4896         250,  250,  250,  250,  250,  250,  250,  250,  250,  250,  250,
4897         250,  250,  250,  250,  250,  889,  250,  276,  250,  250,  250,
4898         250,  556,  722,  944,  310,  250,  250,  250,  250,  250,  667,
4899         250,  250,  250,  278,  250,  250,  278,  500,  667,  500,  250,
4900         250,  250,  250
4901 ] }
4902 sub fontwidth_Times_Roman { [
4903         250,  250,  250,  250,  250,  250,  250,  250,  250,  250,  250,
4904         250,  250,  250,  250,  250,  250,  250,  250,  250,  250,  250,
4905         250,  250,  250,  250,  250,  250,  250,  250,  250,  250,  250,
4906 #       333,  408,  500,  500,  833,  778,  333,  333,  333,  500,  564,
4907         333,  408,  500,  500,  833,  778,  222,  333,  333,  500,  564,
4908         250,  333,  250,  278,  500,  500,  500,  500,  500,  500,  500,
4909         500,  500,  500,  278,  278,  564,  564,  564,  444,  921,  722,
4910         667,  667,  722,  611,  556,  722,  722,  333,  389,  722,  611,
4911         889,  722,  722,  556,  722,  667,  556,  611,  722,  722,  944,
4912         722,  722,  611,  333,  278,  333,  469,  500,  333,  444,  500,
4913         444,  500,  444,  333,  500,  500,  278,  278,  500,  278,  778,
4914         500,  500,  500,  500,  333,  389,  278,  500,  500,  722,  500,
4915         500,  444,  480,  200,  480,  541,  250,  250,  250,  250,  250,
4916         250,  250,  250,  250,  250,  250,  250,  250,  250,  250,  250,
4917         250,  250,  250,  250,  250,  250,  250,  250,  250,  250,  250,
4918         250,  250,  250,  250,  250,  250,  250,  333,  500,  500,  167,
4919         500,  500,  500,  500,  180,  444,  500,  333,  333,  556,  556,
4920         250,  500,  500,  500,  250,  250,  453,  350,  333,  444,  444,
4921         500, 1000, 1000,  250,  444,  250,  333,  333,  333,  333,  333,
4922         333,  333,  333,  250,  333,  333,  250,  333,  333,  333, 1000,
4923         250,  250,  250,  250,  250,  250,  250,  250,  250,  250,  250,
4924         250,  250,  250,  250,  250,  889,  250,  276,  250,  250,  250,
4925         250,  611,  722,  889,  310,  250,  250,  250,  250,  250,  667,
4926         250,  250,  250,  278,  250,  250,  278,  500,  722,  500,  250,
4927         250,  250,  250
4928 ] }
4929