frm2form.pl

Gambas is a graphical development environment based on a Basic interpreter, like Visual Basic. It us

#!/usr/bin/perl
#
# frm2form version 0.05
# 1 September 2004
# Copyright Rob Kudla/Binara, Inc.
# You may use and redistribute this program under the terms of the GNU GPL.
# See http://www.gnu.org/licenses/gpl.html for more information.
#

$/ = "\r\n";
my $curcontrol;

while ($line = <>) {
    chomp $line;
    next unless $line =~ /^\s*begin\s+vb.form\s+(\S+)/i;
    $FORM{'name'} = $1;
    while ($line = <>) {
	parseformline($line);
    }
}

sub parseformline {
    my $line = shift;
    my $parent = shift;
    
    chomp $line;
    return if $line =~ /^\s*end\s*$/i;
    if ($line =~ /^\s*begin\s+(\S+)\s+(\S+)/i) {
	my $curcontrol = $2;
	my $type = $1;
	$type =~ s/^VB.//;
	$type = "Button" if $type eq 'CommandButton';
	$type = "RadioButton" if $type eq 'OptionButton';
	$type = "TabStrip" if $type =~ /(tabdlg.)?sstab/i;
	$curcontrol = "$parent/$curcontrol";
	$FORM{'controls'}->{$curcontrol}->{'type'} = $type;
	while ($line = <>) {
	    chomp $line;
	    if ($line =~ /^\s*end\s*$/i) {
		if (length($parent) <= 1) {
		    last;
		} else {
		    return;
		}
	    } elsif ($line =~ /^\s*backcolor\s*=\s*(\S+)/i) {
		$FORM{'controls'}->{$curcontrol}->{'Background'} = $1;
	    } elsif ($line =~ /^\s*forecolor\s*=\s*(\S+)/i) {
		$FORM{'controls'}->{$curcontrol}->{'Foreground'} = $1;
	    } elsif ($line =~ /^\s*index\s*=\s*(\S+)/i) {
		$FORM{'controls'}->{$curcontrol}->{'index'} = $1;
	    } elsif ($line =~ /^\s*value\s*=\s*(\S+)/i) {
		$FORM{'controls'}->{$curcontrol}->{'Value'} = $1;
	    } elsif ($line =~ /^\s*tabindex\s*=\s*(\S+)/i) {
		# ignore for now till I figure out how to order controls in output
	    } elsif ($line =~ /^\s*height\s*=\s*(\d+)/i) {
		$FORM{'controls'}->{$curcontrol}->{'H'} = int($1 * 10 / 144);
	    } elsif ($line =~ /^\s*width\s*=\s*(\d+)/i) {
		$FORM{'controls'}->{$curcontrol}->{'W'} = int($1 * 10 / 144);
	    } elsif ($line =~ /^\s*left\s*=\s*([\-\d]+)/i) {
		$FORM{'controls'}->{$curcontrol}->{'X'} = int($1 * 10 / 144);
	    } elsif ($line =~ /^\s*top\s*=\s*(\d+)/i) {
		$FORM{'controls'}->{$curcontrol}->{'Y'} = int($1 * 10 / 144);
	    } elsif ($line =~ /^\s*caption\s*=\s*"(.+)"/i) { 
		$FORM{'controls'}->{$curcontrol}->{'Text'} = $1;
	    } elsif ($line =~ /^\s*interval\s*=\s*(\d+)/i) {
		$FORM{'controls'}->{$curcontrol}->{'delay'} = $1;
	    } elsif ($line =~ /^\s*beginproperty\s*font/i) {
		print STDERR "got font, parsing it\n";
		$FORM{'controls'}->{$curcontrol}->{'Font'} = parsefont();
		print STDERR "got font: $FORM{'controls'}->{$curcontrol}->{'Font'}\n";

	    } elsif ($line =~ /^\s*begin\s*\S+\s*\S+/i) {
		parseformline($line, $curcontrol);
	    } else {
		print STDERR "subline not handled: $line\n";
		next;
	    }
	}
    } elsif ($line =~ /^\s*caption\s*=\s*"(.+)"/i) { # form title
	$FORM{'text'} = $1;
    } elsif ($line =~ /^\s*clientheight\s*=\s*(\d+)/i) { # form Y
	$FORM{'H'} = int($1 * 10 / 144); # twips to pixels at 100dpi
    } elsif ($line =~ /^\s*clientwidth\s*=\s*(\d+)/i) { # form Y
	$FORM{'W'} = int($1 * 10 / 144); # twips to pixels at 100dpi
    } else {
	print STDERR "line not handled: $line\n";
    }

}

sub parsefont {
    my($face, $size, $weight, $bold, $underline, $italic, $strikeout);
    while (my $line = <>) {
	chomp $line;
	if ($line =~ /^\s*name\s*=\s*(.+)?\s*$/i) {
	    $face = $1;
	} elsif ($line =~ /^\s*size\s*=\s*(\S+)/i) {
	    $size = $1;
	} elsif ($line =~ /^\s*weight\s*=\s*(\S+)/i) {
	    $bold = "Bold" if $1 > 500;
	} elsif ($line =~ /^\s*italic\s*=\s*(\S+)/i) {
	    $italic = "Italic" if $1 != 0;
	} elsif ($line =~ /^\s*underline\s*=\s*(\S+)/i) {
	    $underline = "Underline" if $1 != 0;
	} elsif ($line =~ /^\s*strikeout\s*=\s*(\S+)/i) {
	    $strikeout = "Strikeout" if $1 != 0;
	} elsif ($line =~ /endproperty/i) {
	    print STDERR "got end font property: $line\n";
	    last;
	}
    }
    my @attr;
    for my $attr ($bold, $underline, $italic, $strikeout) {
	push @attr, $attr if $attr;
    }
    unshift @attr, $size;
    $face =~ s/\"//g;
    unshift @attr, $face;
    return "Font[\"" . join(',', @attr) . "\"]";

}

print qq|# Gambas Form File 1.0\n\n{ $FORM{'name'} Form\n  Move(100, 100, $FORM{'W'}, $FORM{'H'})\n  Text = ("$FORM{'text'}")\n  Persistent = True\n|;
@f = sort keys %{$FORM{'controls'}};
outputform();
print "}\n";

sub outputform {

    while ($f = shift(@f)) {
	$ff = $f;
	$ff =~ s|.*/||g;
	my $ind = $FORM{'controls'}->{$f}->{'index'};
	if ($FORM{'controls'}->{$f}->{'type'} eq 'Timer') {
	    print qq|  \{ $ff$ind $FORM{'controls'}->{$f}->{'type'} \n    \#X = $FORM{'controls'}->{$f}->{'X'}\n    \#Y = $FORM{'controls'}->{$f}->{'Y'}\n    Delay = $FORM{'controls'}->{$f}->{'delay'}\n  \}\n|;
	} else {
	    my $spaces = grep(/\//, split('', $f)) + 0;
	    $spaces = ' ' x ($spaces * 2);
	    print qq|$spaces\{ $ff$ind $FORM{'controls'}->{$f}->{'type'} \n${spaces}Move($FORM{'controls'}->{$f}->{'X'}, $FORM{'controls'}->{$f}->{'Y'}, $FORM{'controls'}->{$f}->{'W'}, $FORM{'controls'}->{$f}->{'H'});\n|;
	    my @skip = ("X", "Y", "W", "H", "type", "index");
	    for my $prop (keys %{$FORM{'controls'}->{$f}}) {
		next if grep(/^$prop/i, @skip) > 0;
		my $val = $FORM{'controls'}->{$f}->{$prop};
		if ($prop eq 'Font') {
		    print "$spaces  $prop = $val\n";
		} else {
		    print "$spaces  $prop = \"$val\"\n";
		}
	    }
	    if ($f[0] =~ m/^$f/) { # recurse
		outputform();
	    }
	    print qq|$spaces\}\n|;
	    my $next = $f[0];
	    $next = grep(/\//, split('', $next)) + 0;
	    $next = ' ' x ($next * 2);
	    return if length($spaces) > length($next);
	}
    }

}