libsubtitle-perl/lib/Subtitle/SSA/Style.pm

package Subtitle::SSA::Style;

use strict;
use warnings;
use utf8;

use overload => (
  '""' => \&to_string,
);

my @FIELDS_SSA = qw(name fontname fontsize primarycolour secondarycolour outlinecolour backcolour bold italic underline strikeout scalex scaley spacing angle borderstyle outline shadow alignment marginl marginr marginv encoding); # FIXME: copypaste
my @FIELDS_ASS = qw(name fontname fontsize primarycolour secondarycolour outlinecolour backcolour bold italic underline strikeout scalex scaley spacing angle borderstyle outline shadow alignment marginl marginr marginv encoding);

my %STYLE_DEFAULTS = (
  # format: string
  name              => { type => 's', value => 'Default', name => 'Name' },
  fontname          => { type => 's', value => 'Arial'  , name => 'Fontname' },
  # format: hex-string (&H00AABBCC) for ASS or decimal number for SSA
  primarycolour     => { type => 'x', value => 0x00FFFFFF, name => 'PrimaryColour' },
  secondarycolour   => { type => 'x', value => 0x00000000, name => 'SecondaryColour' },
  outlinecolour     => { type => 'x', value => 0x004E3873, name => 'OutlineColour' },
  backcolour        => { type => 'x', value => 0x96000000, name => 'BackColour' },
  # format: decimal number
  fontsize          => { type => 'd', value =>  24, name => 'Fontsize' },
  bold              => { type => 'b', value =>   0, name => 'Bold' },
  italic            => { type => 'b', value =>   0, name => 'Italic' },
  underline         => { type => 'b', value =>   0, name => 'Underline' },
  strikeout         => { type => 'b', value =>   0, name => 'StrikeOut' },
  scalex            => { type => 'd', value => 100, name => 'ScaleX' },
  scaley            => { type => 'd', value => 100, name => 'ScaleY' },
  spacing           => { type => 'f', value =>   0, name => 'Spacing' },
  angle             => { type => 'f', value =>   0, name => 'Angle' },
  borderstyle       => { type => 'd', value =>   1, name => 'BorderStyle' },
  outline           => { type => 'f', value =>   2, name => 'Outline' },
  shadow            => { type => 'f', value =>   0, name => 'Shadow' },
  alignment         => { type => 'd', value =>   2, name => 'Alignment' },
  marginl           => { type => 'd', value =>  10, name => 'MarginL' },
  marginr           => { type => 'd', value =>  10, name => 'MarginR' },
  marginv           => { type => 'd', value =>  10, name => 'MarginV' },
  encoding          => { type => 'd', value => 204, name => 'Encoding' },
);

sub new {
  my ($class, %opts) = @_;
  my $self = {};
  bless($self, $class);

  if ($opts{version} and $opts{version} =~ m{^(ass|ssa)$}oi) {
    $self->{_vers} = lc($opts{version});
  } else {
    $self->{_vers} = 'ass';
  }

  my @fields = $self->fields();
  foreach my $field (@fields) {
    $self->{$field} = ($opts{defaults})
      ? $STYLE_DEFAULTS{$field}->{value}
      : undef;
  }

  return $self;
}

sub fields {
  my ($self) = @_;
  return ($self->{_vers} eq 'ssa')
    ? @FIELDS_SSA
    : @FIELDS_ASS;
}

sub set {
  my ($self, $opt, $value) = @_;
  return unless $opt;
  $opt = lc($opt);
  return unless exists $self->{$opt};
  $self->{$opt} = $value;
  return 1;
}

sub to_string {
  my ($self) = @_;
  my @fields = $self->fields();
  my $string = "Style: ";
  my @values = ();
  foreach my $field (@fields) {
    my $d = $STYLE_DEFAULTS{$field};
    my $v = $self->{$f} // $d->{value};
    if ($d->{type} eq 'x') {
      $fmt = ($self->{_vers} eq 'ass') ? '&H%08X' : '%d';
      $v = sprintf $fmt, $v;
    } elsif ($d->{type} eq 'f') {
      $v = sprintf "%.2f", $v;
      # hack: make decimal from float if fractional part is zero after round up
      $v =~ s{\.00$}{}oi;
    } else {
      # use as is
    }
    push @values, $v;
  }
  $string .= join(',', @values);

  return $string;
}

1;