package FormatFFF4;


# PACKAGE : FormatFFF4
# PURPOSE : Contains the Folio View V4 specific tags information
# 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        31/08/98   Rename
#-----------------------------------------


use DX::Format;

@ISA = ('Format');


%default_values = (
    'baseshift'          => 0,
    'alignment'          => 'left',
#    for (temp_int = 0; temp_int < max_tabs; temp_int++)
#    {
#           "tabs[temp_int]"  => 0,  
#    }
    'tabstops'           => [], # tabstopsParse('1,2,"foo"');  
    'left_indent'        => undef,  
    'first_line_indent'  => undef,
    'right_indent'       => undef,  
    'leading'            => undef,
    'space_before'       => undef,
    'space_after'        => undef,
    'grid_lock_flag'     => 1,
    'language'           => undef,
    'hyphenation'        => undef,
    'rule_above'         => undef,
    'rule_below'         => undef,
    'drop_cap'           => undef,
    'dc_char_count'      => undef,
    'dc_line_count'      => undef,
    'keep_with'          => undef,
    'keep_together'      => undef,
    'kt_start_line'      => undef,
    'kt_end_line'        => undef,

#clf

    'plain'              => undef, 
    'bold'               => undef,
    'italic'             => undef,
    'outline'            => undef,
    'shadow'             => undef, 
    'underline'          => undef,
    'wordunderline'      => undef,
    'strikethrough'      => undef,
    'all_caps'           => undef,  
    'small_caps'         => undef,
    'superscript'        => undef,
    'subscript'          => undef,
    'superior'           => undef,
    'font_name'          => 'Times-Roman',
    'font_size'          => 10,
    'colour'             => undef,
    'shade_percent'      => undef,
    'hscale_percent'     => undef,
    'vscale_percent'     => undef,
    'kern'               => undef,
    'track'              => undef

);


####################################
# CLASS METHODS:

sub concreteAttribValueOutput {
  my ($self, $attrib, $value) = @_;

  my $v = $value;
  unless (defined $v) {
      $v = "Undefined";
  }
  &main::debug_print("attrib:$attrib, Value:$v");

  if ($value =~ /[^a-zA-Z0-9.]/) {
    $value =~ s/\"/\\\"/g;
    $value = "\"$value\"";
  }
#HACK to cope with sub/superscript
  if ($value ne '') {
    "$attrib:$value";
  }
  else {
    $attrib;
  }
  
}

sub blockOutput {
  shift;
#HELP is this a hack? should I be making sure I never pass in an empty list?
  if (@_ ge 1) {
    '<' . join('; ', @_) . '>';
  }
  else{
   '';
  }
}


sub nameAttribute {
  'PA';
}
sub nameValue {
  my $self = shift;
  my $name =shift;
  $name;
}


sub recordOutput {
  'RD';
}

sub paraOutput {
  'HR';
}

sub breakOutput {
  'CR';
}
sub atOutput {
  "\@";
}

sub tabOutput {
#  $TabCount++;
  'TB';
}

sub tab_to_tabstop
{
  my $type = shift;
  my $tabstop = shift;
# while ($TabCount < $tabstop) {
#  $self->blockOutput($self->tabOutput)  ;
# }

}
sub asciiOutput {
  my $self = shift;
  my $code = shift;
&main::debug_print("Code = $code");
  if ($code == 9) {
    $main::output_file_style->blockOutput($main::output_file_style->tabOutput);
  }
  elsif ($code == 209) { # M dash
    pack "c", 151;
  }
  elsif ($code == 212) {
    "'";
  }
  elsif ($code == 213) {
    "'";
  }
  else {
    pack "c", $code;
  }
}


#
#
# for each kind of attribute, 
# ie those which take a value or booleans
#
# define 
#   EITHER 
#      <attrib>Output, 
#   OR
#      <attrib>Attribute and <attrib>Value
#
# in the latter case the default Format::attribOutput will use
# <attrib>Attribute and <attrib>Value 
# in conjunction with the supplied  concreteAttribValueOutput above

# Note that Tabcount is not an attribute, but needs a ouput subroutine 
#HELP Ugliness occuring
sub TabCountOutput {
  undef;
}

#---------------------------
# Paragraph level formatting
sub alignmentAttribute {
  'JU';
}

$alignmentValues = { # Default is left
  'left' => 'LF',
  'right' => 'RT',
  'centre' => 'CN',
  'justify' => 'FL'
};

# $_[1] means parameter one, as parameter 0 is the type
sub alignmentValue {
  $alignmentValues{$_[1]};
}

sub baseshiftOutput { # Default is 0
  undef;
}
sub first_line_indentOutput { # Default is 0
  undef;
}
sub grid_lock_flagOutput { # Default is TRUE
  undef;
}
sub keep_togetherOutput { # Default is off
  undef;
}
sub keep_withOutput { # Default is off
  undef;
}
sub languageOutput { # Default is  
  undef;
}
sub leadingOutput { # Default is 0
  undef;
}
sub left_indentOutput { # Default is 0
  undef;
}

sub right_indentOutput { # Default is 0
  undef;
}
sub rule_aboveOutput { # Default is Rule=HASH(0xbbc390)
  undef;
}
sub rule_belowOutput { # Default is Rule=HASH(0xbbc3f0)
  undef;
}
sub space_afterAttribute { 
  'AP';
}
sub space_afterValue { # Default is 0
  0;
}

sub space_beforeAttribute {
  'BP';
}
sub space_beforeValue {# Default is 0
  0;
}
sub tabstopsOutput { # Default is ARRAY(0xbbc30c)
  undef;
}
sub trackOutput { # Default is 0
  undef;
}
#-------------------------------




# Character level formatting
sub all_capsOutput { # Default is off
  undef;
}
sub boldOutput {
  my $self   = shift;
  my $tmp;
  if (defined $self->{bold}) {
    $tmp = $self->{bold};
  } else {
    $tmp = "undefined";
  }
  my $t2 = ref($self);
  &main::debug_print("arg is a $t2, bold is $tmp,  so outputting opposite");
  $self->{bold} ? 'BD-' : 'BD+';
}
sub colourOutput {
  undef;
}
sub dc_char_countOutput { # Default is nil
  undef;
}
sub dc_line_countOutput { # Default is nil
  undef;
}
sub drop_capOutput { # Default is off
  undef;
}
sub font_nameAttribute {
  'FT';
}
sub font_nameValue {
  shift;
  shift;
}
sub font_sizeAttribute {
  'PT';
}
sub font_sizeValue { 
  shift;
  shift;
}

sub hscale_percentOutput { # Default is 0
  shift;
  undef;
}

sub hyphenationOutput { # Default is  
  shift;
  undef;
}
sub italicOutput {
  my $self   = shift;
  $self->{italic} ? 'IT-' : 'IT+';
}
sub kernOutput { # Default is 0
  undef;
}
sub kt_end_lineOutput { # Default is nil
  undef;
}
sub kt_start_lineOutput { # Default is nil
  undef;
}
sub outlineOutput {  # distinction not available
  my $self = shift;
  $self->{outline} ? 'IT+' : 'IT';
}

sub plainOutput { # Default is on
  undef;
}
sub shade_percentOutput { # Default is 0
  undef;
}
sub shadowOutput {
  my $self = shift;
  $self->{shadow} ? 'IT+' : 'IT';  # distinction not available
}
sub small_capsOutput { # Default is off
  undef;
}
sub strikethroughOutput {
  my $self = shift;
  $self->{strikethrough} ? 'SO' : 'SO+';
}
sub subscriptAttribute {  # horrid Folio feature
  my $self = shift;
  $self->{subscript} ? '/SS' : 'SB' ;
}
sub subscriptValue {  # inches
  my $self = shift;
  $self->{subscript} ? '' : '0.005' ;
}
sub superiorOutput { # Default is off
  undef;
}
sub superscriptAttribute {  # horrid Folio feature
  my $self = shift;
  $self->{superscript} ? '/SS' : 'SP'  ;
}
sub superscriptValue {  # inches?
  my $self = shift;
  my $value = shift;

  $self->{superscript} ? '' : '0.005' ;
}
sub underlineOutput {
  my $self   = shift;
  $self->{underline} ? 'UN-' : 'UN+';
}
sub vscale_percentOutput { # Default is 0
  undef;
}
sub wordunderlineOutput {  # distinction not available
  my $self   = shift;
  $self->{wordunderline} ? 'UN+' : 'UN';
}

#=================

sub definitionOutput {
  my $self = shift;
  my $name = shift;

  &main::debug_print("name:$name");
   my @pairs = %{$self};
  $self->attribBlockOutput('name', $name, @pairs);
}

sub invocationOutput {

  $TabCount = 0;
  $_[0]->blockOutput($_[0]->recordOutput)
  .
  $_[0]->blockOutput($_[0]->concreteAttribValueOutput('PS', $_[1]));
}



sub definition_footer
{
  return <<end_of_text;
<CM> ***********************************************
     **          End of Definition                **
     *********************************************** </CM>
end_of_text
}


sub definition_header
{
  return <<end_of_text;
<CM> ***********************************************
     ** Definition Header                         **
     *********************************************** </CM>

<CM> ***********************************************
     ** Folio Flat File Identifier and Version Info **
     *********************************************** </CM>
<VI:Folio,FFF,4.11>

end_of_text
}

sub header
{
  return <<end_of_text;
<CM> ***********************************************
     ** Folio Flat File Header                    **
     *********************************************** </CM>

<CM> ***********************************************
     ** Folio Flat File Identifier and Version Info **
     *********************************************** </CM>
<VI:Folio,FFF,4.11>

end_of_text
}

sub footer
{
  return "<RD>\n";
}

sub new {
  bless {};
}


sub copy {

    my($self) = shift;

    # Create the anonymous hash reference to hold the object's data.

    my %copy = %$self;

    return bless \%copy;  
}

sub set_to_default {
 my($self) = shift;

  my $attrib = '';
  my $type = ref($self);
  foreach $attrib (keys %default_values) {
    my $value = $default_values{$attrib};
    if (defined $value) {
      $self->{$attrib} = $value;
      &main::debug_print("$type: attrib:$attrib: value:$value");
      my $t = $self->{$attrib};
      unless (defined $t) {
         $value = "Undefined";
      }
      &main::debug_print("value set:$t:");
    }
  }
 return $self;
}

sub html_dump
{
  my $self = shift;
  my $name = shift;
  my $attrib;
  my $value;
  my $type = ref($self);
  &main::debug_print("Contents of $name ($type)");
  foreach $attrib (keys %$self) {
    unless (defined $attrib) {
       $attrib = "Undefined";
    }
    $value = $self->{$attrib};
    unless (defined $value) {
       $value = "Undefined";
    }
    &main::debug_print("$attrib $value");
    
  }

}
1;