#!/usr/bin/perl -w
# filename: scale.pl
# author:   Marvin Simkin
# date:     2002-11-25
# purpose:  adjust all X Y and Z values in draw files

# syntax:   scale.pl X Y Z < equal.draw > exagg.draw
# X:        factor for X dimensions, -1=invert 0=collapse 1=no change, 2=double
# Y:        factor for Y dimensions, -1=invert 0=collapse 1=no change, 2=double
# Z:        factor for Z dimensions, -1=invert 0=collapse 1=no change, 2=double
# equal.draw:  draw instructions with equal spacing in X Y and Z
# exagg.draw:  those same instructions but with exaggeration applied

# NOTE:
# The goal of the data format is to make it possible to describe an object
# in a one-line instruction (e.g. draw a line from point A to point B)
# and to set defaults that apply to all subsequent objects (e.g. color red).

# You can have one "word" per line, or multiple "words" separated by ;
# A word describing an object has a colon, such as "line:X1,Y1,Z1,X2,Y2,Z2".
# This immediately causes the object to be created with existing colors etc.
# Or a word can set a value with an equal sign, such as "color=R G B".
# When a word changes a value it applies to all subsequent instructions.

# Input and output data format
# color=1 0 0
# linewidth=3
# line:X1,Y1,Z1,X2,Y2,Z2
# line:X1,Y1,Z1,X2,Y2,Z2;line:X1,Y1,Z1,X2,Y2,Z2
# color=0 0 1
# line:X1,Y1,Z1,X2,Y2,Z2
# triangle:X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3
# line:X1,Y1,Z1,X2,Y2,Z2
# linewidth=1;line:X1,Y1,Z1,X2,Y2,Z2
# color=0.2 0.2 0.2;line:X1,Y1,Z1,X2,Y2,Z2
# fontname=Times-Roman;fontsize=12;fontjust=CENTER
# text:X1,Y1,Z1,whatever you want to say here

# ENHANCEMENT:
# Allow lines with more than two points.
# This would be MUCH more efficient.
# e.g. line:X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3...
#
# Modify other programs to output longer lines.


# INITIALIZE:
my $XFactor;
my $YFactor;
my $ZFactor;

# SUBROUTINES:
use strict;

sub Scale {
  my $Value;
  ($Value) = @_;

# print STDERR "Scaling value='$Value'\n";

  # $Value should have one or more groups of X,Y,Z
  my @XYZ;
  @XYZ = split (/,/, $Value);

  my $Output;
  $Output = '';

  while (defined ($XYZ[0])) {
    $Output .= shift (@XYZ) * $XFactor . ',';
    $Output .= shift (@XYZ) * $YFactor . ',';
    $Output .= shift (@XYZ) * $ZFactor . ',';
  }

# print STDERR "Before chop='$Output'\n";
  # remove last comma
  chop ($Output);
  return $Output;
}


# ARGUMENTS:
$XFactor = shift or die 'Required X factor missing';

$YFactor = shift or die 'Required Y factor missing';

$ZFactor = shift or die 'Required Z factor missing';

# MAINLINE:
my $Line;
while ($Line = <>) {
  chomp $Line;

  my $Output;
  $Output = '';

  # a "word" is anything separated by semicolons
  my @Word;
  @Word = split (/;/, $Line);
  my $Word;
  foreach $Word (@Word) {
#   print STDERR "Processing '$Word'\n";

    # some words may set variables
    if ($Word =~ /=/) {
      # no need to parse VAR=VALUE
      $Output .= $Word;

    # other words may specify objects
    } elsif ($Word =~ /:/) {
      # parse VAR=VALUE
      my $Var;
      my $Value;
      ($Var, $Value) = split (/:/, $Word, 2);

      if ($Var eq 'line') {
        $Output .= "$Var:";
        $Output .= (&Scale ($Value));
      } elsif ($Var eq 'triangle') {
        $Output .= "$Var:";
        $Output .= (&Scale ($Value));
      } elsif ($Var eq 'text') {
        warn "Don't know how to scale text yet";
      } else {
        print STDERR "Unrecognized object name: '$Word'\n";
      }


    } else {
      print STDERR "Unrecognized instruction: '$Word'\n";
    }
    $Output .= ';';
  }
  # remove last semicolon
  chop ($Output);
  print $Output;
  print "\n";
}