package FormatQuark;


# PACKAGE : FormatQuark
# PURPOSE : Contains the Quark Xpress Attributes specific tags information
# AUTHOR  : Tim Pizey
# CREATED : 11 Sep 1998
#-----------------------------------------------------------------------------

# Modification History Log
# ========================
# Who                      When       What
#-----------------------------------------
# Tim@paneris.co.uk        11/09/98   Copy from Formatfff4.pm
#-----------------------------------------


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,


    '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:

# 
# ---------------
#  tabstopsParse
# ---------------
#
# @param    commalist       a list like `1,2,"2  ",3,4,"foo"'
# @returns  a structure like [[1, 2, "2  "], [3, 4, "foo"]]
# 

sub tabstopsParse {
  my ($commalist) = @_;
  my @tabs = ();

  while ($commalist !~ /^\s*$/) {
    if (!($commalist =~ s/^ \s* ([0-9.]+) \s*,\s*
			      ([0-9.]+) \s*,\s*
			      "([^\"]*)" \s* # FIXME escaped quotes?
			      (,|$) //x)) {
      warn "Illegal tabstop definition: $commalist\n";
      last;
    }
    push @tabs, [$1, $2, $3];
  }

  \@tabs;
}



sub code_actions
{
   my($type, $param) = @_;


   &main::debug_print("Param = $param");
   my @return_list = ();

   my ($left_indent, 
       $first_line_indent, 
       $right_indent,
       $leading,
       $space_before,
       $space_after,
       $grid_lock_flag);


#   $param =~ s/^\s*//;
#   $param =~ s/\s*$//;
#
#TESTME   What should we do with <C$>, it is illogical, Center and return to default state.
#FIXME   Also $t15 - it should reset all, then set tabs

#   $param =~ s/^(.+)\$$/$1/;
#   $param =~ s/^\$(.+)$/$1/;

   if ($param eq "\$") {
                       # This is it....
                       # it means 'return all CLF to 
                       # state in this style
     my $attrib;
     foreach $attrib (keys %$main::running_stylesheet) {
       if (defined ($main::running_stylesheet->{$attrib})) {
         &main::debug_print("Attrib $attrib = $main::running_stylesheet->{$attrib}");
         if (defined $main::current_stylesheet->{$attrib}) {
           if ($main::running_stylesheet->{$attrib} eq $main::current_stylesheet->{$attrib}) {
           }
           else {
             push @return_list, ($attrib => $main::current_stylesheet->{$attrib});
           }
         }
         else {
           if (defined $main::normal_stylesheet->{$attrib}) {
             if ($main::running_stylesheet->{$attrib} eq $main::normal_stylesheet->{$attrib}) {
             }
             else {
               push @return_list, ($attrib => $main::normal_stylesheet->{$attrib});
             }
           }
           else {
               push @return_list, ($attrib => undef);
           }
         }
       }
       else {
         if (defined $main::current_stylesheet->{$attrib}) {
             push @return_list, ($attrib => $main::current_stylesheet->{$attrib});
         }
         else {
           if (defined $main::normal_stylesheet->{$attrib}) {
               push @return_list, ($attrib => $main::normal_stylesheet->{$attrib});
           }
         }
       }
     }
   }
   elsif ($param eq '') {
     @return_list =  ();
   }
#HACK
   elsif ($param eq 't$')
   {
     @return_list =  ();
   }
#TEST What is a negative tabstop?
   elsif ($param =~ m|t\-\d+\$?$|)
   {
     @return_list =  ();
   }
#TEST What is a negative decimal tabstop?
   elsif ($param =~ m|t\-\d+\.\d+\$?$|)
   {
     @return_list =  ();
   }
#HACK
   elsif ($param =~ m|(\$?)t[\d+](\$?)|)
   {
     @return_list =  ();
   }
   elsif ($param =~ /^t\(([^\)]*)\)\$?$/) {
      @return_list =  (tabstops => tabstopsParse $1);
   }
   elsif ($param =~ m|^L\$?$|) # Dollar has no meaning
   {
      @return_list =   (alignment => 'left');
   }
   elsif ($param =~ m|R\$?$|) {
      @return_list =   (alignment => 'right');
   }
   elsif ($param =~ m|C\$?$|) {
      @return_list =   (alignment => 'centre');
   }
   elsif ($param =~ m|J\$?$|) {
      @return_list =   (alignment => 'justify');
   }
   elsif ($param =~ m|F\$?$|) {
      @return_list =   (alignment => 'fjustify');
   }
   elsif ($param =~ m|^h"[^"]+"$|) { # hyphenation & justification specification name
                                     # Usually "Standard", but can be "None" or external name
                                     # note similarity to hscale_percent
      @return_list =  ();
   }
   elsif ($param =~ m|^h(\d+\.\d+)\$?$|) # Horizontal scale percent 
   {
       @return_list =  (hscale_percent => $1);
   }
   elsif ($param =~ m|^h\$$|)
   {
        my $hscale_percent = $main::current_stylesheet->{hscale_percent}
        or 
        $hscale_percent = $main::normal_stylesheet->{hscale_percent};
      @return_list =  (hscale_percent => $hscale_percent) ;
   }
   elsif ($param =~ m|kn0\$?$|) { 
      @return_list =   (keep_with => undef);
   }
   elsif ($param =~ m|^kn1\$?$|)
   { 
      @return_list =   (keep_with => 1);
   }
   elsif ($param =~ m|ktA\$?$|) {  # keep together All
#      @return_list =   (keep_together => ?????);
      @return_list =  ();
   }
   elsif ($param =~ m|kt0(\$?)|) { 
#      @return_list =   (keep_together => ?????);
      @return_list =  ();
   }
   elsif ($param =~ m|^kt1\$?$|)
   { 
#      @return_list =   (keep_together => ?????);
      @return_list =  ();
   }
#FIXME
   elsif ($param =~ m|^kt\(([\d+]),([\d+])\)\$?$|)
   { 
      my $start_line_number = $1;
      my $end_line_number   = $2;
#      @return_list =   (keep_together => ?????);
      @return_list =  ();
   }
   elsif ($param =~ m|ra\(([^,]*),([^,]*),([^,]*),([^,]*),([^,]*),([^,]*),([^,]*)\)|) { 
#FIXME
#      @return_list =  (rule_above => ($1,$2,$3,$4,$5,$6,$7));
      @return_list =  ();
   }
   elsif ($param =~ m|ra0\$?$|) { 
      @return_list =  ();
   }
   elsif ($param =~ m|rb0\$?$|) { 
      @return_list =  ();
   }
   elsif ($param =~ m|rb\(([^,]*),([^,]*),([^,]*),([^,]*),([^,]*),([^,]*),([^,]*)\)|) { 
#FIXME
#      @return_list =  (rule_below => ($1,$2,$3,$4,$5,$6,$7));
      @return_list =  ();
   }
   elsif ($param =~ m|d0\$?$|) {  #dropcap
#FIXME
      @return_list =  ();
   }
   elsif ($param eq 'p(0,0,0,12,0,0,g,"International English")') { 
      @return_list =  ();
   }
   elsif (($left_indent, $first_line_indent, $right_indent, $leading, $space_before, $space_after, $grid_lock_flag) = 
            $param =~ m|^p\(([\-\d\.]+),([\-\d\.]+),([\-\d\.]+),([\d\.]+),([\d\.]+),([\d\.]+),([gG]),"International English"\)\$?$|)
   {
      if ($grid_lock_flag eq 'G') {
         $grid_lock_flag = 1;
      }
      else {
         $grid_lock_flag = 0;
      }
      @return_list =  
             (left_indent       => $left_indent, 
              first_line_indent => $first_line_indent, 
              right_indent      => $right_indent,
              leading           => $leading,
              space_before      => $space_before,
              space_after       => $space_after,
              grid_lock_flag    => $grid_lock_flag
             );
   }
   elsif ($param =~ m|^f\"([^\"]*)\"(\$?)$| or
          $param =~ m|^f(\w+)(\$?)$|) # font
   {
       @return_list =  (font_name => $1);
   }
   elsif ($param =~ m|^f\$$|) # font back to normal
   {
        my $font = $main::current_stylesheet->{font} 
        or $font = $main::normal_stylesheet->{font};
       @return_list =  (font_name => $font);
   } 
   elsif ($param =~ m|^P\$?$|) #plain
   {
      my $attrib = '';
      foreach $attrib (keys %$main::running_stylesheet) {
          unless (defined $Format::attribute_level{$attrib}) { 
             &main::cgi_die("Attribute ($attrib) has no level defined.");
          }
          unless ($Format::attribute_level{$attrib} eq 'clf' or 
                  $Format::attribute_level{$attrib} eq 'plf' or
                  $Format::attribute_level{$attrib} eq 'meta' )
          { 
             &main::cgi_die("Attribute ($attrib) has odd level value ($Format::attribute_level{$attrib}).");
          }
          if ($Format::attribute_level{$attrib} eq 'clf')  {
            if (defined $main::running_stylesheet->{$attrib}) {
              if (defined $main::current_stylesheet->{$attrib}) {
                 if ($main::running_stylesheet->{$attrib} ne $main::current_stylesheet->{$attrib}){
                    push @return_list, ($attrib => $main::current_stylesheet->{$attrib});
                 }
              }
              elsif (defined $main::normal_stylesheet->{$attrib}) {
                 if ($main::running_stylesheet->{$attrib} ne $main::normal_stylesheet->{$attrib}){
                    push @return_list, ($attrib => $main::normal_stylesheet->{$attrib});
                 }
              }
              else {
                    push @return_list, ($attrib => undef);
              }
            }
            else {
              if (defined $main::current_stylesheet->{$attrib}) {
                    push @return_list, ($attrib => $main::current_stylesheet->{$attrib});
              }
              elsif (defined $main::normal_stylesheet->{$attrib}) {
                    push @return_list, ($attrib => $main::normal_stylesheet->{$attrib});
              }
              else {
                  # leave undefined
              }
            }
          }
      }
   }
   elsif ($param =~ m|^B\$?$|)
   {
      @return_list =   (bold => 1);
   }
   elsif ($param =~ m|^I\$?$|)
   {
      @return_list =   (italic => 1);
   }
   elsif ($param =~ m|^O\$?$|)
   {
      @return_list =   (outline => 1);
   }
   elsif ($param =~ m|^S\$?$|)
   {
      @return_list =   (shadow => 1);
   }
   elsif ($param =~ m|^U\$?$|)
   {
      @return_list =  (underline => 1) ;
   }
   elsif ($param =~ m|^W\$?$|)
   {
      @return_list =  (wordunderline => 1) ;
   }
   elsif ($param =~ m|^\\\$?$|)
   {
      @return_list =  (strikethru => 1) ;
   }
   elsif ($param =~ m|^K\$?$|)
   {
      @return_list =  (all_caps => 1) ;
   }
   elsif ($param =~ m|^H\$?$|)
   {
      @return_list =  (small_caps => 1) ;
   }
   elsif ($param =~ m|^\-\$?$|)
   {
      @return_list =  (subscript => 1) ;
   }
   elsif ($param =~ m|^\+\$?$|)  
   {
      @return_list =  (superscript => 1) ;
   }
   elsif ($param =~ m|^V\$?$|)
   {
      @return_list =  (superior => 1) ;
   }
   elsif ($param =~ /^z([0-9\.]+)\$?$/)
   {
      @return_list =  (font_size => $1) ;
   }
   elsif ($param =~ /^z\$$/)
   {
     my $font_size = $main::current_stylesheet->{font_size}
     or 
     $font_size = $main::normal_stylesheet->{font_size};
      @return_list =  (font_size => $font_size) ;
   }
   elsif ($param =~ /^s(\d+)\$?$/)
   {
      @return_list =  (shade_percent => $1) ;
   }
   elsif ($param =~ /^s\$?$/)
   {
     my $shade_percent = $main::stylesheets_found{$main::current_stylesheet->{name}}->{shade_percent}
     or 
     $shade_percent = $main::normal_stylesheet->{shade_percent};
     @return_list =  (shade_percent => $shade_percent) ;
   }
   elsif ($param =~ /^h(\d+)\$?$/)
   {
      @return_list =  (hscale_percent => $1) ;
   }
# Track and tabsstops seem to use the same code, the difference seems to be 
# that one has a decimal point

   elsif ($param =~ /^t([\d]+\.[\d]+)$/)
   {
      @return_list =  (track => $1) ;
   }
   elsif ($param =~ /^k([\-\d\.]+)$/) #kern next two characters
   {
      @return_list =  (kern => $2) ;
   }
   elsif ($param =~ /^k\$$/)  #@return_list =  to normal
   {
     my $kern = $main::current_stylesheet->{kern}
     or 
     $kern = $main::normal_stylesheet->{kern};
     @return_list =  (kern => $kern) ;
   }
   elsif ($param =~ /^b([\-\d\.]+)\$?$/)
   {
      @return_list =  (baseshift => $1) ;
   }
   elsif ($param =~ /^b\$$/)  #@return_list =  to normal
   {
     my $baseshift = $main::current_stylesheet->{baseshift}
     or 
     $baseshift = $main::normal_stylesheet->{baseshift};
     @return_list =  (baseshift => $baseshift) ;
   }
   elsif ($param =~ s/^c(\"?[^\"]*\"?)$//) # colour
   {
     @return_list =  (colour => $1);
   }
   elsif ($param =~ s/^c\$$//) # colour back to normal
   {
      my $colour = $main::current_stylesheet->{colour}
      or $colour = $main::normal_stylesheet->{colour};
     @return_list =  (colour => $colour);
   }
   else
   {
     print  "Line $main::line_no: Unknown Code($param)<br>\n";
     @return_list =  ();
   }

    my @tmp_list = @return_list;
    my $return_attrib = '';
    my $return_val = '';
    while ($return_attrib = shift @tmp_list)
    {
       $return_val = shift @tmp_list;
       if (!defined $return_val) {
         $return_val = "Undefined";
       }
       &main::debug_print("Returning actions $return_attrib => $return_val");
    }

   return @return_list;
}


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

  if ($value =~ /[^a-zA-Z0-9.]/) {
    $value =~ s/\"/\\\"/g;
    $value = "\"$value\"";
  }

  "*$attrib$value";
}

sub blockOutput {
  shift;
  '<' . join('', @_) . '>';
}

#
#
# 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




sub nameAttribute {
  '@';
}


sub recordOutput {
  "\n";
}

sub paraOutput {
  "\n";
}

sub breakOutput {
  "\n";
}

sub tabOutput {
  '\t';
}

sub asciiOutput {
  my $code = shift;
  $self->blockOutput("\\#$code");
}

# Attribute Outputs
#--------------------------------------

sub alignmentAttribute {
  '';
}

$alignmentValues = {
  'left' => 'L',
  'right' => 'R',
  'centre' => 'C',
  'justify' => 'J',
  'force' => 'F'
};

sub alignmentValue {
  $alignmentValues{$_[1]};
}

sub indentOutput {
  undef;
}

sub leadingOutput {
  undef;
}

sub space_beforeAttribute {
  undef;
}

sub space_afterAttribute {
  undef;
}

sub keep_withOutput {
  undef;
}

sub tabstopsOutput {
  undef;
}

sub keep_togetherOutput {
  undef;
}

sub font_nameAttribute {
  'f';
}

sub font_sizeAttribute {
  'z';
}

sub boldOutput {
  $_[1]->{bold} ? 'B' : 'B';
}

sub italicOutput {
  $_[1]->{italic} ? 'I' : 'I';
}

sub underlineOutput {
  $_[1]->{underline} ? 'U' : 'U';
}
sub wordunderlineOutput {
  $_[1]->{underline} ? 'W' : 'W';
}

sub strikethroughOutput {
  $_[1]->{strikethrough} ? '/' : '/';
}

# FIXME what is this meant to be?

sub vertical_offsetAttribute {
  'SP';
}

sub hscale_percentOutput {
  undef;
}

sub colourOutput {
  undef;
}

sub shadowOutput {
  $_[1]->{shadow} ? 'O' : 'O';
}


sub outlineOutput {
  $_[1]->{outline} ? 'O' : 'O';
}

sub small_capsOutput {
  $_[1]->{small_caps} ? 'H' : 'H';
}
sub all_capsOutput {
  $_[1]->{all_caps} ? 'K' : 'K';
}
sub superscriptOutput {
  $_[1]->{superscript} ? '+' : '+';
}

sub subscriptOutput {
  $_[1]->{subscript} ? '-' : '-';
}
sub superiorOutput {
  $_[1]->{superior} ? 'V' : 'V';
}


###########################



sub definitionOutput {
  my $self = shift;
  my $name = shift;
  &main::debug_print("Name=($name)");

  $self->attribBlockOutput('name', $name, @_);
}

sub invocationOutput {
  $_[0]->blockOutput($_[0]->recordOutput)
  .
  $_[0]->blockOutput($_[0]->concreteAttribValueOutput('PS', $_[1]));
}



sub definition_footer
{
  return '';
}


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;

    foreach $attrib (keys %default_values) {
      if (defined $default_values{$attrib}) {
        $self->{$attrib} = $default_values{$attrib};
      }
    }

    return 1;
}



1;