#!/usr/bin/perl

# $Id: idraw2graffle.pl,v 1.17 2007/08/17 09:09:15 kono Exp $
#
# Convert idraw format to OmniGraffle format
#
#  Author: Shinji Kono
#** 連絡先： 琉球大学情報工学科 河野 真治 
# ** （E-Mail Address: kono@ie.u-ryukyu.ac.jp）
#
#**    このソースのいかなる複写，改変，修正も許諾します。ただし、
#**    その際には、誰が貢献したを示すこの部分を残すこと。
#**    再配布や雑誌の付録などの問い合わせも必要ありません。
#**    営利利用も上記に反しない範囲で許可します。
#**    このプログラムについては特に何の保証もしない、悪しからず。
#**
#**    Everyone is permitted to do anything on this program 
#**    including copying, modifying, improving,
#**    as long as you don't try to pretend that you wrote it.
#**    i.e., the above copyright notice has to appear in all copies.  
#**    You don't have to ask before copying, redistribution or publishing.
#**    THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE.



use NKF;

my $debug = 0;
# Default Cordinates
#    x1 = a*x+c*y+x
#    y1 = b*x+d*y+y

my $obj = [];

my @buf_stack; 

&initCord;

my $d = '([-+0-9.e]+)';  # partern of number

# No tags for top level
my $ctag = 0;
my @tags = ();  

my @color;
my @bgcolor;
my ($front_color,$back_color);

$group_nest = 0;

&header;

while(<>) {
  chop;
  # Argument part
  if (/%I b (.*)/) { $brush = $1;
     if(/none SetP %I p n/) {
        next;
     }
     ($lwidth,$farrow,$larrow,$dash,$ltype) = (0,0,0,0,0);
     $_ = <>; 
     if(/(\d+) (\d+) (\d+) \[([^]]*)\] (\d+) SetB/) {
        ($lwidth,$farrow,$larrow,$dash,$ltype) = ($1,$2,$3,$4,$5);
     } elsif(/(\d+) (\d+) (\d+) \[\] (\d+) SetB/) {
        ($lwidth,$farrow,$larrow,$dash,$ltype) = ($1,$2,$3,0,$4);
     } 
  } elsif (/%I cfg (.*)/) { 
     $_ = <>; @color = /([-.\d]+)/g;
     $front_color = &color(@color);
  } elsif (/%I cbg (.*)/) { 
     $_ = <>; @bgcolor = /([-.\d]+)/g; 
     $back_color = &color(@bgcolor);
  } elsif (/%I f (.*)/) {  $font = $1; 
     $kanji = ($font =~ /jisx0208/)?1:0;
     $font =~ s/ /\\ /g;
  } elsif (/%I p n/) {     $pattern = 'none';
  } elsif (/%I p (.*)/) {  $pattern = $1;
  } elsif (/%I p$/) {  
     $_ = <>; /([-.\d]+)/; $pattern = $1;
  } elsif (/%I t u/) {
     ($ac,$bc,$cc,$dc,$xc,$yc) =  ($ab,$bb,$cb,$db,$xb,$yb);
  } elsif (/%I t$/) { $_ = <>; 
#    (ab,bb,...)   base   translation
#    (al,bl,...)   local  translation
#    (ac,bc,...)   curret translation
     ($al,$bl,$cl,$dl,$xl,$yl) = 
     /\[\s*$d\s+$d\s+$d\s+$d\s+$d\s+$d\s*\] concat/o;
#    Calculate new current translation (easy. ha?)
#    x2 = ab*(al*x+cl*y+xl)+cb*(bl*x+dl*y+yl)+xb,
#    y2 = bb*(al*x+cl*y+xl)+db*(bl*x+dl*y+yl)+yb 
    ($ac,$bc,$cc,$dc,$xc,$yc) = 
    ($al*$ab+$cb*$bl,    $bb*$al+$db*$bl, 
     $ab*$cl+$cb*$dl,    $bb*$cl+$db*$dl,
     $ab*$xl+$cb*$yl+$xb,$bb*$xl+$db*$yl+$yb);
     if($type eq 'Pict' || $type eq 'Idraw') {
        # Change Base Translation
        ($ab,$bb,$cb,$db,$xb,$yb) = ($ac,$bc,$cc,$dc,$xc,$yc);
        $type = '';
     }
#     print "### Cord $ac,$bc,$cc,$dc,$xc,$yc\n" if $debug;
  # Group part
  } elsif(/%I Pict/) {
     $type = 'Pict';
     $brush = $front_color = $back_color =  $font = $point = 'n';
     push(@cord,$ab,$bb,$cb,$db,$xb,$yb);
     push(@tags,'t' . $ctag++);
     # print "### Begin Pict\n" if $debug;
     push(@buf_stack,$obj); 
     $obj = [];

  } elsif(/%I eop/) {   # Pop global translation in reverse order
     if(@cord) {
	 $tag = pop(@tags) if (@tags);
	 $yb = pop(@cord); $xb = pop(@cord);
	 $db = pop(@cord); $cb = pop(@cord);
	 $bb = pop(@cord); $ab = pop(@cord);
     $id++;
     my $buf = &flush_obj($obj); $obj = pop(@buf_stack);
     &print($obj, << "EOF");
                <dict>
                        <key>Class</key>
                        <string>Group</string>
                        <key>Graphics</key>
                        <array>
EOF
     &print ($obj, << "EOF");
$buf
                        </array>
                        <key>ID</key>
                        <integer>$id</integer>
                </dict>
EOF
     } else {
         &initCord;
     }
     # print "### End Pict\n" if $debug;
  # Item part
  } elsif(/%I (Text|Line|MLine|Poly|Rect|Elli|CBSpl|BSpl|Idraw|Circ)/) {
     $type = $1; @points = (); $pattern = 'none';
     $brush = 65535;
     $front_color = 'Black';
     $back_color =  'White';
     $font = "-*-times-medium-r-normal--12-*-iso8859-1";
     ($al,$bl,$cl,$dl,$xl,$yl) = (1,0,0,1,0,0);
     ($ac,$bc,$cc,$dc,$xc,$yc) =  ($ab,$bb,$cb,$db,$xb,$yb);
     # print "### Begin $type\n" if $debug;
     $obj = &new_obj($obj);
  } elsif(/^%I ([-\d]+)$/||/^%I$/) {
     # print "### Data of $type\n" if $debug;
     if($type eq 'Text') {
        $_ = <>; $text = '';
        while(<>) {
            last if (! /^\(/);
            s/^\(//; chop; chop;
            s/\\([()])/$1/g; 
            $text .= $_ . "\n";
        }
        chop($text);
        if ($kanji) {
#            $text =~ s/\$/\\\$/g;
            $text = "\033\$B" . $text . "\033\(B" ;
            $text =~ s/\n/\033\(B\n\033\$B/g;
        } else {
            $text =~ s/(\$|\&|\"|\[|\]|@)/\\$1/g; 
            $text = eval('"'.$text.'"');
#            $text =~ s/\\\\(\d\d\d)/$1/eg;
#            $text =~ s/\n/\\n/g; 
        }
	print_text(&text_conv($text,$font));
     } elsif($type eq 'Line') {
        if($brush eq 'n') { next; }
	$_ = <>; @points = /$d $d $d $d Line/o;
        &print_line($type,
	    &points($points[0],$points[1]),
	    &points($points[2],$points[3])); 
     } elsif($type eq 'BSpl' || $type eq 'MLine') {
        if($brush eq 'n') { next; }
        my (@p);
        while(<>) {
           last if(/[-\d]+ (BSpl|MLine)/);
           if(/^$d $d/o) {
              push(@p,&points($1,$2));
           }
        }
        &print_line($type,@p);
     } elsif($type eq 'CBSpl' || $type eq 'Poly') {
          my (@p,$x0,$y0,$x1,$y1); 
          $i = 0; 
          while(<>) {
             if(/^$d $d/o) { @buf = ($1,$2); last; }
	  }
          push(@p,&points(@buf));
	  $x0=$p[0]; $y0=$p[1]; $x1=$p[0]; $y1=$p[1];
	  ($x0,$y0,$x1,$y1) = &bound($x0,$y0,$x1,$y1,@p);
# print "bound ($x0,$y0,$x1,$y1) $p[0] $p[1]\n" ;
          while(<>) {
             last if(/[-\d]+ (CBSpl|Poly)/);
             if(/^$d $d/o) {
                push(@p,&points($1,$2));
	        ($x0,$y0,$x1,$y1) = 
		    &bound($x0,$y0,$x1,$y1,$p[$#p-1],$p[$#p]);
# print "bound ($x0,$y0,$x1,$y1) $p[$#p-1],$p[$#p]\n" ;
             }
          }
          push(@p,&points(@buf));
          $larrow = $farrow = 0;
	  ($x0,$y0,$x1,$y1) = &fix_bound($x0,$y0,$x1,$y1);
# print "fixed bound ($x0,$y0,$x1,$y1) \n" ;
	  &print_polygon($type,$x0,$y0,$x1,$y1,@p);
     } elsif($type eq 'Rect') {
        my (@p);
        if($brush eq 'n' && ! $area_fill ) { next; }
	$_ = <>; @points = /$d $d $d $d Rect/o;
	push(@p,&points($points[0],$points[1])); 
	push(@p,&points($points[2],$points[3])); 
        if ($p[0]>$p[2]) { ($p[0],$p[2]) = ($p[2],$p[0]);}
        if ($p[1]>$p[3]) { ($p[1],$p[3]) = ($p[3],$p[1]);}
	$p[2] = $p[2]-$p[0];
	$p[3] = $p[3]-$p[1];
        $larrow = $farrow = 0;
        &print_shape('Rectangle',@p);
     } elsif($type eq 'Elli'||$type eq 'Circ') {
        my (@p);
        if($brush eq 'n' && ! $area_fill ) { next; }
        $_ = <>;
        if($type eq 'Elli') {
	    ($x,$y,$rx,$ry) = /$d $d $d $d Elli/o;
        } else {
	    ($x,$y,$rx) = /$d $d $d Circ/o; $ry = $rx;
        }
        if($bc==0 && $cc==0) {
	    push(@p,&points($x-$rx,$y+$ry));
	    push(@p,&points($x+$rx,$y-$ry)); 
        } else {
            # support no rotated ellipse, but rotated circle (ha!)
	    ($x,$y) = (int($ac*$x + $cc*$y + $xc),int($bc*$x + $dc*$y + $yc));
            $r = ($ac * $dc - $bc * $cc) * $rx * $ry;
            $r = int(sqrt(($r>0)?$r : - $r));
            push(@p, $x-$r,$y+$r,$x+$r,$y-$r); 
        }
        if ($p[0]>$p[2]) { ($p[0],$p[2]) = ($p[2],$p[0]);}
        if ($p[1]>$p[3]) { ($p[1],$p[3]) = ($p[3],$p[1]);}
	$p[2] = $p[2]-$p[0];
	$p[3] = $p[3]-$p[1];
        $larrow = $farrow = 0;
        &print_shape('Circle',@p);
     }
     # print "\n";
     $type = '';
     while(<>) { print "### $_" if $debug; 
        last if (/^End/); 
     }
  } elsif (/^%%EndComments/) {
     &initCord;
     # skip header part (quite long)
     while(<>) {
        last if (/^%%EndProlog/);
     }
  } 
# else { print; print "\n"; }
}
print &flush_obj($obj);

&footer;

# subroutines

sub bound {
    my ($x0,$y0,$x1,$y1,$x,$y) = @_;
    (($x0>$x)?$x:$x0 ,($y0>$y)?$y:$y0 ,
          ($x1<$x)?$x:$x1 ,($y1<$y)?$y:$y1);
}

sub fix_bound {
    my ($x0,$y0,$x1,$y1) = @_;
    (($x0>$x1)?$x1:$x0,
	($y0>$y1)?$y1:$y0,
	($x0>$x1)?($x0-$x1):($x1-$x0),
	($y0>$y1)?($y0-$y1):($y1-$y0));
}

sub initCord {
    $xoffset = 0; $yoffset = 800; $scale = 1;
    ($ac,$bc,$cc,$dc,$xc,$yc) = 
    ($ab,$bb,$cb,$db,$xb,$yb) = ($scale,0,0,-$scale,$xoffset,$yoffset);
}

sub points {
   my($x,$y) = @_;
   # Translate cordinates using current translation
   #    x1 = a*x+c*y+x0
   #    y1 = b*x+d*y+y0

   (int($ac*$x + $cc*$y + $xc)+$offset_x,int($bc*$x + $dc*$y + $yc)+$offset_y);
}

sub print_line {
   my ($type,@p) = @_;
   my ($points,$style);
   my ($ha,$ta,$line_type);

   if (0) {
   if($pattern eq 'none') { # print " -fill {}";  This display nothing
   } elsif ($pattern == 1) {
	# solid pattern
   } else {
   }
   }
   my $color = &color_pattern($pattern,@color);
   $ha = $larrow?"FilledArrow":"0";
   $ta = $farrow?"FilledArrow":"0";
   while (@p) {
        my ($x,$y) = (shift(@p),shift(@p));
        $points .= "\t\t\t<string>{$x,$y}</string>\n";
   }
   if ($type =~ /Spl/) {
       $line_type .= "\n<key>LineType</key>\n<integer>1</integer>"; 
   } 
   if($lwidth > 1) {
       $line_type .= "\n<key>Width</key>\n<real>$lwidth</real>"; 
   } 
   if($brush == 65535) {
   } elsif($brush > 7000) {
       $line_type .= "\n<key>Pattern</key>\n<integer>11</integer>"; 
   } elsif($brush > 3000) {
       $line_type .= "\n<key>Pattern</key>\n<integer>2</integer>"; 
   } elsif($brush > 0) {
       $line_type .= "\n<key>Pattern</key>\n<integer>1</integer>"; 
   } 
   $id ++;
&print($obj, <<"EOF");
<dict>
	<key>Class</key>
	<string>LineGraphic</string>
	<key>ID</key>
	<integer>$id</integer>
	<key>Points</key>
	<array>
	        $points
	</array>
	<key>Style</key>
	<dict>
		<key>stroke</key>
		<dict>$color
                        <key>Cap</key>
                        <integer>0</integer>
			<key>HeadArrow</key>
			<string>$ha</string>
			<key>TailArrow</key>
			<string>$ta</string>
$line_type		</dict>
	</dict>
</dict>
EOF

}

sub color { 
    my($red,$blue,$green) = @_;
    $red   = int($red*255) ; 
    $blue  = int($blue*255) ; 
    $green = int($green*255) ;
    return "{\\colortbl;\\red${red}\\green${green}\\blue${blue};}\n";
}

sub header {
print <<'EOF';
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE plist SYSTEM "file://localhost/System/Library/DTDs/PropertyList.dtd">
<plist version="0.9">
<dict>
	<key>CanvasColor</key>
	<dict>
		<key>w</key>
		<real>1.000000e+00</real>
	</dict>
	<key>ColumnAlign</key>
	<integer>0</integer>
	<key>ColumnSpacing</key>
	<real>3.600000e+01</real>
	<key>GraphDocumentVersion</key>
	<integer>2</integer>
	<key>GraphicsList</key>
	<array>
EOF
}

sub footer {
print <<'EOF';
	</array>
	<key>GridInfo</key>
	<dict/>
	<key>HPages</key>
	<integer>1</integer>
	<key>ImageCounter</key>
	<integer>1</integer>
	<key>IsPalette</key>
	<string>NO</string>
	<key>Layers</key>
	<array>
		<dict>
			<key>Lock</key>
			<string>NO</string>
			<key>Name</key>
			<string>Layer</string>
			<key>Print</key>
			<string>YES</string>
			<key>View</key>
			<string>YES</string>
		</dict>
		<dict>
			<key>Lock</key>
			<string>NO</string>
			<key>Name</key>
			<string>Background</string>
			<key>Print</key>
			<string>YES</string>
			<key>View</key>
			<string>YES</string>
		</dict>
	</array>
	<key>LayoutInfo</key>
	<dict>
		<key>AutoAdjust</key>
		<string>YES</string>
		<key>LayoutType</key>
		<integer>1</integer>
		<key>MagneticFieldCenter</key>
		<string>{0, 0}</string>
		<key>Orientation</key>
		<string>YES</string>
	</dict>
	<key>MagnetsEnabled</key>
	<string>YES</string>
	<key>PageBreakColor</key>
	<dict>
		<key>w</key>
		<real>3.333333e-01</real>
	</dict>
	<key>PageBreaks</key>
	<string>YES</string>
	<key>PageSetup</key>
	<data>
	BAt0eXBlZHN0cmVhbYED6IQBQISEhAtOU1ByaW50SW5mbwGEhAhOU09iamVjdACFkoSE
	hBNOU011dGFibGVEaWN0aW9uYXJ5AISEDE5TRGljdGlvbmFyeQCUhAFpEpKEhIQITlNT
	dHJpbmcBlIQBKxBOU0pvYkRpc3Bvc2l0aW9uhpKEmZkPTlNQcmludFNwb29sSm9ihpKE
	mZkOTlNCb3R0b21NYXJnaW6GkoSEhAhOU051bWJlcgCEhAdOU1ZhbHVlAJSEASqEhAFm
	nSSGkoSZmQtOU1BhcGVyTmFtZYaShJmZBkxldHRlcoaShJmZD05TUHJpbnRBbGxQYWdl
	c4aShJ2chIQBc54AhpKEmZkNTlNSaWdodE1hcmdpboaShJ2cn50khpKEmZkITlNDb3Bp
	ZXOGkoSdnISEAVOfAYaShJmZD05TU2NhbGluZ0ZhY3RvcoaShJ2chIQBZKABhpKEmZkL
	TlNGaXJzdFBhZ2WGkoSdnKmfAYaShJmZFE5TVmVydGljYWxQYWdpbmF0aW9uhpKEnZyk
	ngCGkoSZmRVOU0hvcml6b25hbFBhZ2luYXRpb26GkoSdnKSeAIaShJmZFk5TSG9yaXpv
	bnRhbGx5Q2VudGVyZWSGkoSdnKSeAYaShJmZDE5TTGVmdE1hcmdpboaShJ2cn50khpKE
	mZkNTlNPcmllbnRhdGlvboaShJ2cpJ4AhpKEmZkZTlNQcmludFJldmVyc2VPcmllbnRh
	dGlvboaSo5KEmZkKTlNMYXN0UGFnZYaShJ2chJeXgn////+GkoSZmQtOU1RvcE1hcmdp
	boaShJ2cn50khpKEmZkUTlNWZXJ0aWNhbGx5Q2VudGVyZWSGkrSShJmZC05TUGFwZXJT
	aXplhpKEnpyEhAx7X05TU2l6ZT1mZn2hgQJkgQMYhoaG
	</data>
	<key>RowAlign</key>
	<integer>0</integer>
	<key>RowSpacing</key>
	<real>3.600000e+01</real>
	<key>VPages</key>
	<integer>1</integer>
	<key>WindowInfo</key>
	<dict>
		<key>Frame</key>
		<string>{{45, 44}, {555, 702}}</string>
		<key>VisibleRegion</key>
		<string>{{0, 0}, {540, 625}}</string>
		<key>Zoom</key>
		<string>1</string>
	</dict>
</dict>
</plist>
EOF
}

sub text_conv
{
    my ($text,$font) = @_;
    my ($buf,$x,$y) ;
    my ($fsy,$fsx) = (int(abs(24*$ac)),int(abs(12*$dc))) ;
# print STDERR "($fsy,$fsx) = (24*$ac,12*$dc)\n" ;
    $buf = "\\rtf1\\mac\\ansicpg10001\\cocoartf100\\n";
    $buf .= "{\\fonttbl\\f0\\fnil\\fcharset78 HiraMinPro-W3;\\f1\\froman\\fcharset77 Times-Roman;}\n";
    $buf .= $front_color."\n";
    $buf .= "\\pard\\tx560\\tx1120\\tx1680\\tx2240\\tx2800\\tx3360\\tx3920\\tx4480\\tx5040\\tx5600\\tx6160\\tx6720\\qc\n";

    $text = nkf('-s',$text);
    $x = $y = 0;
    for(split(/\n/,$text)) {
        $y ++;
        $x = length($_) if ($x < length($_));
    }
    $y = $y * $fsy;
    $x = $x * $fsx;
    $f0 = "";
    while($text=~s/^.|\n//) {
	my $c = ord($&);
	$f1 = $c>127?"f0":"f1";
	if ($c>127) {
	    if($f1 ne $f0) { $buf .=  "\\$f1 "; $f0 = $f1; }
	    $text=~s/^.//;
	    my $c1 = ord($&);
            # \f0\fs36 \cf0
	    $buf .= sprintf("\\'%2x\\'%2x",$c,$c1);
	} else {
	    if($f1 ne $f0) { $buf .= "\\$f1\\fs24 \\cf0 "; $f0 = $f1; }
            if ($c==60) {
                $buf .= "\&lt;";
            } elsif ($c==62) {
                $buf .= "\&gt;";
            } elsif ($c==38) {
                $buf .= "\&amp;";
            } else {
		$buf .= sprintf("%c",$c);
            }
	}
    }
    return ($buf,&points(0,0),$x,$y);
}

sub print_text
{
    my ($text,$x0,$y0,$x1,$y1) = @_;

    $id ++;
&print($obj, <<"EOF");
<dict>
	<key>Bounds</key>
	<string>{{$x0,$y0},{$x1.0,$y1.0}}</string>
	<key>Class</key>
	<string>ShapedGraphic</string>
	<key>ID</key>
	<integer>$id</integer>
	<key>Shape</key>
	<string>Rectangle</string>
	<key>Style</key>
	<dict>
		<key>fill</key>
		<dict>
			<key>Draws</key>
			<string>NO</string>
		</dict>
		<key>shadow</key>
		<dict>
			<key>Draws</key>
			<string>NO</string>
		</dict>
		<key>stroke</key>
		<dict>
			<key>Draws</key>
			<string>NO</string>
		</dict>
	</dict>
	<key>Text</key>
	<dict>
		<key>Text</key>
		<string>{$text}</string>
	</dict>
</dict>
EOF
}

sub color_stroke
{
    my (@color) = @_;
    my ($red,$green,$blue) = @color;
    my $line_type;
   if($lwidth > 1) {
       $line_type .= "\n<key>Width</key>\n<real>$lwidth</real>"; 
   } 
   if($brush == 65535) {
   } elsif($brush > 7000) {
       $line_type .= "\n<key>Pattern</key>\n<integer>11</integer>"; 
   } elsif($brush > 3000) {
       $line_type .= "\n<key>Pattern</key>\n<integer>2</integer>"; 
   } elsif($brush > 0) {
       $line_type .= "\n<key>Pattern</key>\n<integer>1</integer>"; 
   } 
return <<"EOF";
                               <key>stroke</key>
                               <dict>
                                       <key>Color</key>
                                       <dict>
                                               <key>b</key>
                                               <string>$blue</string>
                                               <key>g</key>
                                               <string>$green</string>
                                               <key>r</key>
                                               <string>$red</string>
                                       </dict>$line_type
                               </dict>
EOF
}

sub color_pattern
{
    my ($pattern,@color) = @_;
    if ($pattern==1) {
	# solid pattern
    } elsif ($pattern>0 && $pattern <1.0) {
	  if ($pattern>1) { $pattern = 1; }
	  if ($pattern<0) { $pattern = 0; }
          @color = (
	    $color[0]*(1.0-$pattern)+((1.0-$color[0])*$pattern),
	    $color[1]*(1.0-$pattern)+((1.0-$color[1])*$pattern),
	    $color[2]*(1.0-$pattern)+((1.0-$color[2])*$pattern)
          );
    } 
    my ($red,$green,$blue) = @color;
return <<"EOF";
                                        <key>Color</key>
                                        <dict>
                                                <key>a</key>
                                                <string>1</string>
                                                <key>b</key>
                                                <string>$blue</string>
                                                <key>g</key>
                                                <string>$green</string>
                                                <key>r</key>
                                                <string>$red</string>
                                        </dict>
                                        <key>GradientColor</key>
                                        <dict>
                                                <key>a</key>
                                                <string>1</string>
                                                <key>w</key>
                                                <string>1</string>
                                        </dict>
EOF
}

sub print_shape
{
    my ($shape,$x0,$y0,$x1,$y1) = @_;
    my ($fill);
    my($red,$blue,$green);

    if ($pattern eq 'none') {
          $fill = "
		<key>fill</key>
		<dict>
			<key>Draws</key>
			<string>NO</string>
		</dict>\n";
    } else {
          my $color = &color_pattern($pattern,@color);
          $fill = << "EOF";
                                <key>fill</key>
				<dict>$color
				</dict>
EOF
    } 
    my $stroke_color = &color_stroke(@color);
    $id ++;
&print($obj, <<"EOF");
<dict>
	<key>Bounds</key>
	<string>{{$x0,$y0},{$x1.0,$y1.0}}</string>
	<key>Class</key>
	<string>ShapedGraphic</string>
	<key>ID</key>
	<integer>$id</integer>
	<key>Shape</key>
	<string>$shape</string>
	<key>Style</key>
	<dict>$fill
		<key>shadow</key>
		<dict>
			<key>Draws</key>
			<string>NO</string>
		</dict>$stroke_color
	</dict>
</dict>
EOF
}

sub print_polygon
{
    my ($type,$x0,$y0,$x1,$y1,@p) = @_;
    my ($fill,$points);
    my($red,$blue,$green);

    if ($pattern eq 'none') {
          $fill = "
		<key>fill</key>
		<dict>
			<key>Draws</key>
			<string>NO</string>
		</dict>\n";
    } else {
          my $color = &color_pattern($pattern,@color);
          $fill = << "EOF";
                                <key>fill</key>
				<dict>$color
				</dict>
EOF
    } 
   my ($px,$py) = ($p[$#p-3],$p[$#p-2]);
   if ($x1==0) { $x1 = 100.0; }
   if ($y1==0) { $y1 = 100.0; }
    $px = ($px - $x0)/$x1-0.5;
    $py = ($py - $y0)/$y1-0.5;
   my $c = 1.0/6.0;
   while (@p > 2) {
        my ($x,$y) = (shift(@p),shift(@p));
# print "point $x $y x0=$x0 y0=$y0 x1=$x1 y1=$y1\n";
        $x = ($x - $x0)/$x1-0.5;
        $y = ($y - $y0)/$y1-0.5;
# print "  point $x $y\n";
	if ($type eq 'CBSpl') {
	    my $nx = ($p[0] - $x0)/$x1-0.5;
	    my $ny = ($p[1] - $y0)/$y1-0.5;
	    my ($dx,$dy) = (($nx-$px)*$c,($ny-$py)*$c);
	    $points .= "\t\t\t<string>{".($x-$dx).", ".($y-$dy)."}</string>\n";
	    $points .= "\t\t\t<string>{$x, $y}</string>\n";
	    $points .= "\t\t\t<string>{".($x+$dx).", ".($y+$dy)."}</string>\n";
	} elsif ($type eq 'Poly') {
	    $points .= "\t\t\t<string>{$x,$y}</string>\n";
	    $points .= "\t\t\t<string>{$x,$y}</string>\n";
	    $points .= "\t\t\t<string>{$x,$y}</string>\n";
	}
        $px = $x; $py = $y;
   }
    $points =~ s/^[^\n]+\n//m;
    $points .= $&;

    $id ++;
&print($obj, <<"EOF");
<dict>
	<key>Bounds</key>
	<string>{{$x0,$y0},{$x1.0,$y1.0}}</string>
	<key>Class</key>
	<string>ShapedGraphic</string>
	<key>ID</key>
	<integer>$id</integer>
	<key>Shape</key>
	<string>Bezier</string>
	<key>ShapeData</key>
                <dict>
                    <key>UnitPoints</key>
                           <array>
$points
                          </array>
                </dict>
	<key>Style</key>
	<dict>$fill
		<key>shadow</key>
		<dict>
			<key>Draws</key>
			<string>NO</string>
		</dict>
	</dict>
</dict>
EOF
}

# stack order of OmniGraffle is reverse of Idraw,
# we need a output stack.

sub new_obj {
    my ($obj) = @_;
    unshift(@{$obj},"");
    return $obj;
}

sub flush_obj {
    my ($o) = @_;
    join("",@{$o});
}

sub print {
    my ($o,$buf) = @_;
    $o->[0] .= $buf;
}

# end