#
#	vbfrm2pl.pl
#
#	Adapted from Aldo Calpini's frm2pl.pl
#
#!perl -w
use strict;

my %controls;

my $StandardHeader = "\nuse Win32::GUI;\n\n";
my $TitleBarHeight = 405;

my $file = shift or die "No file specified";

my $twip = shift;

frm2pl($file, $twip);

#
#	Generic events (all controls)
#
my @events = qw(
	Click
	RightClick
	DblClick
	DblRightClick
	GotFocus
	LostFocus
	);
#
#	Set up default handlers
#	Don't do anything - just trace to STDERR	
#
for my $ctl (sort keys %controls)
	{
	print "#\n# $ctl\t$controls{$ctl}\n#\n";

	for my $event (@events)
		{
		eventproc($ctl, $event);
		}
	if($controls{$ctl} eq 'Textfield')
		{
		eventproc($ctl, 'Change');
		}
	}

sub eventproc
	{
	my $ctl = shift;
	my $event = shift;

	print <<EOD;

sub ${ctl}_${event}
	{
	print STDERR "${ctl}_${event}\\n";

	return 1;
	}
EOD
	}

#
#
#

sub frm2pl
	{
	my($file, $twip) = @_;
	my $doing = "nothing";
	my @words;
	my ($one, $two, $three);
	my $FormName;
	my $LINE;
	$twip = 15 unless $twip;
    
	print $StandardHeader;

	if(open(FRM, $file))
		{
        	while($LINE = <FRM>)
			{
			#
			chomp $LINE;
			$LINE =~ s/^\s*//;
			$LINE =~ s/\s*$//;
			($one, $two, $three) = split(/\s+/, $LINE, 3);
			if($one =~ /^BEGIN$/i)
				{
				if($two =~ /^VB\.FORM$/i)
					{
					$FormName = $three;
					print "\$$FormName = new Win32::GUI::Window(\n";
					print "\t-name\t=> \"$FormName\",\n";            
					$doing = "form";
					}
				elsif($two =~ /^VB\.COMMANDBUTTON$/i)
					{
					print_ctl("Button");
					}
				elsif($two =~ /^VB\.TEXTBOX$/i)
					{
					print_ctl("Textfield");
					}
				elsif($two =~ /^VB\.CHECKBOX$/i)
					{
					print_ctl("Checkbox");
					}
				elsif($two =~ /^VB\.LABEL$/i)
					{
					print_ctl("Label");
					}
				elsif($two =~ /^VB\.LISTBOX$/i)
					{
					print_ctl("Listbox");
					}
				elsif($two =~ /^VB\.OPTIONBUTTON$/i)
					{
					print_ctl("RadioButton");
					}
				elsif($two =~ /^COMCTLLIB\.TREEVIEW$/i)
					{
					print_ctl("TreeView");
					}
				elsif($two =~ /^COMCTLLIB\.IMAGELIST/i)
					{
					print_ctl("ImageList");
					}
				elsif($two =~ /^COMCTLLIB\.STATUSBAR/i)
					{
					print_ctl("StatusBar");
					}
				else
					{
					print ");\n" if $doing ne "nothing";
					$doing = "nothing";
					}
				}
			else
				{
				if($doing ne "nothing")
					{
					if($one =~ /^END$/i)
						{
						print ");\n";
						$doing = "nothing";
						}
					elsif(index("_LEFTTOPWIDTHHEIGHT", uc($one)) > 0 and $two eq "=")
						{
						print "\t-", lc($one), "\t=> ", int($three / $twip), ",\n";
						}
					elsif($one =~ /Client(Left|Top|Width|Height)/ and $two eq "=")
						{
						#
						# VB stores only the Client area size, so we have to use that
						# plus the height of the title bar (405) to get real height
						#
						my ($temp) = $one =~ m/Client(Left|Top|Width|Height)/;
						print "\t-", lc($temp), "\t=> ", int(($three + (uc($temp) eq 'HEIGHT' ? $TitleBarHeight : 0))/ $twip), ",\n";
						#
						# NOTE: Width does not come out right yet - seems to lose a little in translation
						#
						}
					elsif(index("_VISIBLE", uc($one)) > 0 and $two eq "=")
						{
						print "\t-visible\t=> ", $three, ",\n";
						}
					elsif(index("_CAPTIONTEXT", uc($one)) > 0 and $two eq "=")
						{
						print "\t-text\t=> ", quoteforperl((split(/\s*=\s*/, $LINE, 2))[1]), ",\n";
						}
					#
					#	Text boxes
					#
					elsif(uc($one) eq "PASSWORDCHAR" and $two eq "=")
						{
						print "\t-password\t=> 1,\n";
						}
					}
				}
			}
		close(FRM);
		if($FormName)
			{
			print "\n\$$FormName->Show;\n";
			print "Win32::GUI::Dialog();\n\n";
			}

		eventproc($FormName, 'Activate');
		eventproc($FormName, 'Deactivate');
		eventproc($FormName, 'Resize');
	
		print <<_END_;

sub ${FormName}_Terminate
	{
	print STDERR "${FormName}_Terminate\n";

	return -1;
	}

_END_

		}
	else
		{
		warn "Can't open file $file: $!\n";
		return 0;
		}
	return 1;

	sub print_ctl
		{
		my($ctl) = @_;
	
		$controls{$three} = $ctl;
	
		print ");\n" if $doing eq "form";
		print "\$$three = \$$FormName->Add$ctl(\n";
		print "\t-name\t=> \"$three\",\n";
		$doing = $ctl;
		}

	}


sub quoteforperl
	{
	my($what) = @_;
	$what =~ s/\$/\\\$/g;
	$what =~ s/\@/\\\@/g;
	$what =~ s/\%/\\\%/g;
	return $what;
	}