#!/usr/local/bin/perl
# 画面の位置を調整する
$xoffset = 50;
$yoffset = 350;

# gnuplotなどは短い線をいっぱい出力するのでなるべくつなげる努力をする。
# そのために使うバッファを@mlineとする
@mline = 
    ($polygon='poly',$line_style=1,$thickness=1,$spline=0,
     $forward_arrow=0,$backward_arrow=0,$area_fill=0);
&premble;       # Idrawのヘッダを表示する

$/ = "\.\n";
$* = 1;
while(<>) {
   s/^%.*$//g;
   chop;
   chop;
   eval "\&$_";
}

sub polygon {
    $polygon = 'polygon';
    &polyline(@_);
}
sub poly {
    $polygon = 'poly';
    &polyline(@_);
}

sub polyline {
    # poly('black',4,[
    #         368,288,464,240,448,352,512,336],1,1,1,33,0,0,0,0,8,3,0,[
    # ]).
    local($color,$dm,$points,@arg) = @_;
  # まず折れ線を処理する
    @pos1 = @$points;
    if($polygon eq 'polygon') { 
        pop(@pos1);pop(@pos1); $area_fill = $arg[0] ;
        $forward_arrow = $backward_arrow = 0;
        $thickness = $arg[1]; $line_sytle = $arg[2]; $spline = $arg[3];
    } else { 
        $area_fill = 0;
        $forward_arrow = ($arg[0]&2); $backward_arrow = ($arg[0]&1); 
        $thickness = $arg[1]; $line_sytle = $arg[2]; $spline = $arg[4];
    }
    if($polygon eq $mline[0] && $#pos>0 && $#pos<255 
        && $pos1[0] == $prev1 && $pos1[1] == $prev) {
        push(@pos,@pos1);
    } else {
       if ($#pos>0)  {
         &flush_mline;
       } 
       push(@pos,@pos1);
    }
    @mline = 
    ($polygon,$line_style,$thickness,$spline,
     $forward_arrow,$backward_arrow,$area_fill);
    $prev = pop(@pos); $prev1 = pop(@pos);
}

sub arc {
    # arc('black',0,1,1,0,227,67,320,160,400,112,352,240,1,186,186,1920,-6272,39,0,1,8
    # ,3,0,[
    # ]).
    local($color,@arg) = @_;
  # アークの取り扱い
    $area_fill = $arg[0];
    $forward_arrow = ($arg[2]&2); $backward_arrow = ($arg[2]&1); 
    $thickness = $arg[1]; $line_sytle = $arg[3]; $spline = 1;
#                          0        1          2       3     4    5    6  7
#        Obj = arc(_Color,_ObjFill,_LineWidth,_PenPat,_Dash,_LtX,_LtY,_Xc,_Yc,
#                 8   9   10  11  12
#                _X1,_Y1,_X2,_Y2,_Dir,_W,_H,_Angle1,_Angle2,_Id,_Rotation,
#                _Style,_ArrowHeadW,_ArrowHeadH,_Locked,AttrList),

    ($xc,$yc,$x0,$y0,$x1,$y1,$direction) = @arg[6..12];
#    これは以下と同じ。うーん、便利だ。
#    $xc = $arg[6]; $yc = $arg[7]; $x0 = $arg[8]; $y0 = $arg[9];
#    $x1 = $arg[10]; $y1 = $arg[10];
#    $direction = $arg[10]; 
    $polygon = 'poly';
    &flush_mline;
    @pos = &arc_out($xc,$yc,$x0,$y0,$x1,$y1,$direction);
#    @pos = &arc_out($xc,$yc,$x0,$y0,$x1,$y1); $spline = 0; # for debug
    @mline = 
    ($polygon,$line_style,$thickness,$spline,
     $forward_arrow,$backward_arrow,$area_fill);
    $prev = pop(@pos); $prev1 = pop(@pos);
}

sub rcbox { &box(@_); }

sub box {
    local($color,@arg) = @_;
  # 長方形の取り扱い
    $rect = join(" ",$xoffset+$arg[0],$yoffset-$arg[1],
                     $xoffset+$arg[2],$yoffset-$arg[3]);
    ($forward_arrow,$backward_arrow,$area_fill) = (0,0,0);
    if($icon) { 
        $brushtype = "none SetB %I b n"; $icon = 0;
    } else {    $style = ''; $stylev = 65535;
        $brushtype = "%I b $stylev\n" . 
        "$thickness $forward_arrow $backward_arrow [$style] 0 SetB";
    }

    print <<"EOF";
Begin %I Rect
$brushtype
%I cfg Black
0 0 0 SetCFg
%I cbg White
1 1 1 SetCBg
none SetP %I p n
%I t
[ 1 0 0 1 0 0 ] concat
%I
$rect Rect
End

EOF
}

sub oval {
    local($color,@arg) = @_;
  # 円の扱い
    $elli = join(" ",
            ($xoffset+($arg[0]+$arg[2])/2, 
             $yoffset-($arg[1]+$arg[3])/2, 
             ($arg[2]-$arg[0])/2, ($arg[3]-$arg[1])/2));
    print <<"EOF";
Begin %I Elli
%I b 65535
1 0 0 [] 0 SetB
%I cfg Black
0 0 0 SetCFg
%I cbg White
1 1 1 SetCBg
none SetP %I p n
%I t
[ 1 0 0 1 0 0 ] concat
%I
$elli Elli
End

EOF
} 

sub text {
  # テキスト
# text('black',96,144,1001,0,4,1,0,0,1,90,20,26,0,16,4,0,0,0,0,[
#        "河野でーす"]).
    local($color,@arg) = @_;
    @text = ();
    $x = $arg[0]; $y = $arg[1];
    $texts = $arg[19];
    @text = @$texts;
    foreach (@text) {
      while($_ ne '') {
      # 漢字かどうかで処理をわけないといけない
	if(s/^[\000-\177]+//) {
	  $text = $&; $kanji = 0;
	  $xfont = "-*-times-medium-r-normal--14-*-iso8859-1";
	  $psfont = "Times-Roman"; $font_size = 14; 
	  &text_out($text); $arg[0] += $font_size * length($text)/2;
	} elsif(s/^[\200-\377]+//) {
	  $text = $&; $kanji = 1;
	  $xfont = "-*-fixed-medium-r-normal--14-*-jisx0208.*-0";
	  $psfont = "Ryumin-Light-H"; $font_size = 14;
	  &text_out($text); $arg[0] += $font_size * length($text)/2;
	}
      }
      $arg[1] += 14; $arg[0] = $x;
    }
}

#   tgifの特殊機能は適当にごまかす
#   見えない線で書いておこう
sub state {
    push(@stack,'state');
}

sub attr {
    push(@stack,'attr');
}


&flush_mline if ($#pos>0);
&postemble;

sub text_out {
    local($text) = @_;
    if($text eq '') {return;}
    $position = ($xoffset+$arg[0]) . " " . ($yoffset-$arg[1]);
    $text =~ tr/\200-\377/\000-\177/ if ($kanji);
    $text =~ s/[()\\]/\\$&/g;
    print <<"EOF";
Begin %I Text
%I cfg Black
0 0 0 SetCFg
%I f $xfont
$psfont $font_size SetF
%I t
[ 1 0 0 1 $position ] concat
%I
[
($text)
] Text
End

EOF
}

# たまった線分をいっぺんに出力する
sub flush_mline {
    return if (! ($#pos>0));   # たまってなかった
    local($polygon,$line_style,$thickness,$spline,
        $forward_arrow,$backward_arrow,$area_fill) = @mline;
    $mline = ($polygon eq 'polygon')?
                 ($spline?'CBSpl':'Poly'):
                 ($spline?'BSpl':'MLine');
    # 属性を解析して出力する
    if($line_style == 2) { $style = '4 4 4 4'; $stylev = 3855;
    } elsif($line_style == 3) { $style = '2 2'; $stylev = 13107;
    } else { $style = ''; $stylev = 65535;
    }
    $brushtype = "%I b $stylev\n" . 
    "$thickness $forward_arrow $backward_arrow [$style] 0 SetB";
    if($area_fill>0) {
           $area_fill = 1 - ($area_fill / 21);
           if($area_fill<0)  {$area_fill = 0;}
           if($area_fill>=1) {$area_fill = 1;}
           $setpen = "%I p\n$area_fill SetP";
    } else {
           $setpen = "none SetP %I p n";
    }
    print <<"EOF";
Begin %I $mline
$brushtype
%I cfg Black
0 0 0 SetCFg
%I cbg White
1 1 1 SetCBg
$setpen
%I t u
EOF
    # 前の残りから始める
    push(@pos,$prev1);
    push(@pos,$prev);
    $count = int(($#pos+1)/2);
    print "%I ",$count,"\n";
    # ここで点を出力
    for($i=0;$i<$count;$i++) {
      print int($xoffset+shift(@pos)),' ',
            int($yoffset-shift(@pos)),"\n";
    }
    if($polygon eq 'polygon') {
      print $count," $mline\nEnd\n\n";
    } else {
      print $count," $mline\n%I 1\nEnd\n\n";
    }
#    $#pos = $[;
}

# Idrawはアークがないので、いい加減な近似ですませる
sub arc_out {
   local($xc,$yc,$x0,$y0,$x2,$y2) = @_;
   local($r,$x,$y,$xm,$ym);

   # approximate 3point arc with center by open spline
   ($x0,$y0,$x2,$y2) = 
       ($x0-$xc,$y0-$yc,$x2-$xc,$y2-$yc);
   $r = $x0 * $x0 + $y0 * $y0;
   # calculate mid point
   $y = $y2-$y0; $x = $x2-$x0;
   $xm = sqrt($r/($y*$y+$x*$x));
   $ym = $xm*$x; $xm = -$xm*$y;
   if($direction) { $xm= -$xm; $ym = -$ym; }
   return (  ($x0+$xc,$y0+$yc, 
              &arc3($x0,$y0,$xm,$ym),&arc3($xm,$ym,$x2,$y2), 
              $x2+$xc,$y2+$yc));
}

sub arc3 {
   local($x0,$y0,$x1,$y1) = @_;
   local($d,$e,$f);
   $e = sqrt($r*(($y1-$y0)*($y1-$y0)+($x1-$x0)*($x1-$x0)));
   $d = $x0*$y1-$x1*$y0; $f = ($d>0)?1:-1;
   return ( 
      ($r*($y1-$y0)*$f+$x0*$e)/($d*$f+$e) + $xc,
      ($r*($x0-$x1)*$f+$y0*$e)/($d*$f+$e) + $yc,
      ($r*($y1-$y0)*$f+$x1*$e)/($d*$f+$e) + $xc,
      ($r*($x0-$x1)*$f+$y1*$e)/($d*$f+$e) + $yc);
}



sub postemble {
print <<'EOF';
End %I eop

showpage

%%Trailer

end
EOF
}

sub premble {
print <<'EOF';
%I Idraw 10 Grid 8 8 

%%Page: 1 1

EOF
print <<"EOF";
Begin
%I b u
%I cfg u
%I cbg u
%I f u
%I p u
%I t
[ 0.717045 0 0 0.717045 $xoffset $yoffset ] concat
/originalCTM matrix currentmatrix def

EOF
}

