362 lines
8.6 KiB
Perl
Executable File
362 lines
8.6 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
use strict;
|
|
use warnings;
|
|
use Fcntl qw(:seek :flock);
|
|
|
|
my @input;
|
|
my %style_xlate = (
|
|
"WS_CHILD" => "SWELL_DLG_WS_CHILD",
|
|
"WS_THICKFRAME" => "SWELL_DLG_WS_RESIZABLE",
|
|
"WS_EX_ACCEPTFILES" => "SWELL_DLG_WS_DROPTARGET",
|
|
"WS_CLIPSIBLINGS" => "WS_CLIPSIBLINGS",
|
|
);
|
|
|
|
sub update_file {
|
|
my($fn, $force, $data) = @_;
|
|
|
|
open(FPC_FH, '+>>', $fn) or return $!;
|
|
if (!flock(FPC_FH, LOCK_EX)) {
|
|
close(FPC_FH);
|
|
return "error locking file";
|
|
}
|
|
seek FPC_FH, 0, SEEK_SET;
|
|
|
|
if ($force == 0)
|
|
{
|
|
my $v = "";
|
|
while (<FPC_FH>) { $v .= $_; }
|
|
if ($v eq $data) {
|
|
close(FPC_FH);
|
|
return "";
|
|
}
|
|
seek FPC_FH, 0, SEEK_SET;
|
|
}
|
|
truncate FPC_FH, 0;
|
|
print FPC_FH $data;
|
|
flock(FPC_FH, LOCK_UN);
|
|
close(FPC_FH);
|
|
return "OK";
|
|
}
|
|
|
|
sub convertquotes {
|
|
return $_[0] unless $_[0] =~ /"/;
|
|
my @a = split(/"/,$_[0], -1);
|
|
my $ret = $a[0];
|
|
my $qs = 0;
|
|
for (my $x=1;$x<@a; $x++) {
|
|
my $s = $a[$x];
|
|
if ($s eq "" && $qs && $x+1 < @a) {
|
|
$ret .= '\\"' . $a[++$x];
|
|
} else {
|
|
$ret .= "\"$s";
|
|
$qs = !$qs;
|
|
}
|
|
}
|
|
return $ret;
|
|
}
|
|
|
|
sub swell_rc2cpp_dialog
|
|
{
|
|
my $errstr = "";
|
|
my $retstr = '#ifndef SWELL_DLG_SCALE_AUTOGEN
|
|
#ifdef __APPLE__
|
|
#define SWELL_DLG_SCALE_AUTOGEN 1.7
|
|
#else
|
|
#define SWELL_DLG_SCALE_AUTOGEN 1.9
|
|
#endif
|
|
#endif
|
|
#ifndef SWELL_DLG_FLAGS_AUTOGEN
|
|
#define SWELL_DLG_FLAGS_AUTOGEN SWELL_DLG_WS_FLIPPED|SWELL_DLG_WS_NOAUTOSIZE
|
|
#endif
|
|
|
|
';
|
|
|
|
my $dlg_state=0; # 1 = before BEGIN, 2=after BEGIN
|
|
|
|
my $dlg_name="";
|
|
my $dlg_size_w=0;
|
|
my $dlg_size_h=0;
|
|
my $dlg_title = "";
|
|
my $dlg_styles = "SWELL_DLG_FLAGS_AUTOGEN";
|
|
my $dlg_contents="";
|
|
|
|
for (my $idx = 0; $idx < @input; $idx++)
|
|
{
|
|
my $x = $input[$idx];
|
|
|
|
(my $y = $x) =~ s/^\s+|\s+$//g;
|
|
if ($dlg_state>=2)
|
|
{
|
|
$y = "RTEXT" . $1 if $y =~ /^LTEXT(.*), *WS_EX_RIGHT$/;
|
|
if ($dlg_contents =~ /, *\n$/)
|
|
{
|
|
$dlg_contents =~ s/ *\n$//;
|
|
}
|
|
elsif ($dlg_contents =~ /[|] *\n$/)
|
|
{
|
|
$dlg_contents =~ s/ *\n$/ /;
|
|
}
|
|
elsif ($dlg_contents =~ /NOT *\n$/)
|
|
{
|
|
$dlg_contents =~ s/NOT *\n$/NOT /;
|
|
}
|
|
$dlg_contents .= $y . "\n";
|
|
if ($y eq "END")
|
|
{
|
|
if ($dlg_state==2) { $dlg_styles.="|SWELL_DLG_WS_OPAQUE" };
|
|
$retstr .= "#ifndef SET_${dlg_name}_SCALE\n" .
|
|
"#define SET_${dlg_name}_SCALE SWELL_DLG_SCALE_AUTOGEN\n" .
|
|
"#endif\n" .
|
|
"#ifndef SET_${dlg_name}_STYLE\n" .
|
|
"#define SET_${dlg_name}_STYLE $dlg_styles\n" .
|
|
"#endif\n" .
|
|
"SWELL_DEFINE_DIALOG_RESOURCE_BEGIN($dlg_name,SET_${dlg_name}_STYLE,\"$dlg_title\",$dlg_size_w,$dlg_size_h,SET_${dlg_name}_SCALE)\n";
|
|
|
|
$dlg_contents =~ s/NOT\s+WS_VISIBLE/SWELL_NOT_WS_VISIBLE/gs;
|
|
$retstr .= $dlg_contents;
|
|
$retstr .= "SWELL_DEFINE_DIALOG_RESOURCE_END($dlg_name)\n\n\n";
|
|
$dlg_state=0;
|
|
}
|
|
elsif (length($y)>1) { $dlg_state=3; }
|
|
}
|
|
else
|
|
{
|
|
my @parms = split " ", $y;
|
|
if (@parms > 0)
|
|
{
|
|
if ($dlg_state == 0)
|
|
{
|
|
if (@parms>4 && ($parms[1] eq "DIALOGEX" || $parms[1] eq "DIALOG"))
|
|
{
|
|
$dlg_name=$parms[0];
|
|
my $rdidx = 2;
|
|
if ($parms[$rdidx] eq 'DISCARDABLE') { $rdidx++ };
|
|
while ($rdidx < @parms && $parms[$rdidx] eq "") { $rdidx++; }
|
|
$rdidx += 2;
|
|
($dlg_size_w = $parms[$rdidx++]) =~ s/,//g;
|
|
($dlg_size_h = $parms[$rdidx++]) =~ s/,//g;
|
|
if (@parms >= $rdidx && $dlg_size_w ne "" && $dlg_size_h ne "")
|
|
{
|
|
$dlg_title="";
|
|
$dlg_styles="SWELL_DLG_FLAGS_AUTOGEN";
|
|
$dlg_contents="";
|
|
$dlg_state=1;
|
|
}
|
|
else
|
|
{
|
|
$errstr .= "WARNING: corrupted $dlg_name resource\n";
|
|
}
|
|
}
|
|
}
|
|
elsif ($dlg_state == 1)
|
|
{
|
|
if ($parms[0] eq "BEGIN")
|
|
{
|
|
$dlg_state=2;
|
|
$dlg_contents = $y ."\n";
|
|
}
|
|
else
|
|
{
|
|
if ($parms[0] eq "CAPTION")
|
|
{
|
|
$dlg_title = substr $y, 8;
|
|
$dlg_title =~ s/^\s+|\s+$|"//g;
|
|
}
|
|
elsif ($parms[0] eq "STYLE" || $parms[0] eq "EXSTYLE")
|
|
{
|
|
my $rep=0;
|
|
for (;($idx+1) < @input; $idx++)
|
|
{
|
|
my $next_line = $input[$idx+1];
|
|
last unless $next_line =~ /^[ \t]/;
|
|
|
|
$next_line =~ s/^\s+|\s+$//g;
|
|
$y .= " " . $next_line;
|
|
$rep++;
|
|
}
|
|
@parms = split " ", $y if $rep;
|
|
my $opmode=0;
|
|
for (my $rdidx = 1; $rdidx < @parms; $rdidx ++)
|
|
{
|
|
if ($parms[$rdidx] eq "NOT") { $opmode=1; }
|
|
elsif ($opmode == 0)
|
|
{
|
|
my $s = $style_xlate{$parms[$rdidx]};
|
|
$dlg_styles .= "|$s" if defined($s);
|
|
}
|
|
else { $opmode=0; }
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
$errstr .= "WARNING: there may have been a truncated dialog resource ($dlg_name)\n" if $dlg_state != 0;
|
|
|
|
$retstr .= "\n//EOF\n\n";
|
|
return ( $retstr, $errstr );
|
|
}
|
|
|
|
sub swell_rc2cpp_menu
|
|
{
|
|
my $retstr="";
|
|
my $errstr="";
|
|
|
|
my $menu_symbol="";
|
|
my $menu_depth=0;
|
|
for (@input)
|
|
{
|
|
my $x = $_;
|
|
(my $y = $x) =~ s/^\s+|\s+$//g;
|
|
|
|
if ($menu_symbol eq "")
|
|
{
|
|
my @parms = split " ", $y;
|
|
if (@parms >= 2 && $parms[1] eq "MENU")
|
|
{
|
|
$menu_symbol = $parms[0];
|
|
$menu_depth=0;
|
|
$retstr .= "SWELL_DEFINE_MENU_RESOURCE_BEGIN($menu_symbol)\n";
|
|
}
|
|
}
|
|
else
|
|
{
|
|
if ($y eq "END")
|
|
{
|
|
$menu_depth-=1;
|
|
if ($menu_depth == 0)
|
|
{
|
|
$retstr .= "SWELL_DEFINE_MENU_RESOURCE_END($menu_symbol)\n\n\n";
|
|
}
|
|
$menu_symbol="" if $menu_depth < 1;
|
|
}
|
|
|
|
if ($menu_depth>0)
|
|
{
|
|
if (($retstr =~ /,\s*$/) || ($x =~ /^\s*,/)) {
|
|
$retstr =~ s/\s*\n$//;
|
|
$x =~ s/^\s*//;
|
|
}
|
|
|
|
$x =~ s/, HELP\s*/\n/;
|
|
$retstr .= $x;
|
|
}
|
|
$menu_depth+=1 if $y eq "BEGIN";
|
|
}
|
|
}
|
|
|
|
$retstr .= "\n//EOF\n\n";
|
|
|
|
return ($retstr, $errstr);
|
|
}
|
|
|
|
die("usage: swell_resgen.pl [--force] file.rc ...\n") if @ARGV<1;
|
|
|
|
my $forcemode = 0;
|
|
my $proc=0;
|
|
my $skipped=0;
|
|
my $err=0;
|
|
my $quiet=0;
|
|
for (my $x = 0; $x < @ARGV; $x ++)
|
|
{
|
|
my $srcfn = $ARGV[$x];
|
|
if ($srcfn eq "--quiet")
|
|
{
|
|
$quiet = 1;
|
|
next;
|
|
}
|
|
if ($srcfn eq "--force")
|
|
{
|
|
$forcemode = 1;
|
|
next;
|
|
}
|
|
if (!($srcfn =~ /[.]rc$/i))
|
|
{
|
|
$err++;
|
|
print "$srcfn: does not end in .rc!\n";
|
|
next;
|
|
}
|
|
|
|
if (!open(UTF_FH, "<", $srcfn))
|
|
{
|
|
$err++;
|
|
print "$srcfn: could not open!\n";
|
|
continue;
|
|
}
|
|
$_ = <UTF_FH>;
|
|
if (/^\xff\xfe/ || /^\xfe\xff/) {
|
|
@input = ( );
|
|
my $order = (ord($_) == 0xff) ? 0 : 1;
|
|
seek UTF_FH, 2, SEEK_SET;
|
|
|
|
my $ret = "";
|
|
while (read UTF_FH, my $s, 2)
|
|
{
|
|
$s = ($order == 1) ? (ord($s) | (ord(substr($s,1))<<8)) : (ord(substr($s,1)) | (ord($s)<<8));
|
|
if ($s < 128) {
|
|
$ret .= chr($s);
|
|
if ($s == ord("\n")) {
|
|
push(@input,convertquotes($ret));
|
|
$ret = "";
|
|
}
|
|
}
|
|
elsif ($s <= 0x7ff) {
|
|
$ret .= chr(0xc0 | (($s>>6)&0x1f)) . chr(0x80 | ($s&0x3f));
|
|
}
|
|
else {
|
|
$ret .= chr(0xe0 | (($s>>12)&0xf)) . chr(0x80 | (($s)>>6)&0x3f) . chr(0x80 | ($s&0x3f));
|
|
}
|
|
}
|
|
push(@input,convertquotes($ret)) if $ret ne "";
|
|
} else {
|
|
$_ = substr($_,3) if /^\xef\xbb\xbf/;
|
|
@input = ( $_ );
|
|
while (<UTF_FH>) {
|
|
push @input, convertquotes($_);
|
|
}
|
|
}
|
|
|
|
close(UTF_FH);
|
|
|
|
my $ofnmenu = $srcfn . "_mac_menu";
|
|
my $ofndlg = $srcfn . "_mac_dlg";
|
|
|
|
my ($dlg_str, $dlg_err) = swell_rc2cpp_dialog();
|
|
my ($menu_str, $menu_err) = swell_rc2cpp_menu();
|
|
|
|
if ($dlg_err ne "" || $menu_err ne "")
|
|
{
|
|
$err++;
|
|
print "$srcfn: error";
|
|
print " dialog: $dlg_err" if $dlg_err ne "";
|
|
print " menu: $menu_err" if $menu_err ne "";
|
|
print "\n";
|
|
continue;
|
|
}
|
|
my $f="";
|
|
my $ok = update_file($ofndlg, $forcemode, $dlg_str);
|
|
$f .= ", dlg updated" if $ok eq "OK";
|
|
if ($ok ne "OK" && $ok ne "") { print "error writing $ofndlg: $ok\n"; $err++; }
|
|
|
|
$ok = update_file($ofnmenu, $forcemode, $menu_str);
|
|
$f .= ", menu updated" if $ok eq "OK";
|
|
if ($ok ne "OK" && $ok ne "") { print "error writing $ofnmenu: $ok\n"; $err++; }
|
|
|
|
if ($f ne "")
|
|
{
|
|
$f =~ s/^, //;
|
|
$proc++;
|
|
}
|
|
else
|
|
{
|
|
$skipped++;
|
|
$f = "skipped";
|
|
}
|
|
|
|
print "$srcfn: $f\n" if $quiet == 0;
|
|
}
|
|
|
|
print "processed $proc, skipped $skipped, error $err\n" if $quiet==0 || $err>0;
|
|
|