oox/source/export/preset-definitions-to-shape-types.pl

   1 #!/usr/bin/env perl -w
   2 #
   3 # This file is part of the LibreOffice project.
   4 #
   5 # This Source Code Form is subject to the terms of the Mozilla Public
   6 # License, v. 2.0. If a copy of the MPL was not distributed with this
   7 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
   8 #
   9 # This file incorporates work covered by the following license notice:
  10 #
  11 #   Licensed to the Apache Software Foundation (ASF) under one or more
  12 #   contributor license agreements. See the NOTICE file distributed
  13 #   with this work for additional information regarding copyright
  14 #   ownership. The ASF licenses this file to you under the Apache
  15 #   License, Version 2.0 (the "License"); you may not use this file
  16 #   except in compliance with the License. You may obtain a copy of
  17 #   the License at http://www.apache.org/licenses/LICENSE-2.0 .
  18 #
  19
  20 use strict;
  21 use warnings;
  22
  23 sub usage() {
  24     print STDERR <<EOF;
  25 Usage: preset-definitions-to-shape-types.pl [ --drawingml-adj-names-data | --vml-shape-types-data ] <shapes> <text>
  26
  27 Converts presetShapeDefinitions.xml and presetTextWarpDefinitions.xml to a
  28 .cxx that contains VML with the definitions of the shapes.  The result is
  29 written to stdout.
  30
  31 <shapes> presetShapeDefinitions.xml (including the path to it)
  32 <text>   presetTextWarpDefinitions.xml (including the path to it)
  33 EOF
  34     exit 1;
  35 }
  36
  37 sub show_call_stack
  38 {
  39     my ( $path, $line, $subr );
  40     my $max_depth = 30;
  41     my $i = 1;
  42     print STDERR "--- Begin stack trace ---\n";
  43     while ( (my @call_details = (caller($i++))) && ($i<$max_depth) ) {
  44         print STDERR "$call_details[1] line $call_details[2] in function $call_details[3]\n";
  45     }
  46     print STDERR "--- End stack trace ---\n";
  47 }
  48
  49 my $drawingml_adj_names_data = 0;
  50 my $vml_shape_types_data = 0;
  51 my $src_shapes = shift;
  52 if ($src_shapes eq "--drawingml-adj-names-data") {
  53     $drawingml_adj_names_data = 1;
  54     $src_shapes = shift;
  55 } elsif ($src_shapes eq "--vml-shape-types-data") {
  56     $vml_shape_types_data = 1;
  57     $src_shapes = shift;
  58 }
  59 my $src_text = shift;
  60
  61 usage() if ( !defined( $src_shapes ) || !defined( $src_text ) ||
  62              $src_shapes eq "-h" || $src_shapes eq "--help" ||
  63              !-f $src_shapes || !-f $src_text );
  64
  65 # Global variables
  66 my @levels = ();
  67 my $shape_name = "";
  68 my $state = "";
  69 my $path = "";
  70 my $adjust = "";
  71 my %adj_names;
  72 my $max_adj_no = 0;
  73 my @formulas = ();
  74 my %variables = ();
  75 my $ignore_this_shape = 0;
  76 my $handles = "";
  77 my $textboxrect = "";
  78 my $last_pos_x = "";
  79 my $last_pos_y = "";
  80 my $no_stroke = 0;
  81 my $no_fill = 0;
  82 my $path_w = 1;
  83 my $path_h = 1;
  84 my @quadratic_bezier = ();
  85
  86 my %result_shapes = ();
  87
  88 my %shapes_ids = (
  89     0 => 'notPrimitive',
  90     1 => 'rectangle',
  91     2 => 'roundRectangle',
  92     3 => 'ellipse',
  93     4 => 'diamond',
  94     5 => 'triangle',
  95     6 => 'rtTriangle',
  96     7 => 'parallelogram',
  97     8 => 'trapezoid',
  98     9 => 'hexagon',
  99     10 => 'octagon',
 100     11 => 'plus',
 101     12 => 'star5',
 102     13 => 'rightArrow',
 103     14 => 'thickArrow', # should not be used
 104     15 => 'homePlate',
 105     16 => 'cube',
 106     17 => 'wedgeRoundRectCallout', # balloon
 107     18 => 'star16', # seal
 108     19 => 'arc',
 109     20 => 'line',
 110     21 => 'plaque',
 111     22 => 'can',
 112     23 => 'donut',
 113     24 => 'textPlain', # textSimple - FIXME MS Office 2007 converts these to textboxes with unstyled text, so is it actually correct to map it to a real style?
 114     25 => 'textStop', # textOctagon FIXME see 24
 115     26 => 'textTriangle', # textHexagon FIXMME see 24
 116     27 => 'textCanDown', # textCurve FIXMME see 24
 117     28 => 'textWave1', # textWave FIXMME see 24
 118     29 => 'textArchUpPour', # textRing FIXMME see 24
 119     30 => 'textCanDown', # textOnCurve FIXMME see 24
 120     31 => 'textArchUp', # textOnRing FIXMME see 24
 121     32 => 'straightConnector1',
 122     33 => 'bentConnector2',
 123     34 => 'bentConnector3',
 124     35 => 'bentConnector4',
 125     36 => 'bentConnector5',
 126     37 => 'curvedConnector2',
 127     38 => 'curvedConnector3',
 128     39 => 'curvedConnector4',
 129     40 => 'curvedConnector5',
 130     41 => 'callout1',
 131     42 => 'callout2',
 132     43 => 'callout3',
 133     44 => 'accentCallout1',
 134     45 => 'accentCallout2',
 135     46 => 'accentCallout3',
 136     47 => 'borderCallout1',
 137     48 => 'borderCallout2',
 138     49 => 'borderCallout3',
 139     50 => 'accentBorderCallout1',
 140     51 => 'accentBorderCallout2',
 141     52 => 'accentBorderCallout3',
 142     53 => 'ribbon',
 143     54 => 'ribbon2',
 144     55 => 'chevron',
 145     56 => 'pentagon',
 146     57 => 'noSmoking',
 147     58 => 'star8', # seal8
 148     59 => 'star16', # seal16
 149     60 => 'star32', # seal32
 150     61 => 'wedgeRectCallout',
 151     62 => 'wedgeRoundRectCallout', # wedgeRRectCallout
 152     63 => 'wedgeEllipseCallout',
 153     64 => 'wave',
 154     65 => 'foldedCorner',
 155     66 => 'leftArrow',
 156     67 => 'downArrow',
 157     68 => 'upArrow',
 158     69 => 'leftRightArrow',
 159     70 => 'upDownArrow',
 160     71 => 'irregularSeal1',
 161     72 => 'irregularSeal2',
 162     73 => 'lightningBolt',
 163     74 => 'heart',
 164     75 => 'pictureFrame',
 165     76 => 'quadArrow',
 166     77 => 'leftArrowCallout',
 167     78 => 'rightArrowCallout',
 168     79 => 'upArrowCallout',
 169     80 => 'downArrowCallout',
 170     81 => 'leftRightArrowCallout',
 171     82 => 'upDownArrowCallout',
 172     83 => 'quadArrowCallout',
 173     84 => 'bevel',
 174     85 => 'leftBracket',
 175     86 => 'rightBracket',
 176     87 => 'leftBrace',
 177     88 => 'rightBrace',
 178     89 => 'leftUpArrow',
 179     90 => 'bentUpArrow',
 180     91 => 'bentArrow',
 181     92 => 'star24', # seal24
 182     93 => 'stripedRightArrow',
 183     94 => 'notchedRightArrow',
 184     95 => 'blockArc',
 185     96 => 'smileyFace',
 186     97 => 'verticalScroll',
 187     98 => 'horizontalScroll',
 188     99 => 'circularArrow',
 189     100 => 'notchedCircularArrow', # should not be used
 190     101 => 'uturnArrow',
 191     102 => 'curvedRightArrow',
 192     103 => 'curvedLeftArrow',
 193     104 => 'curvedUpArrow',
 194     105 => 'curvedDownArrow',
 195     106 => 'cloudCallout',
 196     107 => 'ellipseRibbon',
 197     108 => 'ellipseRibbon2',
 198     109 => 'flowChartProcess',
 199     110 => 'flowChartDecision',
 200     111 => 'flowChartInputOutput',
 201     112 => 'flowChartPredefinedProcess',
 202     113 => 'flowChartInternalStorage',
 203     114 => 'flowChartDocument',
 204     115 => 'flowChartMultidocument',
 205     116 => 'flowChartTerminator',
 206     117 => 'flowChartPreparation',
 207     118 => 'flowChartManualInput',
 208     119 => 'flowChartManualOperation',
 209     120 => 'flowChartConnector',
 210     121 => 'flowChartPunchedCard',
 211     122 => 'flowChartPunchedTape',
 212     123 => 'flowChartSummingJunction',
 213     124 => 'flowChartOr',
 214     125 => 'flowChartCollate',
 215     126 => 'flowChartSort',
 216     127 => 'flowChartExtract',
 217     128 => 'flowChartMerge',
 218     129 => 'flowChartOfflineStorage',
 219     130 => 'flowChartOnlineStorage',
 220     131 => 'flowChartMagneticTape',
 221     132 => 'flowChartMagneticDisk',
 222     133 => 'flowChartMagneticDrum',
 223     134 => 'flowChartDisplay',
 224     135 => 'flowChartDelay',
 225     136 => 'textPlain', # textPlainText
 226     137 => 'textStop',
 227     138 => 'textTriangle',
 228     139 => 'textTriangleInverted',
 229     140 => 'textChevron',
 230     141 => 'textChevronInverted',
 231     142 => 'textRingInside',
 232     143 => 'textRingOutside',
 233     144 => 'textArchUp', # textArchUpCurve
 234     145 => 'textArchDown', # textArchDownCurve
 235     146 => 'textCircle', # textCircleCurve
 236     147 => 'textButton', # textButtonCurve
 237     148 => 'textArchUpPour',
 238     149 => 'textArchDownPour',
 239     150 => 'textCirclePour',
 240     151 => 'textButtonPour',
 241     152 => 'textCurveUp',
 242     153 => 'textCurveDown',
 243     154 => 'textCascadeUp',
 244     155 => 'textCascadeDown',
 245     156 => 'textWave1',
 246     157 => 'textWave2',
 247     158 => 'textWave3',
 248     159 => 'textWave4',
 249     160 => 'textInflate',
 250     161 => 'textDeflate',
 251     162 => 'textInflateBottom',
 252     163 => 'textDeflateBottom',
 253     164 => 'textInflateTop',
 254     165 => 'textDeflateTop',
 255     166 => 'textDeflateInflate',
 256     167 => 'textDeflateInflateDeflate',
 257     168 => 'textFadeRight',
 258     169 => 'textFadeLeft',
 259     170 => 'textFadeUp',
 260     171 => 'textFadeDown',
 261     172 => 'textSlantUp',
 262     173 => 'textSlantDown',
 263     174 => 'textCanUp',
 264     175 => 'textCanDown',
 265     176 => 'flowChartAlternateProcess',
 266     177 => 'flowChartOffpageConnector',
 267     178 => 'callout1', # callout90
 268     179 => 'accentCallout1', # accentCallout90
 269     180 => 'borderCallout1', # borderCallout90
 270     181 => 'accentBorderCallout1', # accentBorderCallout90
 271     182 => 'leftRightUpArrow',
 272     183 => 'sun',
 273     184 => 'moon',
 274     185 => 'bracketPair',
 275     186 => 'bracePair',
 276     187 => 'star4', # seal4
 277     188 => 'doubleWave',
 278     189 => 'actionButtonBlank',
 279     190 => 'actionButtonHome',
 280     191 => 'actionButtonHelp',
 281     192 => 'actionButtonInformation',
 282     193 => 'actionButtonForwardNext',
 283     194 => 'actionButtonBackPrevious',
 284     195 => 'actionButtonEnd',
 285     196 => 'actionButtonBeginning',
 286     197 => 'actionButtonReturn',
 287     198 => 'actionButtonDocument',
 288     199 => 'actionButtonSound',
 289     200 => 'actionButtonMovie',
 290     201 => 'hostControl', # should not be used
 291     202 => 'textBox'
 292 );
 293 # An error occurred, we have to ignore this shape
 294 sub error( $ )
 295 {
 296     my ( $msg ) = @_;
 297
 298     $ignore_this_shape = 1;
 299     print STDERR "ERROR (in $shape_name ): $msg\n";
 300 }
 301
 302 # Setup the %variables map with predefined values
 303 sub setup_variables()
 304 {
 305     %variables = (
 306         'l'        => 0,
 307         't'        => 0,
 308         'r'        => 21600,
 309         'b'        => 21600,
 310
 311         'w'        => 21600,
 312         'h'        => 21600,
 313         'ss'       => 21600,
 314         'ls'       => 21600,
 315
 316         'ssd2'     => 10800, # 1/2
 317         'ssd4'     => 5400,  # 1/4
 318         'ssd6'     => 3600,  # 1/6
 319         'ssd8'     => 2700,  # 1/8
 320         'ssd16'    => 1350,  # 1/16
 321         'ssd32'    => 675,   # 1/32
 322
 323         'hc'       => 10800, # horizontal center
 324         'vc'       => 10800, # vertical center
 325
 326         'wd2'      => 10800, # 1/2
 327         'wd3'      => 7200,  # 1/3
 328         'wd4'      => 5400,  # 1/4
 329         'wd5'      => 4320,  # 1/5
 330         'wd6'      => 3600,  # 1/6
 331         'wd8'      => 2700,  # 1/8
 332         'wd10'     => 2160,  # 1/10
 333         'wd12'     => 1800,  # 1/12
 334         'wd32'     => 675,   # 1/32
 335
 336         'hd2'      => 10800, # 1/2
 337         'hd3'      => 7200,  # 1/3
 338         'hd4'      => 5400,  # 1/4
 339         'hd5'      => 4320,  # 1/5
 340         'hd6'      => 3600,  # 1/6
 341         'hd8'      => 2700,  # 1/8
 342         'hd10'     => 2160,  # 1/10
 343         'hd12'     => 1800,  # 1/12
 344         'hd32'     => 675,   # 1/32
 345
 346         '25000'    => 5400,
 347         '12500'    => 2700,
 348
 349         'cd4'      => 90,    # 1/4 of a circle
 350         'cd2'      => 180,   # 1/2 of a circle
 351         '3cd4'     => 270,   # 3/4 of a circle
 352
 353         'cd8'      => 45,    # 1/8 of a circle
 354         '3cd8'     => 135,   # 3/8 of a circle
 355         '5cd8'     => 225,   # 5/8 of a circle
 356         '7cd8'     => 315,   # 7/8 of a circle
 357
 358         '-5400000' => -90,
 359         '-10800000'=> -180,
 360         '-16200000'=> -270,
 361         '-21600000'=> -360,
 362         '-21599999'=> -360,
 363
 364         '5400000'  => 90,
 365         '10800000' => 180,
 366         '16200000' => 270,
 367         '21600000' => 360,
 368         '21599999' => 360
 369 #
 370 #        '21600000' => 360,   # angle conversions
 371 #        '27000000' => 450,
 372 #        '32400000' => 540,
 373 #        '37800000' => 630
 374     );
 375 }
 376
 377 # Convert the (predefiend) value to a number
 378 sub value( $ )
 379 {
 380     my ( $val ) = @_;
 381
 382     my $result = $variables{$val};
 383     return $result if ( defined( $result ) );
 384
 385     return $val if ( $val =~ /^[0-9-]+$/ );
 386
 387     error( "Unknown variable '$val'." );
 388
 389     show_call_stack();
 390     return $val;
 391 }
 392
 393 # Convert the DrawingML formula to a VML one
 394 my %command_variables = (
 395     'w' => 'width',
 396     'h' => 'height',
 397     'r' => 'width',
 398     'b' => 'height'
 399 );
 400
 401 # The same as value(), but some of the hardcoded values can have a name
 402 sub command_value( $ )
 403 {
 404     my ( $value ) = @_;
 405
 406     return "" if ( $value eq "" );
 407
 408     return $value if ( $value =~ /^@/ );
 409
 410     my $command_val = $command_variables{$value};
 411     if ( defined( $command_val ) ) {
 412         return $command_val;
 413     }
 414
 415     return value( $value );
 416 }
 417
 418 # Insert the new formula to the list of formulas
 419 # Creates the name if it's empty...
 420 sub insert_formula( $$ )
 421 {
 422     my ( $name, $fmla ) = @_;
 423
 424     my $i = 0;
 425     foreach my $f ( @formulas ) {
 426         if ( $f eq $fmla ) {
 427             if ( $name ne "" ) {
 428                 $variables{$name} = "@" . $i;
 429             }
 430             return "@" . $i;
 431         }
 432         ++$i;
 433     }
 434
 435     if ( $name eq "" ) {
 436         $name = "@" . ( $#formulas + 1 );
 437     }
 438
 439     $variables{$name} = "@" . ( $#formulas + 1 );
 440     push @formulas, $fmla;
 441
 442     if ( $#formulas > 127 ) {
 443         error( "Reached the maximum amount of formulas, have to ignore the shape '$shape_name'" );
 444     }
 445
 446     return $variables{$name};
 447 }
 448
 449 # The same as insert_formula(), but converts the params
 450 sub insert_formula_params( $$$$$ )
 451 {
 452     my ( $name, $command, $p1, $p2, $p3 ) = @_;
 453
 454     my $result = $command;
 455     if ( $p1 ne "" ) {
 456         $result .= " " . command_value( $p1 );
 457         if ( $p2 ne "" ) {
 458             $result .= " " . command_value( $p2 );
 459             if ( $p3 ne "" ) {
 460                 $result .= " " . command_value( $p3 );
 461             }
 462         }
 463     }
 464
 465     return insert_formula( $name, $result );
 466 }
 467
 468 # Convert the formula from DrawingML to VML
 469 sub convert_formula( $$ )
 470 {
 471     my ( $name, $fmla ) = @_;
 472
 473     if ( $fmla =~ /^([^ ]+)/ ) {
 474         my $command = $1;
 475
 476         # parse the parameters
 477         ( my $values = $fmla ) =~ s/^([^ ]+) *//;
 478         my $p1 = "";
 479         my $p2 = "";
 480         my $p3 = "";
 481         if ( $values =~ /^([^ ]+)/ ) {
 482             $p1 = $1;
 483             $values =~ s/^([^ ]+) *//;
 484             if ( $values =~ /^([^ ]+)/ ) {
 485                 $p2 = $1;
 486                 $values =~ s/^([^ ]+) *//;
 487                 if ( $values =~ /^([^ ]+)/ ) {
 488                     $p3 = $1;
 489                 }
 490             }
 491         }
 492
 493         # now convert the formula
 494         if ( $command eq "+-" ) {
 495             if ( $p1 eq "100000" ) {
 496                 $p1 = value( 'w' );
 497             }
 498             insert_formula_params( $name, "sum", $p1, $p2, $p3 );
 499             return;
 500         }
 501         elsif ( $command eq "*/" ) {
 502             if ( ( $p2 =~ /^(w|h|ss|hd2|wd2|vc)$/ ) && defined( $variables{$p1} ) ) {
 503                 # switch it ;-) - presetTextWarpDefinitions.xml has it in other order
 504                 my $tmp = $p1;
 505                 $p1 = $p2;
 506                 $p2 = $tmp;
 507             }
 508
 509             if ( ( $p1 =~ /^(w|h|ss|hd2|wd2|vc)$/ ) && defined( $variables{$p2} ) ) {
 510                 my $val3 = $p3;
 511                 if ( $val3 =~ /^[0-9-]+$/ ) {
 512                     $val3 *= ( value( 'w' ) / value( $p1 ) );
 513
 514                     # Oh yes, I'm too lazy to implement the full GCD here ;-)
 515                     if ( ( $val3 % 100000 ) == 0 ) {
 516                         $p1 = 1;
 517                         $p3 = sprintf( "%.0f", ( $val3 / 100000 ) );
 518                     }
 519                     elsif ( $val3 < 100000 ) {
 520                         $p3 = 1;
 521                         while ( ( ( $p3 * 100000 ) % $val3 ) != 0 ) {
 522                             ++$p3
 523                         }
 524                         $p1 = ( $p3 * 100000 ) / $val3;
 525                     }
 526                     else {
 527                         error( "Need to count the greatest common divisor." );
 528                     }
 529                 }
 530             }
 531             elsif ( $p3 eq "100000" && $p2 =~ /^[0-9-]+$/ ) {
 532                 # prevent overflows in some shapes
 533                 $p2 = sprintf( "%.0f", ( $p2 / 10 ) );
 534                 $p3 /= 10;
 535             }
 536             elsif ( $p3 eq "32768" && $p2 =~ /^[0-9-]+$/ ) {
 537                 # prevent overflows in some shapes
 538                 $p2 = sprintf( "%.0f", ( $p2 / 8 ) );
 539                 $p3 /= 8;
 540             }
 541             elsif ( $p3 eq "50000" ) {
 542                 $p3 = 10800;
 543             }
 544             elsif ( $name =~ /^maxAdj/ ) {
 545                 my $val = value( $p1 );
 546                 if ( $val =~ /^[0-9-]+$/ ) {
 547                     $p1 = sprintf( "%.0f", ( value( 'w' ) * $val / 100000 ) );
 548                 }
 549             }
 550
 551             if ( ( value( $p1 ) eq value( $p3 ) ) || ( value( $p2 ) eq value( $p3 ) ) ) {
 552                 my $val = value( ( value( $p1 ) eq value( $p3 ) )? $p2: $p1 );
 553                 if ( $val =~ /^@([0-9]+)$/ ) {
 554                     insert_formula( $name, $formulas[$1] );
 555                 }
 556                 else {
 557                     insert_formula( $name, "val $val" );
 558                 }
 559             }
 560             else {
 561                 insert_formula_params( $name, "prod", $p1, $p2, $p3 );
 562             }
 563             return;
 564         }
 565         elsif ( $command eq "+/" ) {
 566             # we have to split this into 2 formulas - 'sum' and 'prod'
 567             my $constructed = insert_formula_params( "", "sum", $p1, $p2, "0" );
 568             insert_formula_params( $name, "prod", 1, $constructed, $p3); # references the 'sum' formula
 569             return;
 570         }
 571         elsif ( $command eq "?:" ) {
 572             insert_formula_params( $name, "if", $p1, $p2, $p3 );
 573             return;
 574         }
 575         elsif ( $command eq "sin" || $command eq "cos" ) {
 576             if ( $p2 =~ /^[0-9-]+$/ && ( ( $p2 % 60000 ) == 0 ) ) {
 577                 $p2 /= 60000;
 578             }
 579             else {
 580                 $p2 = insert_formula_params( "", "prod", "1", $p2, "60000" );
 581             }
 582             # we have to use 'sumangle' even for the case when $p2 is const
 583             # and theoretically could be written as such; but Word does not
 584             # accept it :-(
 585             my $conv = insert_formula_params( "", "sumangle", "0", $p2, "0" );
 586
 587             $p2 = $conv;
 588
 589             insert_formula_params( $name, $command, $p1, $p2, "" );
 590             return;
 591         }
 592         elsif ( $command eq "abs" ) {
 593             insert_formula_params( $name, $command, $p1, "", "" );
 594             return;
 595         }
 596         elsif ( $command eq "max" || $command eq "min" ) {
 597             insert_formula_params( $name, $command, $p1, $p2, "" );
 598             return;
 599         }
 600         elsif ( $command eq "at2" ) {
 601             insert_formula_params( $name, "atan2", $p1, $p2, "" );
 602             return;
 603         }
 604         elsif ( $command eq "cat2" ) {
 605             insert_formula_params( $name, "cosatan2", $p1, $p2, $p3 );
 606             return;
 607         }
 608         elsif ( $command eq "sat2" ) {
 609             insert_formula_params( $name, "sinatan2", $p1, $p2, $p3 );
 610             return;
 611         }
 612         elsif ( $command eq "sqrt" ) {
 613             insert_formula_params( $name, "sqrt", $p1, "", "" );
 614             return;
 615         }
 616         elsif ( $command eq "mod" ) {
 617             insert_formula_params( $name, "mod", $p1, $p2, $p3 );
 618             return;
 619         }
 620         elsif ( $command eq "val" ) {
 621             insert_formula_params( $name, "val", value( $p1 ), "", "" );
 622             return;
 623         }
 624         else {
 625             error( "Unknown formula '$name', '$fmla'." );
 626         }
 627     }
 628     else {
 629         error( "Cannot convert formula's command '$name', '$fmla'." );
 630     }
 631 }
 632
 633 # There's no exact equivalent of 'arcTo' in VML, we have to do some special casing...
 634 my %convert_arcTo = (
 635     '0' => {
 636         '90' => {
 637             'path' => 'qy',
 638             'op' => [ 'sum 0 __last_x__ __wR__', 'sum __hR__ __last_y__ 0' ],
 639         },
 640         '-90' => {
 641             'path' => 'qy',
 642             'op' => [ 'sum 0 __last_x__ __wR__', 'sum 0 __last_y__ __hR__' ],
 643         },
 644     },
 645     '90' => {
 646         '90' => {
 647             'path' => 'qx',
 648             'op' => [ 'sum 0 __last_x__ __wR__', 'sum 0 __last_y__ __hR__' ],
 649         },
 650         '-90' => {
 651             'path' => 'qx',
 652             'op' => [ 'sum __wR__ __last_x__ 0', 'sum 0 __last_y__ __hR__' ],
 653         },
 654     },
 655     '180' => {
 656         '90' => {
 657             'path' => 'qy',
 658             'op' => [ 'sum __wR__ __last_x__ 0', 'sum 0 __last_y__ __hR__' ],
 659         },
 660         '-90' => {
 661             'path' => 'qy',
 662             'op' => [ 'sum __wR__ __last_x__ 0', 'sum __hR__ __last_y__ 0' ],
 663         },
 664     },
 665     '270' => {
 666         '90' => {
 667             'path' => 'qx',
 668             'op' => [ 'sum __wR__ __last_x__ 0', 'sum __hR__ __last_y__ 0' ],
 669         },
 670         '-90' => {
 671             'path' => 'qx',
 672             'op' => [ 'sum 0 __last_x__ __wR__', 'sum __hR__ __last_y__ 0' ],
 673         },
 674     },
 675 );
 676
 677 # Elliptic quadrant
 678 # FIXME optimize so that we compute the const values when possible
 679 sub elliptic_quadrant( $$$$ )
 680 {
 681     my ( $wR, $hR, $stAng, $swAng ) = @_;
 682
 683     if ( defined( $convert_arcTo{$stAng} ) && defined( $convert_arcTo{$stAng}{$swAng} ) ) {
 684         my $conv_path = $convert_arcTo{$stAng}{$swAng}{'path'};
 685         my $conv_op_ref = $convert_arcTo{$stAng}{$swAng}{'op'};
 686
 687         $path .= "$conv_path";
 688
 689         my $pos_x = $last_pos_x;
 690         my $pos_y = $last_pos_y;
 691         for ( my $i = 0; $i <= $#{$conv_op_ref}; ++$i ) {
 692             my $op = $conv_op_ref->[$i];
 693
 694             $op =~ s/__last_x__/$last_pos_x/g;
 695             $op =~ s/__last_y__/$last_pos_y/g;
 696             $op =~ s/__wR__/$wR/g;
 697             $op =~ s/__hR__/$hR/g;
 698
 699             my $fmla = insert_formula( "", $op );
 700
 701             $path .= $fmla;
 702
 703             # so far it's sufficient just to rotate the positions
 704             # FIXME if not ;-)
 705             $pos_x = $pos_y;
 706             $pos_y = $fmla;
 707         }
 708         $last_pos_x = $pos_x;
 709         $last_pos_y = $pos_y;
 710     }
 711     else {
 712         error( "Unhandled elliptic_quadrant(), input is ($wR, $hR, $stAng, $swAng)." );
 713     }
 714 }
 715
 716 # Convert the quadratic bezier to cubic (exact)
 717 # No idea why, but the 'qb' did not work for me :-(
 718 sub quadratic_to_cubic_bezier( $ )
 719 {
 720     my ( $axis ) = @_;
 721
 722     my $a0 = $quadratic_bezier[0]->{$axis};
 723     my $a1 = $quadratic_bezier[1]->{$axis};
 724     my $a2 = $quadratic_bezier[2]->{$axis};
 725
 726     my $b0 = $a0;
 727
 728     # $b1 = $a0 + 2/3 * ( $a1 - $a0 ), but in VML
 729     # FIXME optimize for constants - compute directly
 730     my $b1_1 = insert_formula_params( "", "sum", "0", $a1, $a0 );
 731     my $b1_2 = insert_formula_params( "", "prod", "2", $b1_1, "3" );
 732     my $b1   = insert_formula_params( "", "sum", $a0, $b1_2, "0" );
 733
 734     # $b2 = $b1 + 1/3 * ( $a2 - $a0 );
 735     # FIXME optimize for constants - compute directly
 736     my $b2_1 = insert_formula_params( "", "sum", "0", $a2, $a0 );
 737     my $b2_2 = insert_formula_params( "", "prod", "1", $b2_1, "3" );
 738     my $b2   = insert_formula_params( "", "sum", $b1, $b2_2, "0" );
 739
 740     my $b3 = $a2;
 741
 742     return ( $b0, $b1, $b2, $b3 );
 743 }
 744
 745 # Extend $path by one more point
 746 sub add_point_to_path( $$ )
 747 {
 748     my ( $x, $y ) = @_;
 749
 750     if ( $path =~ /[0-9]$/ && $x =~ /^[0-9-]/ ) {
 751         $path .= ",";
 752     }
 753     $path .= $x;
 754
 755     if ( $path =~ /[0-9]$/ && $y =~ /^[0-9-]/ ) {
 756         $path .= ",";
 757     }
 758     $path .= $y;
 759 }
 760
 761 # Start of an element
 762 sub start_element( $% )
 763 {
 764     my ( $element, %attr ) = @_;
 765
 766     push @levels, $element;
 767
 768     #print "element: $element\n";
 769
 770     if ( @levels > 1 && ( $levels[-2] eq "presetShapeDefinitons" ||
 771                           $levels[-2] eq "presetTextWarpDefinitions" ) ) {
 772         $shape_name = $element;
 773
 774         $state = "";
 775         $ignore_this_shape = 0;
 776         $path = "";
 777         $adjust = "";
 778         $max_adj_no = 0;
 779         @formulas = ();
 780         $handles = "";
 781         $textboxrect = "";
 782         $last_pos_x = "";
 783         $last_pos_y = "";
 784         $no_stroke = 0;
 785         $no_fill = 0;
 786         @quadratic_bezier = ();
 787
 788         setup_variables();
 789
 790         if ( $shape_name eq "sun" ) {
 791             # hack for this shape
 792             $variables{'100000'} = "21600";
 793             $variables{'50000'} = "10800";
 794             $variables{'25000'} = "5400";
 795             $variables{'12500'} = "2700";
 796             $variables{'3662'} = "791";
 797         }
 798
 799         my $found = 0;
 800         foreach my $name ( values( %shapes_ids ) ) {
 801             if ( $name eq $shape_name ) {
 802                 $found = 1;
 803                 last;
 804             }
 805         }
 806         if ( !$found ) {
 807             error( "Unknown shape '$shape_name'." );
 808         }
 809     }
 810     elsif ( $element eq "pathLst" ) {
 811         $state = "path";
 812     }
 813     elsif ( $element eq "avLst" ) {
 814         $state = "adjust";
 815     }
 816     elsif ( $element eq "gdLst" ) {
 817         $state = "formulas";
 818     }
 819     elsif ( $element eq "ahLst" ) {
 820         $state = "handles";
 821     }
 822     elsif ( $element eq "rect" ) {
 823         $textboxrect = value( $attr{'l'} ) . "," . value( $attr{'t'} ) . "," .
 824                        value( $attr{'r'} ) . "," . value( $attr{'b'} );
 825     }
 826     elsif ( $state eq "path" ) {
 827         if ( $element eq "path" ) {
 828             $no_stroke = ( defined( $attr{'stroke'} ) && $attr{'stroke'} eq 'false' );
 829             $no_fill = ( defined( $attr{'fill'} ) && $attr{'fill'} eq 'none' );
 830             $path_w = $attr{'w'};
 831             $path_h = $attr{'h'};
 832         }
 833         elsif ( $element eq "moveTo" ) {
 834             $path .= "m";
 835         }
 836         elsif ( $element eq "lnTo" ) {
 837             $path .= "l";
 838         }
 839         elsif ( $element eq "cubicBezTo" ) {
 840             $path .= "c";
 841         }
 842         elsif ( $element eq "quadBezTo" ) {
 843             my %points = ( 'x' => $last_pos_x, 'y' => $last_pos_y );
 844             @quadratic_bezier = ( \%points );
 845         }
 846         elsif ( $element eq "close" ) {
 847             $path .= "x";
 848         }
 849         elsif ( $element eq "pt" ) {
 850             # remember the last position for the arcTo
 851             $last_pos_x = value( $attr{'x'} );
 852             $last_pos_y = value( $attr{'y'} );
 853
 854             $last_pos_x *= ( value( 'w' ) / $path_w ) if ( defined( $path_w ) );
 855             $last_pos_y *= ( value( 'h' ) / $path_h ) if ( defined( $path_h ) );
 856
 857             if ( $#quadratic_bezier >= 0 ) {
 858                 my %points = ( 'x' => $last_pos_x, 'y' => $last_pos_y );
 859                 push( @quadratic_bezier, \%points );
 860             }
 861             else {
 862                 add_point_to_path( $last_pos_x, $last_pos_y );
 863             }
 864         }
 865         elsif ( ( $element eq "arcTo" ) && ( $last_pos_x ne "" ) && ( $last_pos_y ne "" ) ) {
 866             # there's no exact equivalent of arcTo in VML, so we have to
 867             # compute here a bit...
 868             my $stAng = value( $attr{'stAng'} );
 869             my $swAng = value( $attr{'swAng'} );
 870             my $wR = value( $attr{'wR'} );
 871             my $hR = value( $attr{'hR'} );
 872
 873             $wR *= ( value( 'w' ) / $path_w ) if ( defined( $path_w ) );
 874             $hR *= ( value( 'h' ) / $path_h ) if ( defined( $path_h ) );
 875
 876             if ( ( $stAng =~ /^[0-9-]+$/ ) && ( $swAng =~ /^[0-9-]+$/ ) ) {
 877                 if ( ( ( $stAng % 90 ) == 0 ) && ( ( $swAng % 90 ) == 0 ) && ( $swAng != 0 ) ) {
 878                     my $end = $stAng + $swAng;
 879                     my $step = ( $swAng > 0 )? 90: -90;
 880
 881                     for ( my $cur = $stAng; $cur != $end; $cur += $step ) {
 882                         elliptic_quadrant( $wR, $hR, ( $cur % 360 ), $step );
 883                     }
 884                 }
 885                 else {
 886                     error( "Unsupported numeric 'arcTo' ($attr{'wR'}, $attr{'hR'}, $stAng, $swAng)." );
 887                 }
 888             }
 889             else {
 890                 error( "Unsupported 'arcTo' conversion ($attr{'wR'}, $attr{'hR'}, $stAng, $swAng)." );
 891             }
 892         }
 893         else {
 894             error( "Unhandled path element '$element'." );
 895         }
 896     }
 897     elsif ( $state eq "adjust" ) {
 898         if ( $element eq "gd" ) {
 899             my $adj_no = $attr{'name'};
 900
 901             # Save this adj number for this type for later use.
 902             push(@{$adj_names{$shape_name}}, $adj_no);
 903
 904             my $is_const = 0;
 905
 906             $adj_no =~ s/^adj//;
 907             if ( $adj_no eq "" ) {
 908                 $max_adj_no = 0;
 909             }
 910             elsif ( !( $adj_no =~ /^[0-9]*$/ ) ) {
 911                 ++$max_adj_no;
 912                 $is_const = 1;
 913             }
 914             elsif ( $adj_no != $max_adj_no + 1 ) {
 915                 error( "Wrong order of adj values." );
 916                 ++$max_adj_no;
 917             }
 918             else {
 919                 $max_adj_no = $adj_no;
 920             }
 921
 922             if ( $attr{'fmla'} =~ /^val ([0-9-]*)$/ ) {
 923                 my $val = sprintf( "%.0f", ( 21600 * $1 ) / 100000 );
 924                 if ( $is_const ) {
 925                     $variables{$adj_no} = $val;
 926                 }
 927                 elsif ( $adjust eq "" ) {
 928                     $adjust = $val;
 929                 }
 930                 else {
 931                     $adjust = "$val,$adjust";
 932                 }
 933             }
 934             else {
 935                 error( "Wrong fmla '$attr{'fmla'}'." );
 936             }
 937         }
 938         else {
 939             error( "Unhandled adjust element '$element'." );
 940         }
 941     }
 942     elsif ( $state eq "formulas" ) {
 943         if ( $element eq "gd" ) {
 944             if ( $attr{'fmla'} =~ /^\*\/ (h|w|ss) adj([0-9]+) 100000$/ ) {
 945                 insert_formula( $attr{'name'}, "val #" . ( $max_adj_no - $2 ) );
 946             }
 947             elsif ( $attr{'fmla'} =~ /^pin [^ ]+ ([^ ]+) / ) {
 948                 print STDERR "TODO Map 'pin' to VML as xrange for handles.\n";
 949                 my $pin_val = $1;
 950                 if ( $pin_val eq "adj" ) {
 951                     insert_formula( $attr{'name'}, "val #0" );
 952                 }
 953                 elsif ( $pin_val =~ /^adj([0-9]+)/ ) {
 954                     insert_formula( $attr{'name'}, "val #" . ( $max_adj_no - $1 ) );
 955                 }
 956                 else {
 957                     insert_formula( $attr{'name'}, "val " . value( $pin_val ) );
 958                 }
 959             }
 960             elsif ( $attr{'fmla'} =~ /adj/ ) {
 961                 error( "Non-standard usage of adj in '$attr{'fmla'}'." );
 962             }
 963             else {
 964                 convert_formula( $attr{'name'}, $attr{'fmla'} );
 965             }
 966         }
 967     }
 968     elsif ( $state eq "handles" ) {
 969         if ( $element eq "pos" ) {
 970             $handles .= "<v:h position=\"" . value( $attr{'x'} ) . "," . value( $attr{'y'} ) . "\"/>\n";
 971         }
 972     }
 973 }
 974
 975 # End of an element
 976 sub end_element( $ )
 977 {
 978     my ( $element ) = @_;
 979
 980     pop @levels;
 981
 982     if ( $element eq $shape_name ) {
 983         if ( !$ignore_this_shape ) {
 984             # we have all the info, generate the shape now
 985             $state = "";
 986
 987             # shape path
 988             my $out = "<v:shapetype id=\"shapetype___ID__\" coordsize=\"21600,21600\" o:spt=\"__ID__\" ";
 989             if ( $adjust ne "" ) {
 990                 $out .= "adj=\"$adjust\" ";
 991             }
 992
 993             # optimize it [yes, we need this twice ;-)]
 994             $path =~ s/([^0-9-@])0([^0-9-@])/$1$2/g;
 995             $path =~ s/([^0-9-@])0([^0-9-@])/$1$2/g;
 996
 997             $out .= "path=\"$path\">\n";
 998
 999             # stroke
1000             $out .= "<v:stroke joinstyle=\"miter\"/>\n";
1001
1002             # formulas
1003             if ( $#formulas >= 0 )
1004             {
1005                 $out .= "<v:formulas>\n";
1006                 foreach my $fmla ( @formulas ) {
1007                     $out .= "<v:f eqn=\"$fmla\"/>\n"
1008                 }
1009                 $out .= "</v:formulas>\n";
1010             }
1011
1012             # path
1013             if ( $textboxrect ne "" ) { # TODO connectlocs, connectangles
1014                 $out .= "<v:path gradientshapeok=\"t\" o:connecttype=\"rect\" textboxrect=\"$textboxrect\"/>\n";
1015             }
1016
1017             # handles
1018             if ( $handles ne "" ) {
1019                 $out .= "<v:handles>\n$handles</v:handles>\n";
1020             }
1021
1022             $out .="</v:shapetype>";
1023
1024             # hooray! :-)
1025             $result_shapes{$shape_name} = $out;
1026         }
1027         else {
1028             print STDERR "Shape '$shape_name' ignored; see the above error(s) for the reason.\n";
1029         }
1030         $shape_name = "";
1031     }
1032     elsif ( $state eq "path" ) {
1033         if ( $element eq "path" ) {
1034             $path .= "ns" if ( $no_stroke );
1035             $path .= "nf" if ( $no_fill );
1036             $path .= "e";
1037         }
1038         elsif ( $element eq "quadBezTo" ) {
1039             # we have to convert the quadratic bezier to cubic
1040             if ( $#quadratic_bezier == 2 ) {
1041                 my @points_x = quadratic_to_cubic_bezier( 'x' );
1042                 my @points_y = quadratic_to_cubic_bezier( 'y' );
1043
1044                 $path .= "c";
1045                 # ignore the starting point
1046                 for ( my $i = 1; $i < 4; ++$i ) {
1047                     add_point_to_path( $points_x[$i], $points_y[$i] );
1048                 }
1049             }
1050             else {
1051                 error( "Wrong number of points of the quadratic bezier." );
1052             }
1053             @quadratic_bezier = ();
1054         }
1055     }
1056     elsif ( $element eq "avLst" ) {
1057         $state = "";
1058     }
1059     elsif ( $element eq "gdLst" ) {
1060         $state = "";
1061     }
1062     elsif ( $element eq "ahLst" ) {
1063         $state = "";
1064     }
1065 }
1066
1067 # Text inside an element
1068 sub characters( $ )
1069 {
1070     #my ( $text ) = @_;
1071 }
1072
1073 #################### A trivial XML parser ####################
1074
1075 # Parse the attributes
1076 sub parse_start_element( $ )
1077 {
1078     # split the string containing both the elements and attributes
1079     my ( $element_tmp ) = @_;
1080
1081     $element_tmp =~ s/\s*$//;
1082     $element_tmp =~ s/^\s*//;
1083
1084     ( my $element = $element_tmp ) =~ s/\s.*$//;
1085     if ( $element_tmp =~ /\s/ ) {
1086         $element_tmp =~ s/^[^\s]*\s//;
1087     }
1088     else {
1089         $element_tmp = "";
1090     }
1091
1092     # we have the element, now the attributes
1093     my %attr;
1094     my $is_key = 1;
1095     my $key = "";
1096     foreach my $tmp ( split( /"/, $element_tmp ) ) {
1097         if ( $is_key ) {
1098             $key = $tmp;
1099             $key =~ s/^\s*//;
1100             $key =~ s/\s*=\s*$//;
1101         }
1102         else {
1103             $attr{$key} = $tmp;
1104         }
1105         $is_key = !$is_key;
1106     }
1107
1108     if ( $element ne "" ) {
1109         start_element( $element, %attr );
1110     }
1111 }
1112
1113 # Parse the file
1114 sub parse( $ )
1115 {
1116     my ( $file ) = @_;
1117
1118     my $in_comment = 0;
1119     my $line = "";
1120     while (<$file>) {
1121         # ignore comments
1122         s/<\?[^>]*\?>//g;
1123         s/<!--[^>]*-->//g;
1124         if ( /<!--/ ) {
1125             $in_comment = 1;
1126             s/<!--.*//;
1127         }
1128         elsif ( /-->/ && $in_comment ) {
1129             $in_comment = 0;
1130             s/.*-->//;
1131         }
1132         elsif ( $in_comment ) {
1133             next;
1134         }
1135         # ignore empty lines
1136         chomp;
1137         s/^\s*//;
1138         s/\s*$//;
1139         next if ( $_ eq "" );
1140
1141         # take care of lines where element continues
1142         if ( $line ne "" ) {
1143             $line .= " " . $_;
1144         }
1145         else {
1146             $line = $_;
1147         }
1148         next if ( !/>$/ );
1149
1150         # the actual parsing
1151         my @starts = split( /</, $line );
1152         $line = "";
1153         foreach my $start ( @starts ) {
1154             next if ( $start eq "" );
1155
1156             my @ends = split( />/, $start );
1157             my $element = $ends[0];
1158             my $data = $ends[1];
1159
1160             # start or end element
1161             if ( $element =~ /^\/(.*)/ ) {
1162                 end_element( $1 );
1163             }
1164             elsif ( $element =~ /^(.*)\/$/ ) {
1165                 parse_start_element( $1 );
1166                 ( my $end = $1 ) =~ s/\s.*$//;
1167                 end_element( $end );
1168             }
1169             else {
1170                 parse_start_element( $element );
1171             }
1172
1173             # the data
1174             characters( $data ) if ( defined( $data ) && $data ne "" );
1175         }
1176     }
1177 }
1178
1179 # Do the real work
1180 my $file;
1181 open( $file, "<$src_shapes" ) || die "Cannot open $src_shapes: $!";
1182 parse( $file );
1183 close( $file );
1184
1185 open( $file, "<$src_text" ) || die "Cannot open $src_text: $!";
1186 parse( $file );
1187 close( $file );
1188
1189 if ( !defined( $result_shapes{'textBox'} ) ) {
1190     $result_shapes{'textBox'} =
1191         "<v:shapetype id=\"shapetype___ID__\" coordsize=\"21600,21600\" " .
1192         "o:spt=\"__ID__\" path=\"m,l,21600l21600,21600l21600,xe\">\n" .
1193         "<v:stroke joinstyle=\"miter\"/>\n" .
1194         "<v:path gradientshapeok=\"t\" o:connecttype=\"rect\"/>\n" .
1195         "</v:shapetype>";
1196 }
1197
1198 # Generate the data
1199 if ($drawingml_adj_names_data eq 1) {
1200     foreach my $adj_name (sort(keys %adj_names))
1201     {
1202         foreach my $adj (@{$adj_names{$adj_name}})
1203         {
1204             print "$adj_name\t$adj\n";
1205         }
1206     }
1207     exit 0;
1208 } elsif ($vml_shape_types_data eq 1) {
1209     for ( my $i = 0; $i < 203; ++$i ) {
1210         if ( $i < 4 ) {
1211             print "/* $i - $shapes_ids{$i} - handled separately */\nNULL\n";
1212         }
1213         else {
1214             print "/* $i - $shapes_ids{$i} */\n";
1215             my $out = $result_shapes{$shapes_ids{$i}};
1216             if ( defined( $out ) ) {
1217                 # set the id
1218                 $out =~ s/__ID__/$i/g;
1219
1220                 # output as string
1221                 $out =~ s/\n//g;
1222
1223                 print "$out\n";
1224             }
1225             else {
1226                 print "NULL\n";
1227             }
1228         }
1229     }
1230     exit 0;
1231 }
1232
1233 # should not happen
1234 exit 1;
1235
1236 # vim:set ft=perl shiftwidth=4 softtabstop=4 expandtab: #