+ Subtitle::SSA::Style : draft

lib/Subtitle/SSA/Style.pm

@@ -0,0 +1,97 @@
+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 => 'd', value =>   0, name => 'Spacing' },
+  angle             => { type => 'd', value =>   0, name => 'Angle' },
+  borderstyle       => { type => 'd', value =>   1, name => 'BorderStyle' },
+  outline           => { type => 'd', value =>   2, name => 'Outline' },
+  shadow            => { type => 'd', 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: ";
+  foreach my $field (@fields) {
+    my $d = $STYLE_DEFAULTS{$field};
+    if ($d->{type} eq 'x') {
+      $fmt = ($self->{_vers} eq 'ass') ? '&H%08X' : '%d';
+      $string .= sprintf $fmt, $self->{$f};
+    } else {
+      $string .= $self->{$f} // $d->{value};
+    }
+  }
+
+  return $string;
+}
+
+1;