From 31657f94da134ff835ec4d82fb15d239d74f9971 Mon Sep 17 00:00:00 2001 From: Niels Martin Hansen Date: Thu, 23 Jul 2009 01:39:57 +0000 Subject: [PATCH] The removal of Auto4 Ruby and Auto4 Perl code. Updates #665 and #938. Originally committed to SVN as r3205. --- .../automation/autoload/macro-1p-edgeblur.pl | 62 -- aegisub/automation/demos/k-replacer.rb | 62 -- aegisub/automation/demos/perl-console.pl | 16 - aegisub/automation/include/Aegisub.pm | 41 - .../automation/include/Aegisub/PerlConsole.pm | 6 - .../automation/include/Aegisub/Progress.pm | 11 - aegisub/automation/include/Aegisub/Script.pm | 6 - aegisub/automation/include/Auto4Utils.pm | 251 ------ aegisub/automation/include/karaoke.rb | 68 -- aegisub/automation/include/utils.rb | 114 --- aegisub/automation/v4-docs/perl-api.txt | 273 ------- .../aegisub_vs2008/aegisub_vs2008.vcproj | 56 -- .../aegisub_vs2008/delayload_perl_32.vsprops | 11 - aegisub/src/auto4_perl.cpp | 598 --------------- aegisub/src/auto4_perl.h | 245 ------ aegisub/src/auto4_perl_ass.cpp | 483 ------------ aegisub/src/auto4_perl_console.cpp | 244 ------ aegisub/src/auto4_perl_console.h | 94 --- aegisub/src/auto4_perl_dialogs.cpp | 72 -- aegisub/src/auto4_perl_factory.h | 67 -- aegisub/src/auto4_perl_script.cpp | 475 ------------ aegisub/src/auto4_perldata.inc | 122 --- aegisub/src/auto4_ruby.cpp | 717 ------------------ aegisub/src/auto4_ruby.h | 279 ------- aegisub/src/auto4_ruby_assfile.cpp | 439 ----------- aegisub/src/auto4_ruby_dialog.cpp | 596 --------------- aegisub/src/auto4_ruby_factory.h | 48 -- aegisub/src/config/config_windows0.h | 17 - 28 files changed, 5473 deletions(-) delete mode 100644 aegisub/automation/autoload/macro-1p-edgeblur.pl delete mode 100644 aegisub/automation/demos/k-replacer.rb delete mode 100644 aegisub/automation/demos/perl-console.pl delete mode 100644 aegisub/automation/include/Aegisub.pm delete mode 100644 aegisub/automation/include/Aegisub/PerlConsole.pm delete mode 100644 aegisub/automation/include/Aegisub/Progress.pm delete mode 100644 aegisub/automation/include/Aegisub/Script.pm delete mode 100644 aegisub/automation/include/Auto4Utils.pm delete mode 100644 aegisub/automation/include/karaoke.rb delete mode 100644 aegisub/automation/include/utils.rb delete mode 100644 aegisub/automation/v4-docs/perl-api.txt delete mode 100644 aegisub/build/aegisub_vs2008/delayload_perl_32.vsprops delete mode 100644 aegisub/src/auto4_perl.cpp delete mode 100644 aegisub/src/auto4_perl.h delete mode 100644 aegisub/src/auto4_perl_ass.cpp delete mode 100644 aegisub/src/auto4_perl_console.cpp delete mode 100644 aegisub/src/auto4_perl_console.h delete mode 100644 aegisub/src/auto4_perl_dialogs.cpp delete mode 100644 aegisub/src/auto4_perl_factory.h delete mode 100644 aegisub/src/auto4_perl_script.cpp delete mode 100644 aegisub/src/auto4_perldata.inc delete mode 100644 aegisub/src/auto4_ruby.cpp delete mode 100644 aegisub/src/auto4_ruby.h delete mode 100644 aegisub/src/auto4_ruby_assfile.cpp delete mode 100644 aegisub/src/auto4_ruby_dialog.cpp delete mode 100644 aegisub/src/auto4_ruby_factory.h diff --git a/aegisub/automation/autoload/macro-1p-edgeblur.pl b/aegisub/automation/autoload/macro-1p-edgeblur.pl deleted file mode 100644 index 57f4156d0..000000000 --- a/aegisub/automation/autoload/macro-1p-edgeblur.pl +++ /dev/null @@ -1,62 +0,0 @@ -#!/usr/bin/perl - -use warnings; -use strict; -use Aegisub; # don't forget this - -$script_name = "Add/remove edgeblur macro (Perl version)"; -$script_description = "A demo macro showing how to do simple macros in Auto4-Perl"; -$script_author = "Karl Blomster"; -$script_version = "1"; - - -# this is a line-by-line translation of the Lua macro of the same name. -sub add_edgeblur { - # get the arguments; they are all references (important later) - my ($subtitles, $selected_lines, $active_line) = @_; - - # loop over the selected lines (note the dereferencing) - foreach my $lineno ( @{$selected_lines} ) { - # $line now contains a reference to the line we're working on. - # Note that the "line" is actually a hash with the dialogue line fields as keys. - my $line = $subtitles->[$lineno]; - # Tack on {\be1} to the start of the "text" field... - $line->{"text"} = '{\\be1}' . $line->{"text"}; - # And write our $line back to the file. - $subtitles->[$lineno] = $line; - } - - # This ain't implemented yet :( - # Aegisub::Script::set_undo_point("Add edgeblur"); -} - - -# This routine is NOT a Lua translation and may therefore seem more perlish. :> -sub remove_edgeblur { - # same as above - my ($subtitles, $selected_lines, $active_line) = @_; - - foreach my $lineno ( @{$selected_lines} ) { - # Since we're only going to change the text field of the line, - # why bother copying the entire line? We copy only the text field instead. - # We could also do stuff directly on $subtitles->[$lineno]->{"text"} but - # that's too long to write and is also risky if you blow something up. - my $text = $subtitles->[$lineno]->{"text"}; - - # remove any \be1 tags contained in the first {} block - $text =~ s!^\{(.*?)\\be1(.*?)\}!\{${1}${2}\}!; - # if that leaves nothing in it, remove it - $text =~ s!^\{\}!!; - - # write back - $subtitles->[$lineno]->{"text"} = $text; - } - - # Still not implemented :/ - # Aegisub::Script::set_undo_point("Remove edgeblur"); -} - - -# Register macros with Aegisub -Aegisub::Script::register_macro("Add edgeblur (Perl)", "Adds \\be1 tags to all selected lines", \&add_edgeblur); -Aegisub::Script::register_macro("Remove edgeblur (Perl)", "Removes \\be1 tags from the start of all selected lines", \&remove_edgeblur); \ No newline at end of file diff --git a/aegisub/automation/demos/k-replacer.rb b/aegisub/automation/demos/k-replacer.rb deleted file mode 100644 index 2a539ac95..000000000 --- a/aegisub/automation/demos/k-replacer.rb +++ /dev/null @@ -1,62 +0,0 @@ -load 'karaoke.rb' -load 'utils.rb' - -include Aegisub - -$script_name = "simple k-replacer" -$script_description = "k-replacer test" -$script_author = "Pomyk" -$script_version = "1" - -register_macro("Simple k-replacer", "k-replacer macro", :k_replace_macro, nil) -register_filter("Simple k-replacer", "k-replacer filter", 100, :k_replace_filter, :k_replace_cfg) - - -def k_replace_macro(subs, sel, act) - - cfg = k_replace_cfg(subs, nil) - ok, opt = display_dialog(cfg, nil) - return if not ok # cancelled - - write_options(subs, {$script_name => opt}) - subs.each do |l| - k_replace(l, opt[:templ], opt[:strip]) if l[:class] == :dialogue && # replace if its dialogue - (opt[:style] =="" || l[:style] == opt[:style]) # and has the right style - end - return subs -end - -def k_replace_filter(subs, opt) - subs.each do |l| - k_replace(l, opt[:templ], opt[:strip]) if l[:class] == :dialogue && # replace if its dialogue - opt[:style] =="" || l[:style] == opt[:style] # and has the right style - end - return subs -end - -def k_replace_cfg(subs, opt) - styles = [] - subs.each { |l| # read style names - styles << l[:name] if l[:class] == :style - break if l[:class] == :dialogue - } - header_text = <<-head -Expressions are enclosed in % pairs. -Variables: - $start = Start-time of syllable (ms) - $end = End-time of syllable (ms) - $mid = Time midways through the syllable (ms) - $dur = Duration of syllable (cs) -Calculation example: - \\t($start,%$start+$dur*2%,\\fscx110) - \\t(%$start+$dur*2%,$end,\\fscx90) -head - opt ||= {} - cfg = ScriptCfg.new # helper class for building dialogs - cfg.header header_text, :x => 1, :width => 1 - cfg.edit :templ, "template", :text => opt[:templ] - cfg.dropdown :style, "Style", :items => styles, :value => opt[:style] - cfg.checkbox :strip, "", :label => "Strip tags?", :value => (opt[:strip] == "true" ? true : false) - cfg.to_ary # convert to array -end - diff --git a/aegisub/automation/demos/perl-console.pl b/aegisub/automation/demos/perl-console.pl deleted file mode 100644 index 910ad552a..000000000 --- a/aegisub/automation/demos/perl-console.pl +++ /dev/null @@ -1,16 +0,0 @@ -# Perl console script -# by Simone Cociancich -# This script simply call the registration function for the builtin perl console -# the perl console is chiefly intended as a development and debug tool - -use strict; -use warnings; - -Aegisub::Script::set_info( -'Perl console', -"\nThis script provides a console for messing with the perl engine \\^^/ -(if you break something don't complain >:)", -'ShB'); - -use Aegisub::PerlConsole; -register_console(); diff --git a/aegisub/automation/include/Aegisub.pm b/aegisub/automation/include/Aegisub.pm deleted file mode 100644 index 4eb97205f..000000000 --- a/aegisub/automation/include/Aegisub.pm +++ /dev/null @@ -1,41 +0,0 @@ -package Aegisub; -use Exporter 'import'; - -@EXPORT = qw( text_extents - log_fatal log_error log_warning log_hint log_debug log_trace log_message ); -@EXPORT_OK = qw( LOG_FATAL LOG_ERROR LOG_WARNING LOG_HINT LOG_DEBUG LOG_TRACE LOG_MESSAGE - LOG_WX - log warn ); - -# Constants -sub LOG_FATAL { 0 } -sub LOG_ERROR { 1 } -sub LOG_WARNING { 2 } -sub LOG_HINT { 3 } -sub LOG_DEBUG { 4 } -sub LOG_TRACE { 5 } -sub LOG_MESSAGE { 6 } - -sub LOG_WX { 8 } - -# Shortcut functions -sub log_fatal { Aegisub::log LOG_FATAL, @_; } -sub log_error { Aegisub::log LOG_ERROR, @_; } -sub log_warning { Aegisub::log LOG_WARNING, @_; } -sub log_hint { Aegisub::log LOG_HINT, @_; } -sub log_debug { Aegisub::log LOG_DEBUG, @_; } -sub log_trace { Aegisub::log LOG_TRACE, @_; } -sub log_message { Aegisub::log LOG_MESSAGE, @_; } - -# wxLog variety -sub wxlog { - if($_[0] =~ /^\d+$/) { - $_[0] |= 0x8; - } - else { - unshift @_, LOG_MESSAGE | LOG_WX; - } - Aegisub::log @_; -} - -1; diff --git a/aegisub/automation/include/Aegisub/PerlConsole.pm b/aegisub/automation/include/Aegisub/PerlConsole.pm deleted file mode 100644 index 4e849f063..000000000 --- a/aegisub/automation/include/Aegisub/PerlConsole.pm +++ /dev/null @@ -1,6 +0,0 @@ -package Aegisub::PerlConsole; -use Exporter 'import'; - -@EXPORT = qw( echo register_console ); - -1; diff --git a/aegisub/automation/include/Aegisub/Progress.pm b/aegisub/automation/include/Aegisub/Progress.pm deleted file mode 100644 index e99482c80..000000000 --- a/aegisub/automation/include/Aegisub/Progress.pm +++ /dev/null @@ -1,11 +0,0 @@ -package Aegisub::Progress; -use Exporter 'import'; - -@EXPORT = qw( set_progress set_task set_title is_cancelled ); -@EXPORT_OK = qw( set task title ); - -sub set { set_progress @_ } -sub task { set_task @_ } -sub title { set_title @_ } - -1; diff --git a/aegisub/automation/include/Aegisub/Script.pm b/aegisub/automation/include/Aegisub/Script.pm deleted file mode 100644 index 5a21b1b90..000000000 --- a/aegisub/automation/include/Aegisub/Script.pm +++ /dev/null @@ -1,6 +0,0 @@ -package Aegisub::Script; -use Exporter 'import'; - -@EXPORT = qw( register_macro set_info ); - -1; diff --git a/aegisub/automation/include/Auto4Utils.pm b/aegisub/automation/include/Auto4Utils.pm deleted file mode 100644 index 5ad78a26d..000000000 --- a/aegisub/automation/include/Auto4Utils.pm +++ /dev/null @@ -1,251 +0,0 @@ -#/usr/bin/perl - -######### -# -# Written by Karl Blomster (TheFluff) 2008. -# (OK, mostly just a translation of utils-auto4.lua.) -# -# This script is hereby given into the public domain. -# If that is not possible according to local laws, I, the author, hereby grant -# anyone the right to use this script for any purpose. -# -######### - -package Auto4Utils; -require Exporter; - -use warnings; -use strict; -use feature ":5.10"; -use utf8; # just to be safe -use POSIX (); # gah, we only need floor(), no need to import all of IEEE 1003.1 - - -# Export everything by default -our @ISA = qw(Exporter); -our @EXPORT = qw(extract_color alpha_from_style color_from_style HSV_to_RGB HSL_to_RGB interpolate_color interpolate_alpha - ass_color ass_alpha ass_style_color string_trim clamp interpolate); - - -# Given 3 integers R,G,B, returns ASS formatted &HBBGGRR& string -sub ass_color { - my ($r, $g, $b) = @_; - return(sprintf("&H%02X%02X%02X&", $b, $g, $r)); -} -# Perlier version of that: -# sub ass_color { return sprintf "&H%02X%02X%02X&", reverse } - # I don't think reverse reverses @_ by default, rats :( - -# Convert decimal alpha value to &H00& form -sub ass_alpha { - return(sprintf("&H%02X&", shift(@_))); -} - -# Given 4 integers R,G,B,A, returns a v4+ formatted style color string -# (note no terminating &) -sub ass_style_color { - my ($r, $g, $b, $a) = @_; - return(sprintf("&H%02X%02X%02X%02X", $a, $b, $g, $r)); -} - -# Tries its best to convert a string to 4 integers R,G,B,A. -# Returns them in that order if it succeeds, or undef if it can't do it. -# Useless in scalar context. -sub extract_color { - my $string = shift(@_); - - # This here thingie is a switch statement. Magic! - given ( $string ) { - # try v4+ style (ABGR) - when ( /\&H([[:xdigit:]]{2})([[:xdigit:]]{2})([[:xdigit:]]{2})([[:xdigit:]]{2})/i ) { - return(hex($4), hex($3), hex($2), hex($1)); - } - # color override? (BGR) - when ( /\&H([[:xdigit:]]{2})([[:xdigit:]]{2})([[:xdigit:]]{2})\&H/i ) { - return(0, hex($3), hex($2), hex($1)); - } - # alpha override? (A) - # (bug: bogus results with \c&H& with the first four zeros omitted) - when ( /\&H([[:xdigit:]]{2})\&/i ) { - return(hex($1), 0, 0, 0); - } - # try HTML format for laffs (RGB) - when ( /\#([[:xdigit:]]{2})([[:xdigit:]]{2})?([[:xdigit:]]{2})?/i ) { - return(0, (hex($2) or 0), (hex($2) or 0), (hex($3) or 0)); - } - default { - return(undef, undef, undef, undef); - } - } -} - -# Given a a style color string, returns the alpha part formatted as override -sub alpha_from_style { - my $color_string = shift(@_); - my ($r, $g, $b, $a) = extract_color($color_string); - return(ass_alpha($a or 0)); -} - -# Given a style color string, returns the color part formatted as override -sub color_from_style { - my $color_string = shift(@_); - my ($r, $g, $b, $a) = extract_color($color_string); - return(ass_color(($r or 0), ($g or 0), ($b or 0))); -} - - -# Converts 3 integers H, S, V (hue, saturation, value) to R, G, B -sub HSV_to_RGB { - my ($H, $S, $V) = @_; - my ($r, $g, $b); - - # saturation is zero, make grey - if ($S == 0) { - $r = $V * 255; - $r = clamp($r, 0, 255); - ($g, $b) = ($r, $r); - } - # else calculate color - else { - # calculate subvalues - $H = $H % 360; # put $h in range [0,360] - my $Hi = POSIX::floor($H/60); - my $f = $H/60 - $Hi; - my $p = $V * (1 - $S); - my $q = $V * (1 - $f * $S); - my $t = $V * (1 - (1 - $f) * $S); - - # do math based on hue index - if ($Hi == 0) { $r = $V*255; $g = $t*255; $b = $p*255; } - elsif ($Hi == 1) { $r = $q*255; $g = $V*255; $b = $p*255; } - elsif ($Hi == 2) { $r = $p*255; $g = $V*255; $b = $t*255; } - elsif ($Hi == 3) { $r = $p*255; $g = $q*255; $b = $V*255; } - elsif ($Hi == 4) { $r = $t*255; $g = $p*255; $b = $V*255; } - elsif ($Hi == 5) { $r = $V*255; $g = $p*255; $b = $q*255; } - # TODO: replace this with Aegisub::Script::debug_out() or whatever it is - else { warn("HSV_to_RGB: Hi got an unexpected value: $Hi"); } - } - - $r = POSIX::floor($r); - $g = POSIX::floor($g); - $b = POSIX::floor($b); - return($r, $g, $b); -} - - -# Converts 3 integers H, S, L (hue, saturation, luminance) to R, G, B -# NOTE: THE OUTPUT AND S,V INPUT IS IN THE RANGE [0,1]! -# Routine is best performed to "The HSL Song" by Diablo-D3 and the #darkhold idlers. -# The lyrics are as follows: -# I see a little silluetto of a man -# It's in color, its in color, can you convert to HSL? -# Cyan, yellow and magenta, very very outdated now -# Alvy Smith, Alvy Smith, Alvy Smith, Alvy Smith, Fiigaarrooo -# I'm just a poor boy, stuck with RGB -# (He's just a poor boy, from a poor colorspace, spare him his eyes from this monstrosity) -# -# Easy come, easy go, will you let me HSL? -# (No! We will not let you HSL!) -# Let him HSL! -# (No! We will not let you HSL!) -# Let him HSL! -# (No! We will not let you HSL!) -# Let me HSL! -# (Will not HSL!) -# Let me HSL! -# (Will not HSL!) -# Let me HSL! Let me HSL! -# (Never never never never never!) -# Let me HHHHHSSSSSLLLLL! -# (No no no no no no no!) -# -# [70's rock/bad humour segment ends here. We now return to your regularily scheduled Perl hacking...] -sub HSL_to_RGB { - my ($H, $S, $L) = @_; - my ($r, $g, $b, $Q); - - # make sure input is in range - $H = $H % 360; - $S = clamp($S, 0, 1); - $L = clamp($L, 0, 1); - - # simple case if saturation is 0, all grey - if ($S == 0) { - ($r, $g, $b) = ($L, $L, $L); - } - # more common case, saturated color - else { - if ($L < 0.5) { $Q = $L * (1 + $S); } - else { $Q = $L + $S - ($L * $S); } - - my $P = 2 * $L - $Q; - my $Hk = $H / 360; - - my ($Tr, $Tg, $Tb); - $Tg = $Hk; - if ($Hk < 1/3) { $Tr = $Hk + 1/3; $Tb = $Hk + 2/3; } - elsif ($Hk > 2/3) { $Tr = $Hk - 2/3; $Tb = $Hk - 1/3; } - else { $Tr = $Hk + 1/3; $Tb = $Hk - 1/3; } - - # anonymous subroutine required for closure reasons - my $get_component = sub { - my $T = shift(@_); - if ($T < 1/6) { return($P + (($Q - $P) * 6 * $T)) } - elsif (1/6 <= $T and $T < 1/2) { return($Q) } - elsif (1/2 <= $T and $T < 2/3) { return($P + (($Q - $P) * (2/3 - $T) * 6)) } - else { return($P) } - }; - - $r = $get_component->($Tr); - $g = $get_component->($Tg); - $b = $get_component->($Tb); - } - - return($r, $g, $b); -} - - -# Removes whitespace at the start and end of a string -# (will anyone ever use this in a perl program?) -sub string_trim { - my $string = shift(@_); - $string =~ s!^\s*(.+?)\s*$!$1!; - return($string); -} - - -# Clamp a numeric value to a range -sub clamp { - my ($val, $min, $max) = @_; - if ($val < $min) { return($min) } - elsif ($val > $max) { return($max) } - else { return($val) } -} - -# interpolate between two numbers -sub interpolate { - my ($pct, $min, $max) = @_; - if ($pct <= 0) { return($min) } - elsif ($pct >= 1) { return($max) } - else { return($pct * ($max - $min) + $min) } -} - -# interpolate between two color values (given as &HBBGGRR strings) -# returns string formatted with \c&H override format -sub interpolate_color { - my ($pct, $start, $end) = @_; - my ($r1, $g1, $b1) = extract_color($start); - my ($r2, $g2, $b2) = extract_color($end); - my ($r, $g, $b) = - (interpolate($pct, $r1, $r2), interpolate($pct, $g1, $g2), interpolate($pct, $b1, $b2)); - return(ass_color($r, $g, $b)); -} - -# interpolate between two alpha values (given as either override or part of style color strings) -# returns string formatted with \c&H override format -sub interpolate_alpha { - my ($pct, $start, $end) = @_; - my ($r1, $g1, $b1, $a1) = extract_color($start); - my ($r2, $g2, $b2, $a2) = extract_color($end); - return(ass_alpha(interpolate($pct, $a1, $a2))); -} \ No newline at end of file diff --git a/aegisub/automation/include/karaoke.rb b/aegisub/automation/include/karaoke.rb deleted file mode 100644 index 1840f9907..000000000 --- a/aegisub/automation/include/karaoke.rb +++ /dev/null @@ -1,68 +0,0 @@ -module Aegisub - - - # parsing karaoke line - # should work more or less like the lua version - # input: dialogue line with karaoke tags - # output: number of syllables in karaoke - def parse_karaoke(line) - return 0 if line[:class] != :dialogue - return line[:karaoke].size if line[:karaoke].class == Array - karaoke = [] - time = 0 - line[:text].scan(/(?:{.*?\\(K|k[fto]?)(\d+).*?}([^{]*))|({.*?})([^{]*)/) do |k| - if $1 # karaoke tag - ktag = $1 - kdur = $2.to_i - syl = Hash.new - syl[:start_time] = time - if ktag == 'kt' - time = kdur*10 - syl[:duration] = 0 - else - time += kdur*10 - syl[:duration] = kdur - end - syl[:end_time] = time - syl[:tag] = ktag - syl[:text] = $& - syl[:text_stripped] = $3 - karaoke << syl - else # no karaoke - append to the last syllable - tag = $4 - text = $5 - if not karaoke.empty? - karaoke.last[:text] << tag << text - karaoke.last[:text_stripped] << text if text and tag !~ /\\p\d/ # no drawings - end - end - end - line[:karaoke] = karaoke - return karaoke.size - end - - # replaces matched pattern in the line with an evaluated template - # input: line, template (string), strip (bool), pattern (regexp or string) - # output: line with karaoke effect - def k_replace(line, template, strip, pattern = /\\(:?K|k[fo]?\d+)/) # default pattern = any karaoke tag - return if parse_karaoke(line) == 0 - - res = "" - t = template.gsub(/\$(start|end|dur|mid|text|i|kind)/, '_\1') - _i = 0 - line[:karaoke].each do |s| - _start = s[:start_time] - _end = s[:end_time] - _dur = s[:duration] - _mid = _start + _dur*5 - _text = s[:text_stripped] - _kind = s[:tag] - ev = t.gsub(/(_(:?start|end|dur|mid|text|i|kind))/) { |m| eval($1).to_s } # evalute variables - ev.gsub!(/\%([^%]+)\%/) { |m| eval($1).to_s } # evaluate expressions - res << (strip ? "{" << ev << "}" << s[:text_stripped] : s[:text].gsub!(pattern, ev) ) - _i += 1 - end - line[:text] = res - end - -end diff --git a/aegisub/automation/include/utils.rb b/aegisub/automation/include/utils.rb deleted file mode 100644 index 2652955e5..000000000 --- a/aegisub/automation/include/utils.rb +++ /dev/null @@ -1,114 +0,0 @@ -#include Aegisub - -class Object - def deep_clone - Marshal.load(Marshal.dump(self)) - end -end - - - -module Aegisub - - class ScriptCfg - def initialize # constructor - @opt = [] - @x = 0 - @y = 0 - @labels = true - @width = 1 # TODO - @height = 1 - end - - private - def control(type, name, opt = {}) - @opt << {:class => type, :name => name, :x => @x, :y => @y, - :width => 1, :height => 1}.merge!(opt) - end - - # some meta-programming :] - def self.create_functions(*arr) - arr.each do |a| - class_eval(%Q[ - def #{a.to_s}(name, text, opt = {}) - if @labels; label text, opt; @x += 1; end - control "#{a.to_s}", name, opt - @y += 1 - @x = 0 - end - ]) - end - end - - public - create_functions *[:edit, :intedit, :floatedit, :textbox, - :dropdown, :checkbox, :color, :coloralpha, :alpha ] - - def no_labels; @labels = false; end - - def label(text, opt = {}) - control :label, text, opt.merge({:label => text}) - end - - def header(text, opt = {}) - label text, opt.merge!({:width => 2}) - @y += 1 - end - - def to_ary # conversion to array - @opt - end - - end - - # inserts lines with options into [Script Info] section - def write_options(subs, opt, sep = "~~") - subs.collect! do |l| - if l[:class] == :info - info = true - value = opt.delete(l[:key]) - l[:value] = value.instance_of?(Hash) ? value.to_a.flatten!.join(sep) : value.to_s if value - l - elsif info - r = [l] - opt.each do |key, val| - r << {:class => :info, :key => key, - :value => value.instance_of?(Hash) ? value.to_a.flatten!.join(sep) : value.to_s, - :section => "[Script Info]"} - end - info = false - r - else - l - end - end - end - - # returns a hash with options from [Script Info] section - def read_options(subs, name, sep = "~~") - opt = {} - subs.each { |l| opt[l[:key].to_sym] = l[:value] if l[:class] == :info } - n_sym = name.to_sym - if opt[n_sym] # parsing of script specific options - a = opt[n_sym].split(sep) - h = {} - (a.size/2).times { |j| h[a[2*j].to_sym] = a[2*j+1] } - opt[n_sym] = h - end - return opt - end - - def rgb_to_ssa(*c) - res = "&H" - c.reverse_each {|v| res << "%02X" % v} - res << "&" - return res - end - - def ssa_to_rgb(col) - res = [] - col.scan(/[0-9a-fA-F]{2}/) { res.unshift $1.to_i(16) } - res - end -end - diff --git a/aegisub/automation/v4-docs/perl-api.txt b/aegisub/automation/v4-docs/perl-api.txt deleted file mode 100644 index 4b12dd42f..000000000 --- a/aegisub/automation/v4-docs/perl-api.txt +++ /dev/null @@ -1,273 +0,0 @@ ------------------------------------- -Quick reference on Perl engine's API ------------------------------------- - -All the packages that form the perl interface to Aegisub are automatically -loaded, however none of their symbols are exported initially. If you want to -import them you can use the usual 'use' mechanism; if you call it without a -list of imports it will import more or less everything in your script's -package. Wether they are exported or not is indicated in the following -reference by <--EXPORTED--> (exported by default within a plain 'use' -statement) and <--EXPORTABLE--> (can be imported specifying them explicitely in -the 'use' statement) tags. Finally, <--NOT EXPORTABLE--> indicates symbols that -can't be exported through 'use'. - - -==================================== -package Aegisub - ------------------------------------- -Constants defined: - <--EXPORTABLE--> - -LOG_FATAL == 0 -LOG_ERROR == 1 -LOG_WARNING == 2 -LOG_HINT == 3 -LOG_DEBUG == 4 -LOG_TRACE == 5 -LOG_MESSAGE == 6 - Log levels, to be used with the 'log' function. - -LOG_WX == 8 - Flag to force logging through wxWidgets facilites. - ------------------------------------- -Subroutines defined: - <--EXPORTED--> - -text_extents STYLE, TEXT - Computes the metric for a string of text, based on a specific style. - Arguments: - STYLE The style to use, as a string or ref to a style line. - TEXT Text for which to compute the metrics. - Returns: - WIDTH The width of the text (if called in scalar context, only this is returned). - ASCENT The ascent, i.e. the distance from the baseline to the top of the letters. - DESCENT Descent, i.e. the distance from the baseline to the bottom. - EXTLEADING External leading, i.e. the distance between to lines of text. - -log_fatal LIST - ... -log_message LIST - These are shortcuts for 'log(LOG_FATAL, LIST)' to 'log(LOG_MESSAGE, LIST)' - (see below). - - <--EXPORTABLE--> - -log LEVEL, LIST -log LIST - Prints a log message inside the progress window, if LEVEL is less or equal - to the tracelevel set inside automation options. If called from outside a - callback (i.e. during script loading) prints through the wxWidgets logging - mechanism. 'log(LIST)' is equal to 'log(Aegisub::LOG_MESSAGE, LIST)'. The - short form is used whenever there are at least two arguments and the first - one cannot be read as an integer; it is always used when given only one - argument. This function is not exported by default (review man perlfunc to - understand why :). - - Arguments: - LEVEL The debug level, may be one of the following (the descriptions are - indicative): - 0 Fatal error, for vital errors; - 1 Error, for serious but not too much threatening errors; - 2 Warning, for something that's apparently going wrong; - 3 Hint, for indicating something peculiar is happening; - 4 Debug, for debugging! - 5 Trace, for really verbose debugging; - 6 Message, always printed. - If you OR one of these values with the flag LOG_WX the log message will - be delivered though wxWidgets regardless of wether there is a progress - window displayed (you won't normally need this feature, though). - LIST List of arguments to print. - -warn LIST - Prints a warning through the GUI log facilities (it is equivalent to - 'log(Aegisub::LOG_WARNING, LIST)'). It is automatically hooked to the - global 'warn' function during script execution, thus it is not exported by - default. - Arguments: - LIST List of arguments to print. - - <--NOT EXPORTABLE--> - -wxlog LEVEL, LIST -wxlog LIST - Similar to 'log', but with the LOG_WX flag implicitely set. This function - is top-secret. - - -==================================== -package Aegisub::PerlConsole ------------------------------------- -This package contains the perl console, a debug tool not intended for normal -use by normal users (it's not even enabled in release builds). They are shown -here for completeness. - ------------------------------------- -Subroutines defined: - <--EXPORTED--> - -echo LIST - Prints a list of arguments on the console, or on STDOUT if no console is - registered, a trailing \n is printed too. - Arguments: - LIST List of arguments to print. - -register_console NAME, DESC - Registers an instance of the console, as a macro. You don't want to know - any more because in fact you'll never have to do with this. >:) - Arguments: - NAME Set the name for the macro. (optional) - DESC Set the macro's description. (optional) - - -==================================== -package Aegisub::Progress ------------------------------------- -This package provides an interface to the progress window automatically showed -during the execution of a feature. Its functions are somewhat different to -those available in lua because of clarity, however aliases are given. - ------------------------------------- -Subroutines defined: - <--EXPORTED--> - -set_progress VALUE - Sets the value of the progress bar. It accepts values comprised in [0, 1] - OR (1, 100] (for instance, a value of 0.86 is equivalent to a value of 86: - they both represent '86%'). You should really always use values in the - range [0, 1] if you don't wanna be mocked by your friends and relatives - (and normally they're more immediately computable). - Arguments: - VALUE The value for the progress bar. - -set_task DESC - Sets the description for the current task inside progress window (just - below the progress bar). - Arguments: - DESC The description for the current task. - -set_title TITLE - Sets the title for the progress window (which is not actually the window's - title, but a flashier label below it). The default title is 'Executing ...' - (with the ellpsis possibly replaced by the feature's name). - Arguments: - TITLE The title to set. - -is_cancelled - Returns: A boolean indicating wether the cancel button on the progress - window where pressed in the near past. - - <--EXPORTABLE--> - -set VALUE - Synonym for 'set_progress(VALUE)'. - -task DESC - Synonym for 'set_desc(DESC)', - -title TITLE - Synonym for 'set_title(TITLE)'. - - -==================================== -package Aegisub::Script - ------------------------------------- -Subroutines defined: - <--EXPORTED--> - -register_macro NAME, DESC, PROC_SUB, VAL_SUB - Register a new macro. - Arguments: - NAME The name of the macro. - DESC A description for the macro. - PROC_SUB A ref to a subroutine to be used as the macro processing function - (see the callbacks section). Please, really use a reference and not - just the name of the sub, because of the script 'pacakging' described - below. - VAL_SUB A ref to a subroutine to be used as the macro validation function - (see callbacks)(optional, if not defined will be considered as always true). - -set_info NAME, DESC, AUTHOR, VERSION - You can set all of the script's info values with a call to this - function. (Otherwise you can set the corresponding predefined script - variables individually.) - Arguments: see the parts about script variables, anything is optional. - - -==================================== -package Aegisub::Script::pxxxxxxxx ------------------------------------- -Every script that's loaded gets its code evaluated inside a different package - -whose name is chosen at 'random' - whereas the perl interpreter is unique, so -all the scripts see the same global package, and can possibly access other -scripts' packages. Therefore is recommended to ALWAYS declare all of the -script's local variables with 'my', and of course to 'use strict' to check on -this. You can still declare another package for your script; the script's -predefined variables should be still visible from it without any change in the -code (they're declared as 'our'), however this is discouraged. - ------------------------------------- -Variables defined: - -$script_author - Holds the script author's name. Default is the user executing aegisub. - -$script_description - Holds a description for the script. Default is 'Perl script'. - -$script_name - Holds the script's name. Default is the script's filename. - -$script_version - Holds the script's version. Default is current aegisub version. - -$_script_path - The full path to the script's file. Any change to this variable is ignored - and overwritten. - -$_script_package - The full script package as a string. Any change to this variable is - currently ignored and overwritten, and may be so forever. - - ------------------------------------- -Callbacks definable: - -macro_processing_function LINES, SELECTED, ACTIVE - A function to be used as a callback for Aegisub::Script::register_macro(). - This function will be called when the user selects the corresponding macro - in the Automation menu. The first two arguments can be modified, and the - modifications will be reflected in the subtitles file. - Arguments: - LINES A reference to the list containing the subtitle file lines. - Each element of the list is a reference to a hash that represents a - single subtitle line. For the hash keys refer to lua documentation, - they are basically the same. - Example: - - my $lines = $_[0]; # DON'T shift @_ (unless you reconstruct it - # afterwards) or you'll break everything and - # your hard disk be erased >:) - # The first selected line's index - my $first = $_[1][0]; - # An entire line - my $l = $lines->[$first]; - # The text field of a dialogue line - my $text = $lines->[$first]->{"text"}; - - SELECTED A ref to an array of ints, showing the currently selected - lines in the file. - ACTIVE Index of the currently active line in the subtitle file (sic). - -macro_validation_function LINES, SELECTED, ACTIVE - A function to be used as a callback for Aegisub::Script::register_macro(). - This function will be called whenever the Automation menu is opened to - decide what macros are applicable to the current script. - Arguments: same as macro_processing_function; however any change to the - first two ones will be ignored upon function return. - Returns: - VALID A 'boolean' value to indicate if the macro is applicable to this - particular subtitles file. diff --git a/aegisub/build/aegisub_vs2008/aegisub_vs2008.vcproj b/aegisub/build/aegisub_vs2008/aegisub_vs2008.vcproj index 698e34031..937ae8207 100644 --- a/aegisub/build/aegisub_vs2008/aegisub_vs2008.vcproj +++ b/aegisub/build/aegisub_vs2008/aegisub_vs2008.vcproj @@ -563,62 +563,6 @@ > - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/aegisub/src/auto4_perl.cpp b/aegisub/src/auto4_perl.cpp deleted file mode 100644 index c3c89f7ba..000000000 --- a/aegisub/src/auto4_perl.cpp +++ /dev/null @@ -1,598 +0,0 @@ -// Copyright (c) 2008, Simone Cociancich -// All rights reserved. -// -// Redistribution and use in source and binary forms, with or without -// modification, are permitted provided that the following conditions are met: -// -// * Redistributions of source code must retain the above copyright notice, -// this list of conditions and the following disclaimer. -// * Redistributions in binary form must reproduce the above copyright notice, -// this list of conditions and the following disclaimer in the documentation -// and/or other materials provided with the distribution. -// * Neither the name of the Aegisub Group nor the names of its contributors -// may be used to endorse or promote products derived from this software -// without specific prior written permission. -// -// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE -// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -// CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -// SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -// INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -// CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -// ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -// POSSIBILITY OF SUCH DAMAGE. -// -// ----------------------------------------------------------------------------- -// -// AEGISUB -// -// Website: http://aegisub.cellosoft.com -// Contact: mailto:jiifurusu@gmail.com -// - - -#include "config.h" - -#ifdef WITH_PERL - - -#include "auto4_perl.h" -#include "auto4_perl_console.h" -#include "auto4_perl_factory.h" -#include "options.h" -#include "ass_style.h" - -#ifdef __VISUALC__ -#pragma warning(disable: 4800) -#pragma warning(disable: 4706) -#endif - -#define COLLECT_PV(buf, s, e) \ - buf = wxString(SvPV_nolen(ST(s)), pl2wx);\ - for(int ARG_i = s+1; ARG_i <= e; ARG_i++) {\ - buf << _T(" ") << wxString(SvPV_nolen(ST(ARG_i)), pl2wx);\ - } - - -namespace Automation4 { - - static PerlInterpreter *perl_interpreter = NULL; - -/////////////////////////////////// -// Perl -> C++ interface (XSUBS) -// - - /* package Aegisub */ - XS(perl_log) - { - wxTRACE_FUNC(Aegisub::log); - dXSARGS; - IV level = 6; - - int start = 0; - if(items >= 2 && SvIOK(ST(0))) { - level = SvIV(ST(0)); - start = 1; - } - wxString msg; - COLLECT_PV(msg, start, items-1); - PerlLog(level, msg); - } - - XS(perl_warning) - { - wxTRACE_FUNC(Aegisub::warn); - dXSARGS; - - if(items >= 1) { - wxString buf; - COLLECT_PV(buf, 0, items-1); - PerlLogWarning(buf); - } - } - - - XS(perl_text_extents) - { - wxTRACE_FUNC(Aegisub::text_extents); - dXSARGS; - - // Read the parameters - SV *style; wxString text; - if(items >= 2) { - // Enough of them - style = sv_mortalcopy(ST(0)); - text = wxString(SvPV_nolen(ST(1)), pl2wx); - } - else { - PerlLogWarning(_("Not enough parameters for Aegisub::text_extents()")); - // We needed 2 parameters at least! - XSRETURN_UNDEF; - } - - // Get the AssStyle - AssStyle *s; - if(SvROK(style)) { - // Create one from the hassh - s = PerlAss::MakeAssStyle((HV*)SvRV(style)); - } - else { - // It's the name of the style - wxString sn(SvPV_nolen(style), pl2wx); - // We get it from the AssFile::top - s = AssFile::top->GetStyle(sn); - /* TODO maybe: make it dig from the current hassh's styles */ - if(!s) - XSRETURN_UNDEF; - } - - // The return parameters - double width, height, descent, extlead; - // The actual calculation - if(!CalculateTextExtents(s, text, width, height, descent, extlead)) { - /* TODO: diagnose error */ - XSRETURN_EMPTY; - } - - // Returns - switch(GIMME_V) { - case G_SCALAR: - // Scalar context - XSRETURN_NV(width); - break; - default: - case G_ARRAY: - // List context - EXTEND(SP, 4); - XST_mNV(0, width); - XST_mNV(1, height); - XST_mNV(2, descent); - XST_mNV(3, extlead); - XSRETURN(4); - } - } - - /* Aegisub::Script */ - XS(perl_script_set_info) - { - wxTRACE_FUNC(Aegisub::Script::set_info); - dXSARGS; - - PerlScript *active = PerlScript::GetScript(); - if(active) { - // Update the object's vars - active->ReadVars(); - - // We want at most 4 parameters :P - if(items > 4) items = 4; - // Set script info vars - switch (items) { - case 4: - active->SetVersion(wxString(SvPV_nolen(ST(3)), pl2wx)); - case 3: - active->SetAuthor(wxString(SvPV_nolen(ST(2)), pl2wx)); - case 2: - active->SetDescription(wxString(SvPV_nolen(ST(1)), pl2wx)); - case 1: - active->SetName(wxString(SvPV_nolen(ST(0)), pl2wx)); - } - - // Update the package's vars - active->WriteVars(); - } - } - - XS(perl_script_register_macro) - { - wxTRACE_FUNC(Aegisub::Script::register_macro); - dXSARGS; - - PerlScript *active = PerlScript::GetScript(); - if(active && items >= 3) { - wxString name, description; - SV *proc_sub = NULL, *val_sub = NULL; - - if(items > 4) items = 4; - switch (items) { - case 4: - val_sub = sv_mortalcopy(ST(3)); - case 3: - proc_sub = sv_mortalcopy(ST(2)); - description = wxString(SvPV_nolen(ST(1)), pl2wx); - name = wxString(SvPV_nolen(ST(0)), pl2wx); - } - if(proc_sub) { - active->AddFeature(new PerlFeatureMacro(name, description, active, proc_sub, val_sub)); - XSRETURN_YES; - } - } - XSRETURN_UNDEF; - } - - XS(perl_script_set_undo_point) - { - wxTRACE_FUNC(Aegisub::Script::set_undo_point); - dXSARGS; - - wxString desc; - if(items > 0) - desc = wxString(SvPV_nolen(ST(0)), pl2wx); - else - desc = _T("Auto4Perl"); - - AssFile::top->FlagAsModified(desc); - - XSRETURN_YES; - } - - /* Aegisub::Progress */ - XS(perl_progress_set) - { - wxTRACE_FUNC(Aegisub::Progress::set_progress); - dXSARGS; - - PerlProgressSink *ps = PerlProgressSink::GetProgressSink(); - if(ps && items >= 1) { - NV pc = SvNV(ST(0)); - if(pc <= 1) pc *= 100; - if(pc > 100) pc = 100; - ps->SetProgress(pc); - wxWakeUpIdle(); - } - } - - XS(perl_progress_task) - { - wxTRACE_FUNC(Aegisub::Progress::set_task); - dXSARGS; - - PerlProgressSink *ps = PerlProgressSink::GetProgressSink(); - if(ps && items >= 1) { - wxString task; - COLLECT_PV(task, 0, items-1); - ps->SetTask(task); - wxWakeUpIdle(); - } - } - - XS(perl_progress_title) - { - wxTRACE_FUNC(Aegisub::Progress::set_title); - dXSARGS; - - PerlProgressSink *ps = PerlProgressSink::GetProgressSink(); - if(ps && items >= 1) { - wxString title; - COLLECT_PV(title, 0, items-1); - ps->SetTitle(title); - wxWakeUpIdle(); - } - } - - XS(perl_progress_cancelled) - { - wxTRACE_FUNC(Aegisub::Progress::is_cancelled); - dMARK; dAX; - - if(PerlProgressSink *ps = PerlProgressSink::GetProgressSink()) { - if(ps->IsCancelled()) XSRETURN_YES; - else XSRETURN_NO; - } - else { - XSRETURN_UNDEF; - } - } - - - /* Aegisub::PerlConsole */ - XS(perl_console_register) - { - wxTRACE_FUNC(Aegisub::PerlConsole::register_console); -#ifdef WITH_PERLCONSOLE - dXSARGS; - - PerlScript *script = PerlScript::GetScript(); - if(script) { - wxString name = _T("Perl console"); - wxString desc = _T("Show the Perl console"); - switch (items) { - case 2: - desc = wxString(SvPV_nolen(ST(1)), pl2wx); - case 1: - name = wxString(SvPV_nolen(ST(0)), pl2wx); - } - - if(!PerlConsole::GetConsole()) - // If there's no registered console - script->AddFeature(new PerlConsole(name, desc, script)); - } - XSRETURN_YES; -#else - dMARK; dAX; - PerlLogWarning(_("Tried to register PerlConsole, but support for it was disabled in this version.")); // Warning or Hint? - XSRETURN_UNDEF; -#endif - } - - XS(perl_console_echo) - { - wxTRACE_FUNC(Aegisub::PerlConsole::echo); - dXSARGS; - - // We should get some parameters - if(items == 0) return; - - // Join the params in a unique string :S - wxString buffer = wxString(SvPV_nolen(ST(0)), pl2wx); - for(int i = 1; i < items; i++) { - buffer << _T(" ") << wxString(SvPV_nolen(ST(i)), pl2wx); - } - -#ifdef WITH_PERLCONSOLE - if(PerlConsole::GetConsole()) { - // If there's a console echo to it - PerlConsole::Echo(buffer); - } - else -#endif - // Otherwise print on stdout - PerlIO_printf(PerlIO_stdout(), "%s\n", buffer.mb_str(wxConvLocal).data()); - // (through perl io system) - } - - /* Universal loader */ - EXTERN_C void boot_DynaLoader (pTHX_ CV* cv); - - /* XS registration */ - EXTERN_C void xs_perl_main(pTHX) - { - dXSUB_SYS; - - /* DynaLoader is a special case */ - newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__); - - // My XSUBS ^^ - newXS("Aegisub::log", perl_log, __FILE__); - newXS("Aegisub::warn", perl_warning, __FILE__); - newXS("Aegisub::text_extents", perl_text_extents, __FILE__); - newXS("Aegisub::Script::set_info", perl_script_set_info, __FILE__); - newXS("Aegisub::Script::register_macro", perl_script_register_macro, __FILE__); - newXS("Aegisub::Script::set_undo_point", perl_script_set_undo_point, __FILE__); - newXS("Aegisub::Progress::set_progress", perl_progress_set, __FILE__); - newXS("Aegisub::Progress::set_task", perl_progress_task, __FILE__); - newXS("Aegisub::Progress::set_title", perl_progress_title, __FILE__); - newXS("Aegisub::Progress::is_cancelled", perl_progress_cancelled, __FILE__); - newXS("Aegisub::PerlConsole::echo", perl_console_echo, __FILE__); - newXS("Aegisub::PerlConsole::register_console", perl_console_register, __FILE__); - } - - -///////////// -// PerlLog -// - void PerlLog(unsigned int level, const wxString &msg) - { - PerlProgressSink *ps = PerlProgressSink::GetProgressSink(); - if(!(level & 0x8) && ps) { - wxString _msg; - // Prepend a description of the log line - switch(level) { - case 0: _msg = _("Fatal error: "); - break; - case 1: _msg = _("Error: "); - break; - case 2: _msg = _("Warning: "); - break; - case 3: _msg = _("Hint: "); - break; - case 4: _msg = _("Debug: "); - break; - case 5: _msg = _("Trace: "); - } - // Print onto the progress window - ps->Log(level >= 6 ? -1 : level, _msg+msg+_T("\n")); - } - else { - level &= 0x7; - // Use the wx log functions - switch(level) { - case 0: wxLogFatalError(msg); - break; - case 1: wxLogError(msg); - break; - case 2: wxLogWarning(msg); - break; - case 3: wxLogVerbose(msg); - break; - case 4: wxLogDebug(msg); - break; - case 5: wxLogTrace(wxTRACE_AutoPerl, msg); - break; - default: - case 6: wxLogMessage(msg); - } - } - } - - -//////////////// -// PerlThread -// - - PerlThread::PerlThread(): - wxThread(wxTHREAD_JOINABLE) - { - pv = NULL; sv = NULL; - } - - PerlThread::PerlThread(const char *sub_name, I32 flags, bool type): - wxThread(wxTHREAD_JOINABLE) - { - wxTRACE_METH(PerlThread); - if(type == CALL) Call(sub_name, flags); - if(type == EVAL) Eval(sub_name, flags); - } - - PerlThread::PerlThread(SV *sv, I32 flags, bool type): - wxThread(wxTHREAD_JOINABLE) - { - wxTRACE_METH(PerlThread); - if(type == CALL) Call(sv, flags); - if(type == EVAL) Eval(sv, flags); - } - - wxThreadError PerlThread::launch() - { - wxThreadError e = Create(); - if(e != wxTHREAD_NO_ERROR) return e; - - switch(Options.AsInt(_T("Automation Thread Priority"))) { - case 2: SetPriority(10); - break; - case 1: SetPriority(30); - break; - default: - case 0: SetPriority(50); // fallback normal - } - - wxTRACE_RET(PerlThread); - return Run(); - } - - wxThreadError PerlThread::Call(const char *sub_name, I32 _flags) - { - type = CALL; pv = sub_name; flags = _flags; - wxLogTrace(wxTRACE_AutoPerl, _T("type = CALL, pv = '%s', flags = %u"), wxString(pv, pl2wx).c_str(), flags); - return launch(); - } - wxThreadError PerlThread::Call(SV *_sv, I32 _flags) - { - type = CALL; sv = _sv; flags = _flags; - wxLogTrace(wxTRACE_AutoPerl, _T("type = CALL, sv = %p, flags = %u"), sv, flags); - return launch(); - } - - wxThreadError PerlThread::Eval(const char* p, I32 croak_on_error) - { - type = EVAL; pv = p; flags = croak_on_error; - wxLogTrace(wxTRACE_AutoPerl, _T("type = EVAL, pv = '%s', flags = %u"), wxString(pv, pl2wx).c_str(), flags); - return launch(); - } - wxThreadError PerlThread::Eval(SV* _sv, I32 _flags) - { - type = EVAL; sv = _sv; flags = _flags; - wxLogTrace(wxTRACE_AutoPerl, _T("type = EVAL, sv = %p, flags = %u"), sv, flags); - return launch(); - } - - wxThread::ExitCode PerlThread::Entry() - { - wxTRACE_METH(Entry); - - PerlProgressSink *ps; - if(ps = PerlProgressSink::GetProgressSink()) { - // If there's a progress sink... - while(!ps->has_inited); - // ...wait for it to have inited - } - - PERL_SET_CONTEXT(perl_interpreter); - ExitCode ec = NULL; - switch(type) { - case CALL: - if(sv) ec = (ExitCode)((size_t)call_sv(sv, flags)); - else if(pv) ec = (ExitCode)((size_t)call_pv(pv, flags)); - break; - case EVAL: - if(sv) ec = (ExitCode)((size_t)eval_sv(sv, flags)); - else if(pv) ec = (ExitCode)((size_t)eval_pv(pv, flags)); - } - - if(SvTRUE(ERRSV)) { - // Log $@ in case of error - PerlLogError(wxString(SvPV_nolen(ERRSV), pl2wx)); - } - - if(ps) { - ps->script_finished = true; - wxWakeUpIdle(); - } - - wxTRACE_RET(Entry); - return ec; - } - - -/////////////////////// -// PerlScriptFactory -// - - PerlScriptFactory::PerlScriptFactory() - { -#ifdef WXTRACE_AUTOPERL - // Add tracing of perl engine operations - wxLog::AddTraceMask(wxTRACE_AutoPerl); -#endif - - // Script engine properties - loaded = false; - engine_name = _T("Perl"); - filename_pattern = _T("*") _T(PERL_SCRIPT_EXTENSION); - } - - void PerlScriptFactory::RegisterFactory() - { - // On Visual Studio, first check if the dll is available - // This needs to be done because it is set to delay loading of this dll -#ifdef __VISUALC__ - HMODULE dll = LoadLibrary(_T("perl510.dll")); - if (!dll) return; - FreeLibrary(dll); -#endif - - // Perl interpreter initialization (ONE FOR ALL THE SCRIPTS) - int argc = 3; - char *argv[3] = { "aegisub", "-e", "0" }; - char** env = NULL; - char **argv2 = (char**) argv; // VC++ wants this °_° - PERL_SYS_INIT3(&argc,&argv2,&env); - parser = perl_alloc(); - perl_construct(parser); - perl_parse(parser, xs_perl_main, - argc, argv, - NULL); - //free(argv); - // (That was pretty magic o_O) - - // Let's register the perl script factory \o/ - perl_interpreter = parser; - Register(this); - loaded = true; - } - - PerlScriptFactory::~PerlScriptFactory() - { - // Perl interpreter deinitialization - if (loaded) { - perl_destruct(parser); - perl_free(parser); - PERL_SYS_TERM(); - } - } - - Script* PerlScriptFactory::Produce(const wxString &filename) const - { - if(filename.EndsWith(_T(PERL_SCRIPT_EXTENSION))) { - return new PerlScript(filename); - } - else { - return 0; - } - } -}; - - -#endif //WITH_PERL diff --git a/aegisub/src/auto4_perl.h b/aegisub/src/auto4_perl.h deleted file mode 100644 index 704c2ab4e..000000000 --- a/aegisub/src/auto4_perl.h +++ /dev/null @@ -1,245 +0,0 @@ -// Copyright (c) 2008, Simone Cociancich -// All rights reserved. -// -// Redistribution and use in source and binary forms, with or without -// modification, are permitted provided that the following conditions are met: -// -// * Redistributions of source code must retain the above copyright notice, -// this list of conditions and the following disclaimer. -// * Redistributions in binary form must reproduce the above copyright notice, -// this list of conditions and the following disclaimer in the documentation -// and/or other materials provided with the distribution. -// * Neither the name of the Aegisub Group nor the names of its contributors -// may be used to endorse or promote products derived from this software -// without specific prior written permission. -// -// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE -// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -// CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -// SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -// INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -// CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -// ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -// POSSIBILITY OF SUCH DAMAGE. -// -// ----------------------------------------------------------------------------- -// -// AEGISUB -// -// Website: http://aegisub.cellosoft.com -// Contact: mailto:jiifurusu@gmail.com -// - - -#pragma once -#ifndef _AUTO4_PERL_H -#define _AUTO4_PERL_H - - -#include "auto4_base.h" -#include -#include - -#include "ass_file.h" - -#undef _ -#include -#include -#include - -#include "auto4_perldata.inc" // Perl variables manipulation macros -#undef bool - -// the fucking perl.h redefines _() -.- -#undef _ -#define _(s) wxGetTranslation(_T(s)) - - -// String conversions between wxWidgets and Perl -#define wx2pl wxConvUTF8 -#define pl2wx wxConvUTF8 - - -#define PERL_SCRIPT_EXTENSION ".pl" /* TODO maybe: make it multi-extension */ - - -// Debug support -/* define the following to activate tracing for the perl engine */ -#define WXTRACE_AUTOPERL -#define wxTRACE_AutoPerl _T("auto4_perl") - -#define wxTRACE_METH(name) \ - wxLogTrace(wxTRACE_AutoPerl, _T("\t=== %p::%s() ==="), this, _T(#name)) - -#define wxTRACE_FUNC(name) \ - wxLogTrace(wxTRACE_AutoPerl, _T("\t=== %s() ==="), _T(#name)) - -#define wxTRACE_RET(name) \ - wxLogTrace(wxTRACE_AutoPerl, _T("\t___ %s() returned ___"), _T(#name)) - - -namespace Automation4 { - - -///////////// -// PerlLog -// -#define LOG_FATAL 0 -#define LOG_ERROR 1 -#define LOG_WARNING 2 -#define LOG_HINT 3 -#define LOG_DEBUG 4 -#define LOG_TRACE 5 -#define LOG_MESSAGE 6 - -#define LOG_WX 8 - -#define PerlLogFatal(str) PerlLog(LOG_FATAL, str) -#define PerlLogFatalError(str) PerlLog(LOG_FATAL, str) -#define PerlLogError(str) PerlLog(LOG_ERROR, str) -#define PerlLogWarning(str) PerlLog(LOG_WARNING, str) -#define PerlLogHint(str) PerlLog(LOG_HINT, str) -#define PerlLogVerbose(str) PerlLog(LOG_HINT, str) -#define PerlLogDebug(str) PerlLog(LOG_DEBUG, str) -#define PerlLogTrace(str) PerlLog(LOG_TRACE, str) -#define PerlLogMessage(str) PerlLog(LOG_MESSAGE, str) - - void PerlLog(unsigned int level, const wxString &msg); - - -//////////////// -// PerlThread -// - class PerlThread : public wxThread { - private: - const char *pv; - SV *sv; - I32 flags; - - bool type; - - wxThreadError launch(); - - public: - enum { EVAL = 0, CALL = 1 }; - - PerlThread(); - PerlThread(const char *sub_name, I32 flags, bool type = CALL); - PerlThread(SV *sv, I32 flags, bool type = CALL); - - wxThreadError Call(const char *sub_name, I32 flags); - wxThreadError Call(SV *sv, I32 flags); - wxThreadError Eval(const char* p, I32 croak_on_error); - wxThreadError Eval(SV* sv, I32 flags); - - virtual ExitCode Entry(); - }; - - -/////////////////// -// Script object -// - class PerlScript : public Script { - private: - static PerlScript *active; // The active script (at any given time) - - AV *inc_saved; - wxString package; // Every script resides in a package named at random - - bool reload; // Automatically reload if source file has changed - time_t mtime; // The mtime of the loaded source file - - void load(); // It doas all the script initialization - void unload(); // It does all the script disposing - - static void activate(PerlScript *script); // Set the active script - static void deactivate(); // Unset the active script - - public: - PerlScript(const wxString &filename); - virtual ~PerlScript(); - static PerlScript *GetScript() { return active; } // Query the value of the active script - - virtual void Reload(); // Reloading of a loaded script - - void Activate() { activate(this); } // Set the script as active - void Deactivate() const { deactivate(); } // Unset the active script - - /* TODO maybe: move to tied scalars */ - void ReadVars(); // Sync the script's vars from perl package to script object - void WriteVars() const; // Sync the script's vars from script object to perl package - - void AddFeature(Feature *feature); - void DeleteFeature(Feature *feature); - - const wxString& GetPackage() const { return package; } // The perl package containing script code - void SetName(const wxString &str) { name = str; } - void SetDescription(const wxString &str) { description = str; } - void SetAuthor(const wxString &str) { author = str; } - void SetVersion(const wxString &str) { version = str; } - }; - - -////////////////// -// Macro object -// - class PerlFeatureMacro : public FeatureMacro { - private: - SV *processing_sub; // May be reference or name of sub - SV *validation_sub; // here too - - protected: - PerlScript *script; // The owner script - - public: - PerlFeatureMacro(const wxString &name, const wxString &description, PerlScript *perl_script, SV *proc_sub, SV *val_sub); - virtual ~PerlFeatureMacro(); - - virtual bool Validate(AssFile *subs, const std::vector &selected, int active); - virtual void Process(AssFile *subs, std::vector &selected, int active, wxWindow * const progress_parent); - }; - - -////////////////////// -// PerlProgressSink -// - class PerlProgressSink : public ProgressSink { - private: - static PerlProgressSink *sink; - public: - PerlProgressSink(wxWindow *parent, const wxString &title = _T("...")); - ~PerlProgressSink(); - static PerlProgressSink *GetProgressSink() { return sink; } - - bool IsCancelled() const { return cancelled; } - void Log(int level, const wxString &message) { if(level <= trace_level) AddDebugOutput(message); } - }; - - -/////////////////////////////////////////////////// -// Conversion between aegisub data and perl data -// - class PerlAss { - private: - - public: - static wxString GetEntryClass(AssEntry *entry); - - static HV *MakeHasshEntry(AssEntry *entry); - static HV *MakeHasshStyle(AssStyle *style); - static HV *MakeHasshDialogue(AssDialogue *diag); - static AV *MakeHasshLines(AV *lines, AssFile *ass); - - static AssEntry *MakeAssEntry(HV *entry); - static AssStyle *MakeAssStyle(HV *style); - static AssDialogue *MakeAssDialogue(HV *diag); - static AssFile *MakeAssLines(AssFile *ass, AV *lines); - }; - -}; - - -#endif diff --git a/aegisub/src/auto4_perl_ass.cpp b/aegisub/src/auto4_perl_ass.cpp deleted file mode 100644 index 42d528909..000000000 --- a/aegisub/src/auto4_perl_ass.cpp +++ /dev/null @@ -1,483 +0,0 @@ -// Copyright (c) 2008, Simone Cociancich -// All rights reserved. -// -// Redistribution and use in source and binary forms, with or without -// modification, are permitted provided that the following conditions are met: -// -// * Redistributions of source code must retain the above copyright notice, -// this list of conditions and the following disclaimer. -// * Redistributions in binary form must reproduce the above copyright notice, -// this list of conditions and the following disclaimer in the documentation -// and/or other materials provided with the distribution. -// * Neither the name of the Aegisub Group nor the names of its contributors -// may be used to endorse or promote products derived from this software -// without specific prior written permission. -// -// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE -// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -// CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -// SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -// INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -// CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -// ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -// POSSIBILITY OF SUCH DAMAGE. -// -// ----------------------------------------------------------------------------- -// -// AEGISUB -// -// Website: http://aegisub.cellosoft.com -// Contact: mailto:jiifurusu@gmail.com -// - - -#include "config.h" - -#ifdef WITH_PERL - - -#include "auto4_perl.h" -#include "ass_file.h" -#include "ass_entry.h" -#include "ass_style.h" -#include "ass_dialogue.h" -#include "ass_attachment.h" - - -// Disable warning -#ifdef __VISUALC__ -#pragma warning(disable: 4800) -#endif - -// For wxString::Trim -#define right true -#define left false - - -#define HASSH_BASIC_INIT(ae, he) \ - HV_TOUCH(he, "raw", 3)\ - HV_STORE(newSVpv(ae->GetEntryData().mb_str(wx2pl), 0));\ - HV_TOUCH(he, "section", 7)\ - HV_STORE(newSVpv(ae->group.mb_str(wx2pl), 0));\ - wxString he ## _class = GetEntryClass(ae);\ - HV_TOUCH(he, "class", 5)\ - HV_STORE(newSVpv(he ## _class.mb_str(wx2pl), 0)) - -#define ASS_BASIC_INIT(he, ae) \ - HV_FETCH(he, "raw", 3)\ - ae->SetEntryData(wxString(SvPV_nolen(HV_VAL), pl2wx));\ - HV_FETCH(he, "section", 7)\ - ae->group = wxString(SvPV_nolen(HV_VAL), pl2wx) - - -namespace Automation4 { - - wxString PerlAss::GetEntryClass(AssEntry *entry) - { - switch(entry->GetType()) { - case ENTRY_DIALOGUE: return _T("dialogue"); - case ENTRY_STYLE: - return _T("style"); - /* TODO: add stylex recognition */ - break; - case ENTRY_ATTACHMENT: return _T("attachment"); - default: - case ENTRY_BASE: - wxString data(entry->GetEntryData()); - if(data.Trim(left).StartsWith(_T(";"))) return _T("comment"); - else { - if(entry->group == _T("[Script Info]") && data.Matches(_T("*:*"))) return _T("info"); - if(data == entry->group) return _T("head"); - if(data.StartsWith(_T("Format:"))) return _T("format"); - if(data.IsEmpty()) return _T("clear"); - } - } - - // Fallback - return _T("unknown"); - } - - - HV *PerlAss::MakeHasshEntry(AssEntry *e) - { - switch(e->GetType()) { - case ENTRY_DIALOGUE: - return MakeHasshDialogue(AssEntry::GetAsDialogue(e)); - - case ENTRY_STYLE: - return MakeHasshStyle(AssEntry::GetAsStyle(e)); - - case ENTRY_ATTACHMENT: - - default: - case ENTRY_BASE: - dHV; - HV *entry = newHV(); - HASSH_BASIC_INIT(e, entry); - - if(entry_class == _T("info")) { - // Info - HV_TOUCH(entry, "key", 3) { - wxString _text = e->GetEntryData().BeforeFirst(_T(':')).Strip(wxString::both); - HV_STORE(newSVpv(_text.mb_str(wx2pl), 0)); - } - - HV_TOUCH(entry, "value", 5) { - wxString _text = e->GetEntryData().AfterFirst(_T(':')).Strip(wxString::both); - HV_STORE(newSVpv(_text.mb_str(wx2pl), 0)); - } - } - else if(entry_class == _T("format")) { - // Format °_° - HV_TOUCH(entry, "fields", 6) { - AV *fields_av = newAV(); - HV_STORE(newRV_noinc((SV*)fields_av)); - for(wxString fields_buf = e->GetEntryData().AfterFirst(_T(':')).Trim(left); - !fields_buf.IsEmpty(); - fields_buf = fields_buf.AfterFirst(_T(',')).Trim(left)) { - av_push(fields_av, newSVpv(fields_buf.BeforeFirst(_T(',')).Trim(right).mb_str(wx2pl), 0)); - } - } - } - else if(entry_class == _T("comment")) { - // Comment - HV_TOUCH(entry, "text", 4) { - wxString _text = e->GetEntryData().AfterFirst(_T(';')); - HV_STORE(newSVpv(_text.mb_str(wx2pl), 0)); - } - } - return entry; - } - } - - HV *PerlAss::MakeHasshStyle(AssStyle *s) - { - dHV; - - // Create new empty hash - HV *style = newHV(); - - // Add fields - HASSH_BASIC_INIT(s, style); - - HV_TOUCH(style, "name", 4) - HV_STORE(newSVpv(s->name.mb_str(wx2pl), 0)); - - HV_TOUCH(style, "font", 4) - HV_STORE(newSVpv(s->font.mb_str(wx2pl), 0)); - - HV_FAS(style, "fontsize", 8, nv, s->fontsize); - - HV_TOUCH(style, "color1", 6) - HV_STORE(newSVpv(s->primary.GetASSFormatted(true).mb_str(wx2pl), 0)); - HV_TOUCH(style, "color2", 6) - HV_STORE(newSVpv(s->secondary.GetASSFormatted(true).mb_str(wx2pl), 0)); - HV_TOUCH(style, "color3", 6) - HV_STORE(newSVpv(s->outline.GetASSFormatted(true).mb_str(wx2pl), 0)); - HV_TOUCH(style, "color4", 6) - HV_STORE(newSVpv(s->shadow.GetASSFormatted(true).mb_str(wx2pl), 0)); - - HV_TOUCH(style, "bold", 4) HV_STORE(newSViv(s->bold)); - - HV_FAS(style, "italic", 6, iv, s->italic); - HV_FAS(style, "underline", 9, iv, s->underline); - HV_FAS(style, "strikeout", 9, iv, s->strikeout); - - HV_FAS(style, "scale_x", 7, nv, s->scalex); - HV_FAS(style, "scale_y", 7, nv, s->scaley); - - HV_FAS(style, "spacing", 7, nv, s->spacing); - - HV_FAS(style, "angle", 5, nv, s->angle); - - HV_FAS(style, "borderstyle", 11, iv, s->borderstyle); - - HV_FAS(style, "outline", 7, nv, s->outline_w); - - HV_FAS(style, "shadow", 6, nv, s->shadow_w); - - HV_FAS(style, "align", 5, iv, s->alignment); - - HV_FAS(style, "margin_l", 8, iv, s->Margin[0]); - HV_FAS(style, "margin_r", 8, iv, s->Margin[1]); - HV_FAS(style, "margin_t", 8, iv, s->Margin[2]); - HV_FAS(style, "margin_b", 8, iv, s->Margin[3]); - - HV_FAS(style, "encoding", 8, iv, s->encoding); - HV_FAS(style, "relative_to", 11, iv, s->relativeTo); - - // Return the hassh style - return style; - } - - HV *PerlAss::MakeHasshDialogue(AssDialogue *d) - { - dHV; - - // Create new hash - HV *diag = newHV(); - - // Copy the values from the AssDialogue - HASSH_BASIC_INIT(d, diag); - - HV_FAS(diag, "comment", 7, iv, d->Comment); - - HV_FAS(diag, "layer", 5, iv, d->Layer); - - HV_FAS(diag, "start_time", 10, iv, d->Start.GetMS()); - HV_FAS(diag, "end_time", 8, iv, d->End.GetMS()); - - HV_TOUCH(diag, "style", 5) - HV_STORE(newSVpv(d->Style.mb_str(wx2pl), 0)); - - HV_TOUCH(diag, "actor", 5) - HV_STORE(newSVpv(d->Actor.mb_str(wx2pl), 0)); - - HV_FAS(diag, "margin_l", 8, iv, d->Margin[0]); - HV_FAS(diag, "margin_r", 8, iv, d->Margin[1]); - HV_FAS(diag, "margin_t", 8, iv, d->Margin[2]); - HV_FAS(diag, "margin_b", 8, iv, d->Margin[3]); - - HV_TOUCH(diag, "effect", 6) - HV_STORE(newSVpv(d->Effect.mb_str(wx2pl), 0)); - - HV_TOUCH(diag, "text", 4) - HV_STORE(newSVpv(d->Text.mb_str(wx2pl), 0)); - - // Return the dialogue - return diag; - } - - /* TODO: report progress */ - AV *PerlAss::MakeHasshLines(AV *lines, AssFile *ass) - { - if(!lines) { - lines = newAV(); - } - - dAV; - I32 i = 0; I32 lines_len = av_len(lines); - for(std::list::iterator it = ass->Line.begin(); it != ass->Line.end(); it++) { - if(i <= lines_len && av_exists(lines, i)) - av_delete(lines, i, G_DISCARD); - AV_TOUCH(lines, i++) - AV_STORE(newRV_noinc((SV*)MakeHasshEntry(*it))); - } - for(; i <= lines_len; i++) { - if(av_exists(lines, i)) - av_delete(lines, i, G_DISCARD); - } - - return lines; - } - - - AssEntry *PerlAss::MakeAssEntry(HV *entry) - { - dHV; - - if(!entry) { - // Create an empty line, if NULL - entry = newHV(); - } - - // The fallback class - wxString cl(_T("unknown")); - // Let's get the actual class of the hassh - HV_FETCH(entry, "class", 5) - cl = wxString(SvPV_nolen(HV_VAL), pl2wx); - - // We trust the value of entry{class} - if(cl == _T("dialogue")) { - // It seems to be a dialogue, let's call the specialized function - return MakeAssDialogue(entry); - } - else if(cl == _T("style")) { - // It seems to be a style, let's call the specialized function - return MakeAssStyle(entry); - } - else if(cl == _T("attachment")) { - /* TODO */ - return NULL; - } - else { - // A base entry - AssEntry *e = new AssEntry(); - - ASS_BASIC_INIT(entry, e); - - if(cl == _T("info")) { - wxString key, value; - HV_FETCH(entry, "key", 3) { - key = wxString(SvPV_nolen(HV_VAL), pl2wx); - HV_FETCH(entry, "value", 5) { - value = wxString(SvPV_nolen(HV_VAL), pl2wx); - e->SetEntryData(key + _T(": ") + value); - } - } - } - // Not necessary, format customization isn't even supported by aegi (atm? °_°) - /*else if(cl == _T("format")) { - HV_FETCH(entry, "fields", 6) { - AV *fields = (AV*)SvRV(HV_VAL); - for(int i = 0; i < av_len(fields); i++) { - SV ** field = av_fetch(fields, i, 0); - if(field) { - wxString field(SvPV_nolen(*field), pl2wx); - } - } - } - }*/ - else if(cl == _T("comment")) { - HV_FETCH(entry, "text", 4) { - e->SetEntryData(_T(";") + wxString(SvPV_nolen(HV_VAL), pl2wx)); - } - } - return e; - } - } - - AssStyle *PerlAss::MakeAssStyle(HV *style) - { - dHV; - - // Create a default style - AssStyle *s = new AssStyle(); - - // Fill it with the values from the hassh - ASS_BASIC_INIT(style, s); - - HV_FETCH(style, "name", 4) - s->name = wxString(SvPV_nolen(HV_VAL), pl2wx); - - HV_FETCH(style, "font", 4) - s->font = wxString(SvPV_nolen(HV_VAL), pl2wx); - - HV_FAA(style, "fontsize", 8, NV, s->fontsize); - - HV_FETCH(style, "color1", 6) - s->primary.Parse(wxString(SvPV_nolen(HV_VAL), pl2wx)); - HV_FETCH(style, "color2", 6) - s->secondary.Parse(wxString(SvPV_nolen(HV_VAL), pl2wx)); - HV_FETCH(style, "color3", 6) - s->outline.Parse(wxString(SvPV_nolen(HV_VAL), pl2wx)); - HV_FETCH(style, "color4", 6) - s->shadow.Parse(wxString(SvPV_nolen(HV_VAL), pl2wx)); - - HV_FAA(style, "bold", 4, IV, s->bold); - - HV_FAA(style, "italic", 6, IV, s->italic); - HV_FAA(style, "underline", 9, IV, s->underline); - HV_FAA(style, "strikeout", 9, IV, s->strikeout); - - HV_FAA(style, "scale_x", 7, NV, s->scalex); - HV_FAA(style, "scale_y", 7, NV, s->scaley); - - HV_FAA(style, "spacing", 7, NV, s->spacing); - - HV_FAA(style, "angle", 5, NV, s->angle); - - HV_FAA(style, "borderstyle", 11, IV, s->borderstyle); - - HV_FAA(style, "outline", 7, NV, s->outline_w); - - HV_FAA(style, "shadow", 6, NV, s->shadow_w); - - HV_FAA(style, "align", 5, IV, s->alignment); - - HV_FAA(style, "margin_l", 8, IV, s->Margin[0]); - HV_FAA(style, "margin_r", 8, IV, s->Margin[1]); - HV_FAA(style, "margin_t", 8, IV, s->Margin[2]); - HV_FAA(style, "margin_b", 8, IV, s->Margin[3]); - - HV_FAA(style, "encoding", 8, IV, s->encoding); - HV_FAA(style, "relative_to", 11, IV, s->relativeTo); - - // Return the style - return s; - } - - AssDialogue *PerlAss::MakeAssDialogue(HV *diag) - { - dHV; - - // Create a default dialogue - AssDialogue *d = new AssDialogue(); - - ASS_BASIC_INIT(diag, d); - - HV_FAA(diag, "comment", 7, IV, d->Comment); - - HV_FAA(diag, "layer", 5, IV, d->Layer); - - HV_FETCH(diag, "start_time", 10) - d->Start.SetMS(SvIV(HV_VAL)); - HV_FETCH(diag, "end_time", 8) - d->End.SetMS(SvIV(HV_VAL)); - - HV_FETCH(diag, "style", 5) - d->Style = wxString(SvPV_nolen(HV_VAL), pl2wx); - - HV_FETCH(diag, "actor", 5) - d->Actor = wxString(SvPV_nolen(HV_VAL), pl2wx); - - HV_FAA(diag, "margin_l", 8, IV, d->Margin[0]); - HV_FAA(diag, "margin_r", 8, IV, d->Margin[1]); - HV_FAA(diag, "margin_t", 8, IV, d->Margin[2]); - HV_FAA(diag, "margin_b", 8, IV, d->Margin[3]); - - HV_FETCH(diag, "effect", 6) - d->Effect = wxString(SvPV_nolen(HV_VAL), pl2wx); - - HV_FETCH(diag, "text", 4) - d->Text = wxString(SvPV_nolen(HV_VAL), pl2wx); - - // Return the dialogue - return d; - } - - /* TODO: report progress */ - AssFile *PerlAss::MakeAssLines(AssFile *ass, AV *lines) - { - if(!ass) { - /* TODO: create new AssFile if NULL */ - return NULL; - } - - // There may be a progress sink to report to - PerlProgressSink *ps = PerlProgressSink::GetProgressSink(); - - dAV; - std::list::iterator it = ass->Line.begin(); - I32 len = av_len(lines); - for(I32 i = 0; i <= len; i++) { - if(!av_exists(lines, i)) continue; - if(i < (I32)ass->Line.size()) { - if(*it) delete *it; - AV_FETCH(lines, i) - *it++ = MakeAssEntry((HV*)SvRV(AV_VAL)); - } - else { - AV_FETCH(lines, i) - ass->Line.push_back(MakeAssEntry((HV*)SvRV(AV_VAL))); - } - - // Report progress - if(ps) ps->SetProgress((i+1)/(len+1) * 100); - } - - for(; it != ass->Line.end();) { - it = ass->Line.erase(it); - } - - return ass; - } - - -}; - - -#endif //WITH_PERL diff --git a/aegisub/src/auto4_perl_console.cpp b/aegisub/src/auto4_perl_console.cpp deleted file mode 100644 index 1dbc31439..000000000 --- a/aegisub/src/auto4_perl_console.cpp +++ /dev/null @@ -1,244 +0,0 @@ -// Copyright (c) 2008, Simone Cociancich -// All rights reserved. -// -// Redistribution and use in source and binary forms, with or without -// modification, are permitted provided that the following conditions are met: -// -// * Redistributions of source code must retain the above copyright notice, -// this list of conditions and the following disclaimer. -// * Redistributions in binary form must reproduce the above copyright notice, -// this list of conditions and the following disclaimer in the documentation -// and/or other materials provided with the distribution. -// * Neither the name of the Aegisub Group nor the names of its contributors -// may be used to endorse or promote products derived from this software -// without specific prior written permission. -// -// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE -// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -// CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -// SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -// INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -// CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -// ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -// POSSIBILITY OF SUCH DAMAGE. -// -// ----------------------------------------------------------------------------- -// -// AEGISUB -// -// Website: http://aegisub.cellosoft.com -// Contact: mailto:jiifurusu@gmail.com -// - - -#include "config.h" - -#ifdef WITH_PERL -#ifdef WITH_PERLCONSOLE - - -#include "auto4_perl.h" -#include "auto4_perl_console.h" -#include "main.h" -#include "frame_main.h" -#include "subs_grid.h" - - -namespace Automation4 { - - -//////////////////////////////////// -// PerlConsole::Dialog -// - - inline PerlConsole::Dialog::Dialog() - { - txt_out = NULL; - } - - inline bool PerlConsole::Dialog::Create(wxWindow* parent, wxWindowID id, const wxString& title, - const wxPoint& pos, const wxSize& size, - long style, const wxString& name) - { - wxDialog::Create(parent, id, title, pos, size, style, name); - - // The text controls in the console - txt_out = new wxTextCtrl(this, -1, _T(""), wxDefaultPosition, wxSize(300,200), - wxTE_MULTILINE | wxTE_READONLY | wxTE_CHARWRAP | wxTE_RICH); - - txt_hist = new wxTextCtrl(this, -1, _T(""), wxDefaultPosition, wxDefaultSize, - wxTE_MULTILINE | wxTE_READONLY | wxTE_CHARWRAP | wxTE_RICH); - txt_in = new wxTextCtrl(this, -1, _T(""), wxDefaultPosition, wxDefaultSize, - wxTE_MULTILINE | wxTE_CHARWRAP | wxTE_PROCESS_ENTER); - - // The right panel - wxBoxSizer *rightpanel = new wxBoxSizer(wxVERTICAL); - rightpanel->Add(txt_hist, 1, wxEXPAND); - rightpanel->Add(txt_in, 0, wxEXPAND); - // And the event handler for the input box - Connect(txt_in->GetId(), wxEVT_COMMAND_TEXT_ENTER, wxCommandEventHandler(PerlConsole::Dialog::InputEnter)); - - // The whole dialog - wxBoxSizer *mainpanel = new wxBoxSizer(wxHORIZONTAL); - mainpanel->Add(txt_out, 1, wxEXPAND | wxRIGHT, 2); - mainpanel->Add(rightpanel, 1, wxEXPAND | wxLEFT, 2); - - // Getting it to work - SetSizer(mainpanel); - mainpanel->SetSizeHints(this); - - return true; - } - - inline void PerlConsole::Dialog::InputEnter(wxCommandEvent& evt) - { - if(txt_in->GetInsertionPoint() == txt_in->GetLastPosition() && - txt_in->GetLineLength(txt_in->GetNumberOfLines()-1) == 0) { - // If an empty line have been entered... - /* TODO: implement an actual command history */ - *txt_hist << txt_in->GetValue() << PerlConsole::Evaluate(txt_in->GetValue()) << _T("\n"); - - // Resetting the input box - txt_in->ChangeValue(_T("")); - } - else { - // Just a normal line with text - txt_in->WriteText(_T("\n")); - } - } - - -////////////////////// -// PerlConsole -// - PerlConsole *PerlConsole::registered = NULL; - - PerlConsole::PerlConsole(const wxString &name, const wxString &desc, PerlScript *script): - Feature(SCRIPTFEATURE_MACRO, name), - /*FeatureMacro(name, description),*/ - PerlFeatureMacro(name, desc, script, NULL, NULL) - { - parent_window = NULL; - dialog = new Dialog(); - - // Remove any previously registered console °_° - if(registered) { - registered->script->DeleteFeature(registered); - } - registered = this; - } - - PerlConsole::~PerlConsole() - { - if(dialog) dialog->Destroy(); - - /* TODO: Free something? */ - - // Delete the registered console - registered = NULL; - } - - void PerlConsole::Process(AssFile *subs, std::vector &selected, int active, wxWindow * const progress_parent) - { - if(!parent_window) { - // Create the console's dialog if it doesn't already exist - parent_window = progress_parent; - dialog->Create(parent_window, -1, GetName(), wxDefaultPosition, wxDefaultSize, wxDEFAULT_DIALOG_STYLE | wxRESIZE_BORDER); - } - // Show the console - dialog->Show(true); - // and return, the console will stay visible and permit running other macros - // the console will 'just' emulate the execution of a macro whenever some code will be evaluated - } - - wxString PerlConsole::evaluate(const wxString &str) - { - /* This mimics FrameMain::OnAutomationMacro */ - - // Get a hold of the SubsBox - SubtitlesGrid *sb = wxGetApp().frame->SubsBox; - sb->BeginBatch(); - - // Create the @_ (global <.<) - AV *AT = get_av("_", 1); - av_clear(AT); - // $_[0] - AV *lines = PerlAss::MakeHasshLines(NULL, AssFile::top); - av_push(AT, newRV_noinc((SV*)lines)); - // $_[1] - std::vector selected_lines = sb->GetAbsoluteSelection(); - AV *selected_av = newAV(); - VECTOR_AV(selected_lines, selected_av, int, iv); - av_push(AT, newRV_noinc((SV*)selected_av)); - // $_[2] - int first_sel = sb->GetFirstSelRow(); - av_push(AT, newSViv(first_sel)); - -// Clear all maps from the subs grid before running the macro -// The stuff done by the macro might invalidate some of the iterators held by the grid, which will cause great crashing - sb->Clear(); - - // Here we go - script->WriteVars(); - // Box the code into the right package - wxString code = _T("package ") + script->GetPackage() + _T(";\n"); - // Add the user's code - code << str; - // Evaluate the code - SV *e = eval_pv(code.mb_str(wx2pl), 0); - /* TODO: use threaded calls */ - /*PerlThread eval(code.mb_str(wx2pl), 1, PerlThread::EVAL); - e = (SV*)eval.Wait();*/ - /* TODO: check for errors */ - script->ReadVars(); - - // Recreate the top assfile from perl hassh - //AssFile::top->FlagAsModified(GetName()); - PerlAss::MakeAssLines(AssFile::top, lines); - av_undef(lines); - // And reset selection vector - selected_lines.clear(); - AV_VECTOR(selected_av, selected_lines, IV); - CHOP_SELECTED(AssFile::top, selected_lines); - av_undef(selected_av); - -// Have the grid update its maps, this properly refreshes it to reflect the changed subs - sb->UpdateMaps(); - sb->SetSelectionFromAbsolute(selected_lines); - sb->CommitChanges(true, false); - sb->EndBatch(); - - // The eval's return - return wxString(SvPV_nolen(e), pl2wx); - } - - wxString PerlConsole::Evaluate(const wxString &str) - { - if(registered) { - return registered->evaluate(str); - } - else { - /* TODO: print error */ - return _T(""); - } - } - - void PerlConsole::Echo(const wxString &str) - { - if(registered && registered->dialog->txt_out) { - *(registered->dialog->txt_out) << str << _T("\n"); - } - else { - PerlIO_printf(PerlIO_stdout(), "%s\n", str.c_str()); - } - } - - -}; - - -#endif //WITH_PERLCONSOLE -#endif //WITH_PERL diff --git a/aegisub/src/auto4_perl_console.h b/aegisub/src/auto4_perl_console.h deleted file mode 100644 index 3b42efebb..000000000 --- a/aegisub/src/auto4_perl_console.h +++ /dev/null @@ -1,94 +0,0 @@ -// Copyright (c) 2008, Simone Cociancich -// All rights reserved. -// -// Redistribution and use in source and binary forms, with or without -// modification, are permitted provided that the following conditions are met: -// -// * Redistributions of source code must retain the above copyright notice, -// this list of conditions and the following disclaimer. -// * Redistributions in binary form must reproduce the above copyright notice, -// this list of conditions and the following disclaimer in the documentation -// and/or other materials provided with the distribution. -// * Neither the name of the Aegisub Group nor the names of its contributors -// may be used to endorse or promote products derived from this software -// without specific prior written permission. -// -// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE -// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -// CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -// SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -// INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -// CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -// ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -// POSSIBILITY OF SUCH DAMAGE. -// -// ----------------------------------------------------------------------------- -// -// AEGISUB -// -// Website: http://aegisub.cellosoft.com -// Contact: mailto:jiifurusu@gmail.com -// - - -#pragma once -#ifndef _AUTO4_PERL_CONSOLE_H -#define _AUTO4_PERL_CONSOLE_H - - -#include "auto4_perl.h" -#include - - -namespace Automation4 { - - -///////////////// -// PerlConsole -// - class PerlConsole : public PerlFeatureMacro { - private: - static PerlConsole *registered; - - // Nested classes are messy, therefore we use them :) - class Dialog : public wxDialog { - private: - friend class PerlConsole; - wxTextCtrl *txt_out, *txt_hist, *txt_in; - - public: - Dialog(); - - bool Create(wxWindow* parent, wxWindowID id, const wxString& title, - const wxPoint& pos = wxDefaultPosition, const wxSize& size = wxDefaultSize, - long style = wxDEFAULT_DIALOG_STYLE, const wxString& name = _T("console_dialog")); - - void InputEnter(wxCommandEvent& evt); - }; - - Dialog *dialog; - wxWindow *parent_window; - - wxString evaluate(const wxString &str); - - public: - PerlConsole(const wxString &name, const wxString &desc, PerlScript *script); - virtual ~PerlConsole(); - - static PerlConsole *GetConsole() { return registered; } - - virtual bool Validate(AssFile *subs, const std::vector &selected, int active) { return true; } - virtual void Process(AssFile *subs, std::vector &selected, int active, wxWindow * const progress_parent); - - static wxString Evaluate(const wxString &str); - static void Echo(const wxString &str); - }; - - -}; - - -#endif diff --git a/aegisub/src/auto4_perl_dialogs.cpp b/aegisub/src/auto4_perl_dialogs.cpp deleted file mode 100644 index aa4bb59ca..000000000 --- a/aegisub/src/auto4_perl_dialogs.cpp +++ /dev/null @@ -1,72 +0,0 @@ -// Copyright (c) 2008, Simone Cociancich -// All rights reserved. -// -// Redistribution and use in source and binary forms, with or without -// modification, are permitted provided that the following conditions are met: -// -// * Redistributions of source code must retain the above copyright notice, -// this list of conditions and the following disclaimer. -// * Redistributions in binary form must reproduce the above copyright notice, -// this list of conditions and the following disclaimer in the documentation -// and/or other materials provided with the distribution. -// * Neither the name of the Aegisub Group nor the names of its contributors -// may be used to endorse or promote products derived from this software -// without specific prior written permission. -// -// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE -// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -// CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -// SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -// INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -// CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -// ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -// POSSIBILITY OF SUCH DAMAGE. -// -// ----------------------------------------------------------------------------- -// -// AEGISUB -// -// Website: http://aegisub.cellosoft.com -// Contact: mailto:jiifurusu@gmail.com -// - - -#include "config.h" - -#ifdef WITH_PERL - - -#include "auto4_perl.h" - - -namespace Automation4 { - - -////////////////////// -// PerlProgressSink -// - PerlProgressSink *PerlProgressSink::sink; - - PerlProgressSink::PerlProgressSink(wxWindow* parent, const wxString &title): - ProgressSink(parent) - { - if(sink) { - sink->Destroy(); - } - sink = this; - SetTitle(_("Executing ") + title); - } - - PerlProgressSink::~PerlProgressSink() - { - sink = NULL; - } - - -}; - - -#endif //WITH_PERL diff --git a/aegisub/src/auto4_perl_factory.h b/aegisub/src/auto4_perl_factory.h deleted file mode 100644 index 7261099d8..000000000 --- a/aegisub/src/auto4_perl_factory.h +++ /dev/null @@ -1,67 +0,0 @@ -// Copyright (c) 2008, Simone Cociancich -// All rights reserved. -// -// Redistribution and use in source and binary forms, with or without -// modification, are permitted provided that the following conditions are met: -// -// * Redistributions of source code must retain the above copyright notice, -// this list of conditions and the following disclaimer. -// * Redistributions in binary form must reproduce the above copyright notice, -// this list of conditions and the following disclaimer in the documentation -// and/or other materials provided with the distribution. -// * Neither the name of the Aegisub Group nor the names of its contributors -// may be used to endorse or promote products derived from this software -// without specific prior written permission. -// -// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE -// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -// CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -// SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -// INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -// CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -// ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -// POSSIBILITY OF SUCH DAMAGE. -// -// ----------------------------------------------------------------------------- -// -// AEGISUB -// -// Website: http://aegisub.cellosoft.com -// Contact: mailto:jiifurusu@gmail.com -// - - -#pragma once -#ifndef _AUTO4_PERL_FACTORY_H -#define _AUTO4_PERL_FACTORY_H - - -#include "auto4_base.h" -struct interpreter; -typedef interpreter PerlInterpreter; - -namespace Automation4 { - - /////////////////////// - // PerlScriptFactory - // - class PerlScriptFactory : public ScriptFactory { - private: - PerlInterpreter *parser; - bool loaded; - - public: - PerlScriptFactory(); - ~PerlScriptFactory(); - - void RegisterFactory(); - - Script* Produce(const wxString &filename) const; - }; -}; - - -#endif diff --git a/aegisub/src/auto4_perl_script.cpp b/aegisub/src/auto4_perl_script.cpp deleted file mode 100644 index c4aedf2ef..000000000 --- a/aegisub/src/auto4_perl_script.cpp +++ /dev/null @@ -1,475 +0,0 @@ -// Copyright (c) 2008, Simone Cociancich -// All rights reserved. -// -// Redistribution and use in source and binary forms, with or without -// modification, are permitted provided that the following conditions are met: -// -// * Redistributions of source code must retain the above copyright notice, -// this list of conditions and the following disclaimer. -// * Redistributions in binary form must reproduce the above copyright notice, -// this list of conditions and the following disclaimer in the documentation -// and/or other materials provided with the distribution. -// * Neither the name of the Aegisub Group nor the names of its contributors -// may be used to endorse or promote products derived from this software -// without specific prior written permission. -// -// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE -// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -// CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -// SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -// INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -// CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -// ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -// POSSIBILITY OF SUCH DAMAGE. -// -// ----------------------------------------------------------------------------- -// -// AEGISUB -// -// Website: http://aegisub.cellosoft.com -// Contact: mailto:jiifurusu@gmail.com -// - - -#include "config.h" - -#ifdef WITH_PERL - - -#include "auto4_perl.h" -#include "version.h" -#include "standard_paths.h" -#include -#include - - -#ifdef __VISUALC__ -#pragma warning(disable: 4800) -#pragma warning(disable: 4706) -#endif - - -namespace Automation4 { - - -////////////////////// -// PerlScript class -// - PerlScript *PerlScript::active = NULL; - - PerlScript::PerlScript(const wxString &filename): - Script(filename) - { - // Create a package name for the script - package.Printf(_T("Aegisub::Script::p%lx"), this); - - // local @INC; # lol - inc_saved = newAV(); - - // Buggy - reload = false; - mtime = 0; - - // Load the script - load(); - } - - PerlScript::~PerlScript() - { - unload(); - } - - void PerlScript::Reload() - { - unload(); - reload = false; - load(); - } - - void PerlScript::load() - { - wxTRACE_METH(load); - wxLogTrace(wxTRACE_AutoPerl, _T("filename = '%s', package = '%s'"), GetFilename().c_str(), package.c_str()); - - // Feed some defaults into the script info - name = GetPrettyFilename().BeforeLast(_T('.')); - description = _("Perl script"); - author = wxGetUserId(); - version = GetAegisubShortVersionString(); - - wxFileName fn(GetFilename()); - wxDateTime mod; - fn.GetTimes(NULL,&mod,NULL); - mtime = mod.GetTicks(); - - // Create the script's package - gv_stashpv(package.mb_str(wx2pl), 1); - // Set this script as active - activate(this); - - // 'Enclose' the script into its package - wxString _script = _T("package ") + package + _T(";\n") - _T("require Aegisub; require Aegisub::Script; require Aegisub::Progress;") // Core modules - _T("our ($_script_reload, $_script_path, $_script_package);\n") // Internal vars - _T("our ($script_name, $script_description, $script_author, $script_version);\n") // Package info - _T("open SCRIPT, $_script_path;\n") // Open the script file - _T("local @_source =