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

package Subtitle::SSA::Style;

use strict;
use warnings;
use utf8;

use base 'Subtitle::SSA::Record';

my @FIELDS_SSA = qw(name fontname fontsize primarycolour secondarycolour tertiarycolour backcolour bold italic borderstyle outline shadow alignment marginl marginr marginv alphalevel encoding);
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);

# see parse() description for available type's
my %FIELDS = (
  name              => { type => 's', value => 'Default', name => 'Name' },
  fontname          => { type => 's', value => 'Arial'  , name => 'Fontname' },
  primarycolour     => { type => 'x', value => 0x00FFFFFF, name => 'PrimaryColour' },
  secondarycolour   => { type => 'x', value => 0x00000000, name => 'SecondaryColour' },
  outlinecolour     => { type => 'x', value => 0x004E3873, name => 'OutlineColour' },
  tertiarycolour    => { type => 'x', value => 0x004E3873, name => 'TertiaryColour' },
  backcolour        => { type => 'x', value => 0x96000000, name => 'BackColour' },
  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' },
  alphalevel        => { type => 'd', value =>   0, name => 'AlphaLevel' },
  encoding          => { type => 'd', value => 204, name => 'Encoding' },
);

# options:
#  * type - 'ssa' for v4 or 'ass' for v4+
sub new {
  my ($class, %opts) = @_;
  my $self = {
    _type   => 'ass',
    _fields => \%FIELDS,
    _format => \@FIELDS_ASS,
    _prefix => 'Style',
  };

  if (my $t = $opts{type}) {
    if ($t =~ m{^(ass|ssa)$}oi) {
      $self->{_type} = lc($t);
    } else {
      die("unsupported event type $t");
    }
  }

  $self->{_format} = \@FIELDS_SSA
    if $self->{_type} eq 'ssa';

  my @fields = @{ $self->{_format} };
  $self->{$_} = $FIELDS{$_}->{value}
    foreach @fields;

  return bless($self, $class);
}

1;