#!/usr/bin/perl
# hpgl2vrml.pl - convert HPGL to VRML
# Andrew Daviel, Vancouver Webpages 1996

# See http://vancouver-webpages.com/vrml/hpgl2vrml.html

# based on conv_hpgl.f, A.Daviel, TRIUMF (that's why there's a couple of gotos)

$debug = 0 ; $inline = 0 ; # debugging level

# Simple color map for mapping color names to RGB values
%color = ("blue","0 0 1","red","1 0 0","green","0 1 0",
  "white","1 1 1", "black","0 0 0") ;

if (@ARGV[0] =~ /-h/i) {
  print "Usage: $0 [pen1color,pen2color, ...] < HPGLfile > VRMLfile\n";
  exit ;
}

# if supported, get X11 colors using "showrgb"
# colors have names like "PaleGreen", "MediumTurquoise"

$_ = `showrgb` ;
@lines = split(/\n/) ;
foreach $line (@lines) {
  $line =~ tr/\t//s ;
  @field = split(/\t/,$line) ;
  if (!($field[1] =~ / /)) {
    $field[0] =~ tr/ //s ; $field[0] =~ s/^ // ;
    @rgb = split(/ /,$field[0]) ;
    for ($i=0; $i<=2;$i++) {
      $rgb[$i] = $rgb[$i]/255 ;
      $RGB[$i] = sprintf("%5.3f",$rgb[$i]) ;
    }
    $color{$field[1]} = join(' ',@RGB) ;
  }
}


#              black  blue    green   cyan    red     magenta  yello  white 
@pencolor = ("0 0 0","0 0 1","0 1 0","0 1 1","1 0 0","1 0 1","1 1 0","1 1 1" );
if (@ARGV[0]) { 
  @colors = split(/,/,@ARGV[0]) ; 
  for ($i=0;$i<@colors+0;$i++) {
    $color = $colors[$i] ;
    if ($color{$color}) {
      $pencolor[$i] = $color{$color} ;
    } else {
      print STDERR "Warning - color $color not found in table, default RGB is $pencolor[$i]\n";
    }
  }
}

print "#VRML V1.0 ascii\nInfo { string \"Created by hpgl2vrml.pl|\n" ;
print "See http://vancouver-webpages.com/vrml/hpgl2vrml.html\" }\n";
$pd0 = 0 ; # previous pen down
$code = "IN" ; goto IN ; # initialize

# Input loop
L1:  
  $istat = 4 ; # badcmd
  while ($istat) {
    $istat = &nextcmd($code) ;
    if ($istat == 1) { # if eof
      if ($debug) { print STDERR "EOF\n"; }
      exit ; 
    }
  }
  if ($debug>1) { print STDERR "Command $code\n"; }
  if ($code eq 'IN') {
# IN Initialize
IN:
    if ($debug) { print STDERR "Initialize\n"; }
    $pd=0 ; $p1x = -17000 ; $p1y = -11000 ; $p2x = 17000 ; $p2y = 11000 ;
    $p12diag=sqrt(($p2y-$p1y)**2+($p2x-$p1x)**2) ;
  }
  if ($code eq 'IN' || $code eq 'DF') {
# DF default
    if ($debug) { print STDERR "Init/Default\n"; }
    $pabs = 1 ; $lorg = 1 ; $term = "\003" ; $atol = 5 ; $sx1 = $p1x ; $sx2 = $p2x ;
    $sy1 = $p1y ; $sy2 = $p2y ; $wx1 = 0 ; $wx2 = 0 ; $wy1 = 0 ; $wy2 = 0 ;
    $ltype = 7 ; $charwd = 2.85/0.025 ; $charht = 3.75/0.025 ;
    $tangle = 0 ; $tln = 0.5 ; $tlp = 0.5 ;
  } elsif ($code eq 'IW') {
# Input Window IW x1,y1,x2,y2; Set window for plotting
    &skipsep ; &rdnum($wx1) ; &skipsep ; &rdnum($wy1) ;
    &skipsep ; &rdnum($wx2) ; &skipsep ; &rdnum($wy2) ;
    if ($debug) { print STDERR "Window $wx1 $wy1 $wx2  $wy2\n"; }
    # get window corners in user co-ordinates
    $xb=$p1x+($wx1-$sx1)*($p2x-$p1x)/($sx2-$sx1) ;
    $yb=$p1y+($wy1-$sy1)*($p2y-$p1y)/($sy2-$sy1) ;
    $xt=$p1x+($wx2-$sx1)*($p2x-$p1x)/($sx2-$sx1) ;
    $yt=$p1y+($wy2-$sy1)*($p2y-$p1y)/($sy2-$sy1) ;
    # user rotation
    &r90($xb,$yb,$irt) ; &r90($xt,$yt,$irt) ;
  } elsif ($code eq 'SC') {
# SC xmin,xmax,ymin,ymax ; map user units to P1,P2
# Plotter units are default 0.025mm
    &skipsep ;
    if ($ch =~ tr/0-9// ) {
      &rdnum($sx1) ; &skipsep ; &rdnum($sx2) ; &skipsep ;
      &rdnum($sy1) ; &skipsep ; &rdnum($sy2) ; &skipsep ;
    } else {
      # Scaling off
      $sx1 = $p1x ; $sx2 = $p2x ; $sy1 = $p1y ; $sy2 = $p2y ;
    }
    if ($debug) { print STDERR "Scale $sx1 $sx2 $sy1 $sy2\n"; }
  } elsif ($code eq 'IP') {
# IP p1x,p1y(,p2x,p2y); set scaling points
     $p1x0=$p1x ; $p1y0=$p1y ;
     &skipsep ; &rdnum($p1x) ; &skipsep ; &rdnum($p1y) ; &skipsep ;
     if ($ch =~ tr/0-9//) {
       &rdnum($p2x) ; &skipsep ; &rdnum($p2y) ;
       # if P1 set but not P1, P2 tracks P1
     } else {
       $p2x=$p2x+$p1x-$p1x0 ; $p2y=$p2y+$p1y-$p1y0 ;
     } 
     if ($debug) { print STDERR "Set P1,P2 $p1x $p1y $p2x $p2y\n"; }
     $sx1=$p1x ; $sx2=$p2x ; $sy1=$p1y ; $sy2=$p2y ; # set scale = P1,P2
  } elsif ($code eq 'CI') {
# CI radius(,chord tol); circle at present positon
    &skipsep ; &rdnum($z1) ; # radius
    if ($ch =~ tr/0-9//) {  # GET SECOND PARAMETER  
      &rdnum($z2) ; # CHORD TOL
    } else {
      $z2 = $atol ;
    }
    if ($debug) { print STDERR "Circle $z1 $z2\n"; }
    if ($inline) { print "# CI $z1 $z2\n"; }
    # convert to user units (ought to fix this to give ellipse)
    $z1=$z1*($p2x-$p1x)/($sx2-$sx1) ;
    # Center x0,x0, ainc=atol, iline=0
    $nseg = int(1+360/$atol) ;
    $angl = 3.14159 *2;
    $ainc = $angl/$nseg ;
    $x2=$ix+$z1 ; $y2=$iy ;
    &plot_r($x2,$y2,3) ; # draw pen up
    for ($i=1;$i<=$nseg;$i++) {
      $a2=$ainc*$i ;
      $x2=$ix+$z1*cos($a2) ;
      $y2=$iy+$z1*sin($a2) ;
      &plot_r($x2,$y2,2) ; # draw pen down
    }
    &plot_r($ix0,$iy0,3) ; # leave pen at center of circle
  } elsif($code eq 'AR' || $code eq 'AA') {
    if($code eq 'AR') {
# AR x,y,angle(,chord tol); Arc relative from current pos. center x,y
# angle degrees (+ve anticlockwise)
      &skipsep ; &rdnum($z1) ; &skipsep ; &rdnum($z2) ;
      if ($ch =~ tr/0-9//) { &rdnum($angl) ; } else { $angl = $atol ; }
      if ($debug) { print STDERR "Arc Relative AR $z1 $z2 $angl\n"; }
      if ($inline) { print "# AR $z1 $z2 $angl\n"; }
      $z1 = $z1 + $x1 ; $z2 = $z2 + $y1 ;
    } elsif($code eq 'AA') {
# AA x,y,angle(,chord tol); Arc absolute from current pos. center x,y
      &skipsep ; &rdnum($z1) ; &skipsep ; &rdnum($z2) ; &skipsep ; 
      if ($ch =~ tr/0-9//) { &rdnum($angl) ; } else { $angl = $atol ; }
      if ($debug) { print STDERR "Arc Absolute $z1 $z2 $angl\n"; }
      if ($inline) { print "# AA $z1 $z2 $angl\n"; }
    }
    # Convert user units to plotter units
    $ix=$p1x+($z1-$sx1)*($p2x-$p1x)/($sx2-$sx1) ;
    $iy=$p1y+($z2-$sy1)*($p2y-$p1y)/($sy2-$sy1) ;
    &r90($ix,$iy,$irt) ;
    # FORTRAN version used degrees, COSD etc.
    $nseg = int(1+&abs($angl)/$atol) ;
    $angl = $angl*3.14159/180 ;
    $ainc = $angl/$nseg ;
    $r=sqrt(($ix0-$ix)**2 + ($iy0-$iy)**2);
    $a1=atan2(($iy0-$iy),($ix0-$ix));
    for ($i=1;$i<=$nseg;$i++) {
      $a2=$a1+$ainc*$i ;
      $x2=$ix+$r*cos($a2) ;
      $y2=$iy+$r*sin($a2) ;
      &plot_r($x2,$y2,2) ; # draw pen down
    }
    $ix0 = $x2 ; $iy0 = $y2 ;
  } elsif ($code eq 'LO') {
# LO Label origin
    &skipsep ; if ($ch =~ tr/0-9//) {
      &rdnum($a1) ; $lorg = int($a1) ;
      if ($lorg > 9) { $lorg = $lorg - 10 ; }
    } else {
      $lorg = 1 ;
    }
   if ($debug) { print STDERR "Label Origin $lorg\n"; } 
  } elsif ($code eq 'PU') {
# PU ; pen up
   if ($debug) { print STDERR "Pen up\n"; }
   $pd = 0 ; goto L30 ;
  } elsif ($code eq 'SP') {
# SP n ; select pen n ; 0 parks ; no digit parks
    &skipsep ; &rdnum($pen) ; $ipen = int($pen) ;
    if ($debug) { print STDERR "Select pen $ipen\n"; }
    &colour($ipen) ; 
  } elsif ($code eq 'DV' || $code eq 'DI') {
    if ($code eq 'DV') {
# DV n; or DV; direction vertical 0 or 1, default 0 (horizontal)
     if (!($ch =~ tr/0-9//)) { $rise = 0 ; }
     &rdnum($rise) ;
     if ($rise == 0) { $run= 1 ; } else { $run = 0 ; }
     if ($debug) { print STDERR "Direction Vertical DV $rise\n"; }
    } elsif ($code eq 'DI') {
# DI run,rise; or DI Direction Absolute default 1,0
      if ($ch =~ tr/0-9//) {
        &rdnum($run) ; &skipsep ; &rdnum($rise) ;
      } else {
        $run= 1 ; $rise = 0 ;
      }
      if ($debug) { print STDERR "Direction command DI $run $rise\n"; }
    }
    $tangle=atan2(-$rise,-$run)+atan2(1.0,1.0)*4 - $irt*atan2(1.0,1.0)/45.0 ;
    if ($tangle < 0.0) { $tangle=$tangle+atan2(1.0,1)*8 ; }
    if ($tangle >= atan2(1.0,1)*8) { $tangle=$tangle-atan2(1,1)*8 ; }
    # convert to degrees 
    $rtangle= tangle ; $tangle=$tangle*45.0/atan2(1.0,1) ;
  } elsif ($code eq 'LT') {
# LT pattern,(length); or LT; Line Type
    &skipsep ; 
    if ($ch =~ tr/0-9//) {
      &rdnum($z1) ; $ltype = int($z1) ; &skipsep ;
      if ($ch =~ tr/0-9//) {
        &rdnum($patlen) ;
      } else { 
        $patlen = 4.0 ; # 4% of (P2-P1)
      }
      if ($debug) { print STDERR "Line type LT $ltype $patlen\n"; }
      $patlen=$patlen/100.0*$p12diag ;
    } else {
      if ($debug) { print STDERR "LT solid line\n"; }
      $ltype = 7 ;
    }
  } elsif ($code eq 'DT') {
# DT n ; define terminator for label command
    $term = $ch ;
    if ($debug) { print STDERR "Define terminator $term\n"; }
    if (&getch == 1) { goto L98 ; }
  } elsif ($code eq 'CP') {
# CP s,l; Character Plot s spaces, l lines default <CR><LF>
    if ($ch =~ tr/0-9//) {    
      &rdnum($z1) ; &skipsep ;
      if ($ch =~ tr/0-9//) { &rdnum($z2) ; } else { $z2 = 1 ; }
      $x1=$x1+$z1*$charwd*sin($rtangle) *1.5 ; # z1 spaces to right (1.5* char width)
      $y1=$y1+$z2*$charht*cos($rtangle) *2  ; #  z2 lines down (2* char height) 
      $ix=$p1x+($x1-$sx1)*($p2x-$p1x)/($sx2-$sx1) ;
      $iy=$p1y+($y1-$sy1)*($p2y-$p1y)/($sy2-$sy1) ;
      if ($debug) { print STDERR "Char plot to $ix $iy\n"; }
      &plot_r($ix,$iy,3) ; # draw pen up
      $ix0 = $ix ; $iy0 = $iy ;
    }
  } elsif ($code eq 'LB') {
    &getlabel($label,$labell,$term) ;
    if ($debug) { print STDERR "Label $label\n"; }
    $lbht = $1.5*charwd ; if ($charht < $lbht) { $lbht = $charht ; }
    &conv_hptext($label,$labell,$tangle,$lbht,$ix0,$iy0,$lorg) ;
    # allow label to push XMAX
    $xmax = &max($xmax,($ix0+($labell+1)*$charwd)) ; 
  } elsif ($code eq 'SI') {
# SI width, height ; character size in cm default 0.285,0.375
    &skipsep ;
    if ($ch =~ tr/0-9//) {
      &rdnum($z1) ; &skipsep ;
      &rdnum($z2) ; $charwd = $z1/0.0025 ; $charht = $z2/0.0025 ;
    } else {
      $charwd= 2.85/0.025 ; $charht= 3.75/0.025 ;
    }
    if ($debug) { print STDERR "Abs. character size SI $charht $charwd\n"; }
  } elsif ($code eq 'SR') {
# SR width, height ; character size as % of (P2-P1)
    &skipsep ;
    if ($ch =~ tr/0-9//) {
      &rdnum($z1) ; &skipsep ;
      &rdnum($z2) ; $charwd = $z1*$p12diag/100.0 ; $charht = $z2*$p12diag/100.0 ;
    } else {
      $charwd= 2.85/0.025 ; $charht= 3.75/0.025 ;
    }
    if ($debug) { print STDERR "Rel. character size SR $charht $charwd\n"; }
  } elsif ($code eq 'TL') {
# TL Tick Length
    skipsep ;
    if ($ch =~ tr/0-9//) {
      &rdnum($tlp) ; # positive tick length
      &skipsep ;
    } else {
      $tlp = 0.5 ; 
    }
    if ($ch =~ tr/0-9//) {
      &rdnum($tln) ; # negative tick length
    } else {
      $tln = 0.5 ;
    }
    if ($debug) { print STDERR "Tick Length (%) $tlp $tln\n"; }
  } elsif ($code eq 'XT') {
# XT ; X tick
    if ($debug) { print STDERR "X Tick XT\n"; }
    $ix1=$p1x+($x1-$sx1)*($p2x-$p1x)/($sx2-$sx1) ;
    $iy1=$p1y+($y1-$sy1)*($p2y-$p1y)/($sy2-$sy1) ;
    $ix=$ix1 ;
    $iy=$p1y+($y1-($sy2-$sy1)*$tln/100.0-$sy1)*($p2y-$p1y)/($sy2-$sy1) ;
    &r90($ix,$iy,$irt) ; &plot_r($ix,$iy,3 ) ; # draw pen up    
    $ix = $ix1 ;
    $iy=$p1y+($y1+($sy2-$sy1)*$tlp/100.0-$sy1)*($p2y-$p1y)/($sy2-$sy1) ;
    &r90($ix,$iy,$irt) ; &plot_r($ix,$iy,2) ; # draw pen down
    $ix = $ix1 ; $iy = $iy1 ;
    &r90($ix,$iy,$irt) ; &plot_r($ix,$iy,3 ) ; # draw pen up
  } elsif ($code eq 'YT') {
# YT      plot a 'Y' tick
    if ($debug) { print STDERR "Y Tick YT\n"; }
    $ix1=$p1x+($x1-$sx1)*($p2x-$p1x)/($sx2-$sx1) ;
    $iy1=$p1y+($y1-$sy1)*($p2y-$p1y)/($sy2-$sy1) ;
    $ix=$p1x+($x1-($sx2-$sx1)*$tln/100.0-$sx1)*($p2x-$p1x)/($sx2-$sx1);
    $iy=$iy1 ; &r90($ix,$iy,$irt) ; &plot_r($ix,$iy,3) ; # draw pen up
    $ix=$p1x+($x1+($sx2-$sx1)*$tlp/100.0-$sx1)*($p2x-$p1x)/($sx2-$sx1) ;
    $iy=$iy1 ; &r90($ix,$iy,$irt) ; &plot_r($ix,$iy,2) ; # draw pen down
    $ix=$ix1 ; $iy=$iy1 ; &r90($ix,$iy,$irt) ; &plot_r($ix,$iy,3) ; # draw pen up
  } elsif ($code eq 'PD') {
# PD ; pen down
    if ($debug) { print STDERR "Pen down\n"; }
    $pd = 1 ; goto L30 ; # movement
  } elsif ($code eq 'PA') {
# PA x,y(x,y,x,y...) ; Plot absolute to x,y
    if ($debug) { print STDERR "Plot absolute PA\n"; }
    $pabs = 1 ; goto L30 ; # movement
  } elsif ($code eq 'PR') {
# PR ; Plot relative
    if ($debug) { print STDERR "Plot relative PR\n"; }
    $pabs = 0 ; goto L30 ; # movement
  } else {
    if ($debug) { print STDERR "Ignored command $code\n"; }
  }
goto L1 ;

L30:
# movement: process pairs of digits following PU, PD, PA or PR command
&skipsep ;
while ($ch =~ tr/0-9//) {
  if (&rdnum($x2) == 1) { goto L98 ; } # eof
  &skipsep ;
  if (&rdnum($y2) == 1) { goto L98 ; } # eof
  &skipsep ;
  if ($pabs) {
  # absolute movement
    $x1 = $x2 ; $y1 = $y2 ;
  } else {
  # relative movement
  $x1=$x1+$x2 ; $y1=$y1+$y2 ;
  }
  if ($debug>1) { print STDERR "XY $x2 $y2\n"; }
  $ix=$p1x+($x1-$sx1)*($p2x-$p1x)/($sx2-$sx1) ;
  $iy=$p1y+($y1-$sy1)*($p2y-$p1y)/($sy2-$sy1) ;
  &r90($ix,$iy,$irt) ;
  if ($ipen>0 && $pd) {
    if ($debug>1) { print STDERR "Draw to $ix,$iy\n"; }
    if ($ltype == 7 || $ltype == 0) {
      # currently do not support LT0 - dot only
      &plot_r($ix,$iy,2) ; # draw pen down
    } else {
#    # patterned line types
#    $dxy=sqrt(($ix-$ix0)**2+($iy-$iy0)**2) ;
#    $npat=&max(&nint($dxy/$patlen),1) ;
#    $sint=($ix-$ix0)/$dxy ;
#    $cost=($iy-$iy0)/$dxy ;
#    # negative line type indicates that repeat length is adjusted
#    # so that there is a dash at both ends of the line segment
#    $apatlen=dxy/(npat-space1(&abs(ltype))) ;
#            else
#              apatlen=patlen
#            endif
#            do k=0,npat-1
#              kx=ix0 + (k+dash1(&abs(ltype)))*sint*apatlen
#              ky=iy0 + (k+dash1(&abs(ltype)))*cost*apatlen
#c if unadjusted pattern ends in a dash, end it
#              if (k.eq.npat-1.and.ltype.gt.0) then
#                if(sqrt((ix-kx)**2+(iy-ky)**2).le.
#     1              dash1(abs(ltype))*apatlen)then
#                  call plot_r(ix,iy,2) ! draw pen down
#                  goto 81
#                endif
#              endif
#              call plot_r(kx,ky,2) ! draw pen down
#              if (k.eq.npat-1.and.ltype.gt.0) goto 80
#              kx=kx + space1(&abs(ltype))*sint*apatlen
#              ky=ky + space1(&abs(ltype))*cost*apatlen
#              call plot_r(kx,ky,3) ! draw pen up
#              if (dash2(&abs(ltype)).gt.0.0) then
#                kx=kx + dash2(&abs(ltype))*sint*apatlen
#                ky=ky + dash2(&abs(ltype))*cost*apatlen
#                call plot_r(kx,ky,2) ! draw pen down
#                kx=kx + space1(&abs(ltype))*sint*apatlen
#                ky=ky + space1(&abs(ltype))*cost*apatlen
#                call plot_r(kx,ky,3) ! draw pen up
#              endif
#              if (dash3(abs(ltype)).gt.0.0) then
#                kx=kx + dash3(&abs(ltype))*sint*apatlen
#                ky=ky + dash3(&abs(ltype))*cost*apatlen
#                call plot_r(kx,ky,2) ! draw pen down
#                kx=kx + space1(&abs(ltype))*sint*apatlen
#                ky=ky + space1(&abs(ltype))*cost*apatlen
#                call plot_r(kx,ky,3) ! draw pen up
#              endif
#            enddo ! k
#80          call plot_r(ix,iy,3)  ! move to end of line segment
#81          continue
#          endif      ! ltype.eq.7.or.0
    } # end patterned type
  } else {
    if ($debug>1) { print STDERR "Move to $ix $iy\n"; }
    &plot_r($ix,$iy,3) ; # draw pen up
  }
  $ix0 = $ix ; $iy0 = $iy ;
  $xmin=&min($xmin,$ix) ; $xmax=&max($xmax,$ix) ;
  $ymin=&min($ymin,$iy) ; $ymax=&max($ymax,$iy) ;
} # while digit
goto L1 ;

L98: print STDERR "Unexpected EOF on HPGL file\n"; 
exit ;

sub max {
  if ($_[1] > $_[0]) {
    return($_[1]) ;
  } else {
     return($_[0]) ;
  }
}
sub min {
  if ($_[1] < $_[0]) {
    return($_[1]) ;
  } else {
     return($_[0]) ;
  }
}

sub getlabel {
# (label,lblen,term)
  $_[0] = "" ; $_[1] = 0 ;
  while ($ch ne $_[2]) {
    $_[0] = $_[0].$ch ; $_[1]++ ;
    if (&getch == 1) { return(1) ; }
  }
  if (&getch == 1) { return(1) ; }
  return(0) ;
}

sub rdnum {
  # (x)
  local ($word) = "" ;
  while ($ch =~ tr/0-9//) { # while digit
    $word = $word.$ch ;
    if (&getch == 1) { return(1) ; }
  }
  $_[0] = $word + 0 ;
  return(0) ;
}

sub r90 {
  #(x,y,irt)
  local($tx) ;
  if ($_[2] == 0 ) { return ; }
  $tx = $_[0] ;
  if ($_[2] == 90 ) {
    $_[0] = $_[1] ; $_[1] = -$tx ;
  } elsif ($_[2] == 180) {
    $_[0] = -$_[0] ; $_[1] = -$_[1] ;
  } elsif ($_[2] == 270) {
    $_[0] = -$_[1] ; $_[1] = $tx ;
  }
  return ;
}

sub sign {
  # (value, sign)
  # assigns the sign of the second argument to the absolute value of the first
  local($tmp) ;
  if ($_[0]<0) { $tmp = -$_[0] ; } else { $tmp = $_[0] ; }
  if ($_[1] < 0 ) { return (-$tmp) ; } else { return ($tmp) ; }
}
sub abs {
  if ($_[0]<0) { return (-$_[0]) ; } else { return($_[0]) ; }
}
sub nint {
  return (int($_[0]+0.5)) ;
}

sub skipsep {
%separator=(";",1,"\n",1,"\r",1,"\03",1," ",1,",",1) ;
  while ($separator{$ch}) {
    if (&getch == 1) { return(1) ; } # eof
  }
  return(0) ;
}

sub getch {
  $stat = read(STDIN, $ch,1) ;
  if ($stat) { return(0) ; }
  return(1) ; # eof
}

sub nextcmd { 
  # (cmd)
  while (!($ch =~ tr/A-Za-z//)) {
    if (&getch == 1) { return(1) ; } # eof
  }
  $_[0] = $ch ;
  if (&getch == 1) { return(1) ; }
  $_[0] = $_[0].$ch ;
  if (!($ch =~ tr/A-Za-z//)) { 
    if (&getch == 1) { return(1) ; } #eof
    return(4) ;  # badcmd  
  }
  if (&getch == 1) { return(1) ; } # eof
  return(0) ; # success 
}
###
sub conv_hptext {
  #  ($label,$labell,$tangle,$lbht,$ix0,$iy0,$lorg) ;

  # (LABEL,LABELL,LANGLE,LHEIGHT,LX,LY,LORG)
  local($xdig) = $_[4] ; local($ydig) = $_[5] ; # Location
  local($theight) = $_[3] ; local($tangle) = $_[2] ;
  local(@tjust_legal) = ("LEFT","LEFT","LEFT","CENTER","CENTER","CENTER","RIGHT","RIGHT","RIGHT") ;
  local($ifont) = 1 ; local($tjust) ;
  $tjust = $tjust_legal[$_[6]-1] ; # Justification
  print "  Separator {\n    Material { diffuseColor $rgb }\n";
  print "    Translation { translation  $xdig $ydig  0 }\n";
  print "    FontStyle { size $theight }\n";
  print "    AsciiText { \n      string \"$_[0]\"\n";
  print "      spacing 1\n      justification $tjust\n      width 0\n    }\n  }\n";

  if ($debug) { print STDERR "Plot label \"$label\" at $xdig $ydig\n"; }
}

sub colour {
  # ($icolset)  ( 1 .. 15)
  $rgb = $pencolor[$_[0]-1] ;
  if ($debug) { print STDERR "Set color to $rgb\n";}
}
sub plot_r {
  $plot_r = 1 ;
  # ($ix,$iy,$pd) ; # 3 - draw pen up, 2 - pen down
  $pd = ($_[2] == 2) ;
  if ($pd0 && !$pd) {
    # pen going up - dump previous polyline
    if ($debug) { print STDERR "Pen up - write polyline\n";}
    $np = @xp + 0 ;
    if ($np) {
      print "  Separator {\n    Material { diffuseColor $rgb }\n";
      print "    Coordinate3 { point [\n";
      for ($i=0;$i<$np-1;$i++) { print "      $xp[$i] $yp[$i] 0,\n" ; }
      print "      $xp[$np-1] $yp[$np-1] 0 ]\n    }\n";
      print "    IndexedLineSet { coordIndex [" ;
      for ($i=0;$i<$np-1;$i++) { print "$i," ; }
      $np1 = $np-1 ; print "$np1,-1] }\n  }\n";
    }
    undef(@xp); undef(@yp) ;
    push (@xp,int($_[0])) ; push (@yp,int($_[1])) ;
  } elsif ($pd) {
    # push (@xp,sprintf("%6.2f",$ix)) ; push (@yp,sprintf("%6.2f",$iy)) ; # build current polyline
    push (@xp,int($_[0])) ; push (@yp,int($_[1])) ; # build current polyline
  } else {
    $xp[0] = &nint($_[0]) ; $yp[0] = &nint($_[1]) ; # move with pen up
  }
  $pd0 = $pd ;
    
}