package Format;

# PACKAGE : Format
# PURPOSE : Contains the abstract attribute manipulations
# AUTHOR  : William Chesters (WilliamC@dai.ed.ac.uk)
# CREATED : 1 Sep 1998
#-----------------------------------------------------------------------------

# Modification History Log
# ========================
# Who                      When       What
#-----------------------------------------
# Williamc@dai.ed.ac.uk    31/08/98   Write
# Tim@paneris.co.uk        07/09/98   Debug :) 
#                                     (V3 perl has different scoping rules for my)
# Tim@paneris.co.uk        07/09/98   Rename
# Tim@paneris.co.uk        21/09/98   Move new, new blank et al in from StyleSheet
#HELP - This can't really be right.............
# Tim@paneris.co.uk        23/09/98   Move copy into children, so as not to change object type 
#-----------------------------------------

use DX::Rule;



# Naming convention
#
# I have tried to stick to SGML naming conventions, 
# even for Formats which owe nothing to SGML.
#  A tag is something enclosed in (Start Tag Open Character) STOC (<) and (Start Tag End Character) STEC (>).
# In SGML there are Start Tags and End Tags, but at the moment we don't have End tags as such.
#
# A Tag has Attributes which can take Values or not, in which case they are flags
#
# So in SGML:
# <p align=center indented> </p> 
#   p is a Tag
#   align is an Attribute 
#   indented is an Attribute
#   center is a Value
#
# In FFF
# <PA:"style name";JU:CN;HD+>
#   PA is both a Tag and an Attribute ?????
#   "style name" is a Value
#   JU is an Attribute
#   CN is a Value
#   HD is an Attribute
#    + is a Value



# Something can be changed either 
#    by bare tags <B>
# or by attributes with values <font_size = 10> 
# or by tags with attributes with values <font size=10>
# or by tags with attributes without values <p indented>

# Only one of subroutine out of <attrib>Attribute and <attrib>Value should exist.
sub attribOutput {
  my ($self, $attrib, $value_from_code_actions) = @_;
  {
     my $colour = "ffaaff";
     my $val = $value_from_code_actions;
     unless (defined $val) {
       $val = "Undefined";
     }
     my $att = $attrib;
     unless (defined $att) {
       $att = "Undefined Att";
       $colour = "FFFF00";
     }
     &main::debug_print("Att=($att), Val=($val)");
  }

  my $concreteVal  = undef;
  my $output       = undef;
  my $attribValue  = $attrib . 'Value';
  my $attribOutput = $attrib . 'Output';
 
  # See if the sub $attribAttribute exists
  my $attrib_name = undef;
  my $attribAttribute = $attrib . 'Attribute';
  eval {
    &main::debug_print("looking for $attribAttribute");
    local $SIG{__DIE__} = 'IGNORE'; # else will get [CGI::Carp]ed at
    $attrib_name = $self->$attribAttribute();
  };
  if (defined $attrib_name) {
    eval {
      &main::debug_print("looking for $attribValue");
      local $SIG{__DIE__} = 'IGNORE'; # else will get [CGI::Carp]ed at
      $concreteVal = $self->$attribValue($value_from_code_actions);
    };
    $@ eq '' or &main::cgi_die("subroutine $attribAttribute exists but $attribValue has an error.");
    if (defined($concreteVal)) {
      &main::debug_print("found $attribValue");
      $output = $self->concreteAttribValueOutput($attrib_name, $concreteVal);
    }
    else {
      &main::debug_print("$attribValue not defined");
      $output = undef;
    }
  }
  else {
    eval {
      local $SIG{__DIE__} = 'IGNORE'; # else will get [CGI::Carp]ed at
      $output = $self->$attribOutput();
    };
    $@ eq '' or &main::cgi_die("Neither $attribValue nor $attribOutput subroutines defined");
  }

  $output;
}

# Return a block of attributes 
# from a list of alternating attributes and values
sub attribBlockOutput {
  my $self = shift;
  my @entries = ();
  my $attrib;
  while (defined ($attrib = shift)) {
    my $value = shift;
    defined $value or $value = '';
    &main::debug_print("calling attribOutput($attrib, $value)");
    my $output = $self->attribOutput($attrib, $value);
    push @entries, $output if defined $output;
  }

  $self->blockOutput(@entries);
}



sub set_values { 
    my $self   = shift;
    my %params = @_;
    my $param;
    my @tags = ();
    foreach $param (keys %params) {
      {
        my $tmp = $params{$param};
        unless (defined $params{$param}) {
          $tmp = "undefined";
        }
        my $tmp2 = ref($self);
        &main::debug_print("Setting $param to $tmp for $tmp2");
      }
      my $tag_contents = $self->attribOutput($param, $params{$param});
      if (defined $tag_contents) {
          push @tags, $tag_contents;
      }
      if(defined($self->{$param}) && $self->{$param} eq 1) {
	$self->{$param} = undef;
      }
      else {
	$self->{$param} = $params{$param};
      }      
    }
  return @tags;
} 


####################################
# CONSTRUCTOR:  

# We dont want all the values defaulted, so give us a blank one

sub new {
  return bless {};
}

sub display {
  my $self = shift;
  my @keys = @_ ? @_ : sort keys %$self;
  print "<table>\n";
  foreach $key (@keys) {
     print " <tr>\n  <td>$key</td>\n  <td>$self->{$key}</td>\n </tr>\n";
  }
  print "</table>\n";
}

sub write_tags {
  my $self = shift;
  my $key;
  print "<pre>\n";
  foreach $key (sort keys %$self) {
       print " '$key' => 'clf,'\n";
  }
  print "</pre>\n";
}

%attribute_level = (

 'name'              => 'meta',
 'alignment'         => 'plf',
 'baseshift'         => 'plf',
 'first_line_indent' => 'plf',
 'grid_lock_flag'    => 'plf',
 'keep_together'     => 'plf',
 'keep_with'         => 'plf',
 'language'          => 'plf',
 'leading'           => 'plf',
 'left_indent'       => 'plf',
 'right_indent'      => 'plf',
 'rule_above'        => 'plf',
 'rule_below'        => 'plf',
 'space_after'       => 'plf',
 'space_before'      => 'plf',
 'tabstops'          => 'plf',
 'track'             => 'plf',

 'all_caps'        => 'clf',
 'bold'            => 'clf',
 'colour'          => 'clf',
 'drop_cap'        => 'clf',
 'dc_char_count'   => 'clf',
 'dc_line_count'   => 'clf',
 'font_name'       => 'clf',
 'font_size'       => 'clf',
 'hscale_percent'  => 'clf',
 'hyphenation'     => 'clf',
 'italic'          => 'clf',
 'kern'            => 'clf',
 'kt_end_line'     => 'clf',
 'kt_start_line'   => 'clf',
 'outline'         => 'clf',
 'plain'           => 'clf',
 'shade_percent'   => 'clf',
 'shadow'          => 'clf',
 'small_caps'      => 'clf',
 'strikethru'      => 'clf',
 'subscript'       => 'clf',
 'superior'        => 'clf',
 'superscript'     => 'clf',
 'underline'       => 'clf',
 'vscale_percent'  => 'clf',
 'wordunderline'   => 'clf'

);

sub write_subs
{
  my $self = shift;
  my ($attrib,$value_from_code_actions);
  print "<pre>\n";
  print "# Paragraph level formatting\n";
  foreach $attrib (sort keys %$self) {
    my $value_from_code_actions = $self->{$attrib};
    if ($attribute_level{$attrib} eq 'plf')
    {
     print "sub $attrib","Output { # Default is $value_from_code_actions\n  undef;\n}\n";
    }
  } 
  print "# Character level formatting\n";
  foreach $attrib (sort keys %$self) {
    my $value_from_code_actions = $self->{$attrib};
    if ($attribute_level{$attrib} eq 'clf')
    {
     print "sub $attrib","Output { # Default is $value_from_code_actions\n  undef;\n}\n";
    }
  }
  print "</pre>\n";
}


1;