#!/usr/bin/perl -w
#
# For pulling MUSHformatted MUSHCode apart into something that's more
# human-friendly.
#
# Copyright (C) Bek Oberin, 1997.
# http://www.tertius.net.au/~gossamer/mush/
#
# $Id: mush2human,v 1.1.1.1 1998/11/12 14:03:56 gossamer Exp $
#
# Last updated by gossamer on Tue Jan 13 09:03:59 EST 1998
#

use strict;
no strict 'vars';

#
# User config
#

$tabstring = "   ";

$DEBUG = 1;

#
# End user config
# Anything you change below here is YOUR problem!
#

sub indent {
   my ($line) = @_;

   $line =~ s/^/$tabstring/mg;

   return($line);
}

sub de_something {
   my ($in, $char, $in_bracket, $out_bracket) = @_;
   my @chars = split(//, $in);
   my ($in_brackets) = (0);
   my @out_chars = ();

   foreach my $c (@chars) {
     if ($c eq '\\') {
        if ($escaped) {
           $escaped = 0;
        } else {
           $escaped = 1;
        }
     } elsif ($c =~ /$in_bracket/) {
       ++$in_brackets;
     } elsif ($c =~ /$out_bracket/) {
       --$in_brackets;
     } elsif ((($in_brackets > 0) || $escaped) && ($c eq $char)) {
       $c = '@@';
       $escaped = 0;
     }
     push @out_chars, $c;
   }

   return(join ("", @out_chars));
}



sub do_program {
   my ($line) = @_;

   print "do_program: '$line'\n" if $DEBUG > 1;

   # This is the attribute name
   #$line =~ s/^\s*([^:]+)\s*://;
   $line =~ s/^\s*([\@\&][^=]+)\s*=//;
   return($1 . "=\n" . &indent(&do_function($line)));
}

sub do_function {
   my ($line) = @_;

   print "do_function: '$line'\n" if $DEBUG > 1;

   # This is command name and arguments
   
   if ($line =~ s/^\s*(\$[^:]+)\s*://) {
      # Guess it's a command
      return($1 . ":\n" . &indent(&do_command_list($line)));
   } else {
      # Guess it's a function
      return &indent(&do_command_list($line));
   }
}

#
# List of commands separated by semicolons
#
sub do_command_list {
   my ($line) = @_;

   print "do_command_list: '$line'\n" if $DEBUG > 1;

   my ($output) = "";

   $line = &de_something($line, ';', '[\[\{]', '[\]\}]');

   # split on ;'s and pass each piece to do_command
   while ($line =~ s/^\s*([^;]*)\s*;\s*//) {
      my $command = $1;
      $command =~ s/\@\@/;/g;
      $output .= &do_command($command) . ";\n";
   }
   $line =~ s/\@\@/;/g;
   $output .= &do_command($line);

   return($output);
}


sub do_command {
   my ($line) = @_;

   print "do_command: '$line'\n" if $DEBUG > 1;

   $line = &de_something($line, '=', '[\(\{]', '[\)\}]');
   if ($line =~ s/^\s*\{\s*(.*)\s*\}\s*$//) { 
      # braces
      $tmp = $1;
      $tmp =~ s/\@\@/=/g;
      return("{\n" . &indent(&do_command_list($tmp)) . "\n}");

   } elsif ($line =~ s/^(\@switch(\/(first|all))?)\s*([^=]+)=//) { 
      # switch
      $tmp = $4;
      $switch = $1;
      $line =~ s/\@\@/=/g;
      $tmp =~ s/\@\@/=/g;
      return($switch . " " . &do_expression($tmp) . "=\n" . 
             &indent(&do_command_switch($line)));

   } elsif ($line =~ s/^\@wait\s+([^=]+)=//) { 
      # wait
      $tmp = $1;
      $line =~ s/\@\@/=/g;
      $tmp =~ s/\@\@/=/g;
      return("\@wait " . &do_expression($tmp) . "=\n" .
             &indent(&do_command($line)));

   } elsif ($line =~ s/^\@pemit\s+([^=]+)=//) { 
      # pemit
      $tmp = $1;
      $line =~ s/\@\@/=/g;
      $tmp =~ s/\@\@/=/g;
      return("\@pemit " . &do_expression($tmp) . "=" . &do_long_expression($line));

   } elsif ($line =~ s/^\@dolist\s+([^=]+)=//) { 
      # dolist
      $tmp = $1;
      $line =~ s/\@\@/=/g;
      $tmp =~ s/\@\@/=/g;
      return("\@dolist " . &do_expression($tmp) . "=\n" . 
             &indent(&do_command($line)));

   } else {
      $line =~ s/\@\@/=/g;

      #if ($line =~ /^\[/) {
         return(&do_long_expression($line));
      #} else {
         #return($line);
      #}

   }

}

sub do_expression {
   my ($line) = @_;

   print "do_expression: '$line'\n" if $DEBUG > 1;

   if (length($line) > 70) {
      return ("\n" . &indent(&do_long_expression($line)));
   } else {
      return ($line);
   }
}

sub do_long_expression {
   my ($line) = @_;

   print "do_long_expression: '$line'\n" if $DEBUG > 1;

   $line =~ s/(%r)/$1\n$tabstring/g;
   $line =~ s/\]\[/\]\n$tabstring\[/g;

   #if ($line =~ m/\n/m) {
   #   $line =~ s/^/\n$tabstring/;
   #}

   return ($line);
}

sub do_command_switch {
   my ($line) = @_;

   print "do_command_switch: '$line'\n" if $DEBUG > 1;
   my ($output) = "";

   $line = &de_something($line, ',', '[\[\{\(]', '[\)\]\}]');

   while ($line =~ s/^\s*([^,]*,[^,]+)\s*(,|$)//) {
      my $pair = $1;
      my $trailing_comma = $2;
      $pair =~ s/\@\@/,/g;
      $output .= &do_command_switch_pair($pair) . ($trailing_comma ? ",\n" : "");
   }
   # optional default
   if ($line =~ /(.+)/) {
      my $command = $1;
      $command =~ s/\@\@/,/g;
      $output .= &do_command($command);
   }

   return ($output);

}

sub do_command_switch_pair {
   my ($line) = @_;

   print "do_command_switch_pair: '$line'\n" if $DEBUG > 1;

   $line = &de_something($line, ',', '[\[\{]', '[\]\}]');

   $line =~ s/^\s*([^,]*)\s*,\s*([^,]+)\s*//;

   my $expression = $1;
   my $command = $2;
   $expression =~ s/\@\@/,/g;
   $command =~ s/\@\@/,/g;
   return(&do_expression($expression) . ",\n" . &indent(&do_command($command)));
}


#
# Main starts here
#
while (<>) {     # each line is a separate command, remember
   # Remove newlines
   chomp;

   if (/^$/) {
      next;
   }

   print &do_program($_);
   print "\n\n";

}

#
# End.
#