From e6e42dde64af3d9f114ba76c69210800c3db71d4 Mon Sep 17 00:00:00 2001 From: Alex Gomez Date: Mon, 24 Jan 2022 18:19:36 -0600 Subject: [PATCH 1/3] Initial commit --- 00_Utilities/bas2perl.pl | 329 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 329 insertions(+) create mode 100755 00_Utilities/bas2perl.pl diff --git a/00_Utilities/bas2perl.pl b/00_Utilities/bas2perl.pl new file mode 100755 index 00000000..2df1b5dc --- /dev/null +++ b/00_Utilities/bas2perl.pl @@ -0,0 +1,329 @@ +#!/usr/bin/perl +use strict; + + +my $Mode= lc($ARGV[0]); #trace #convert +my $File= $ARGV[1]; +my $LN= "Line"; + +my %Vars; +my @Data; +my %Code; +open(FH, $File); +while (my $Line = ) { + chomp $Line; + my $Space= index($Line, " "); + my $Key= substr($Line, 0, $Space); + my $Code= substr($Line, $Space+1); + $Code{$Key}=$Code; + } +close(FH); + + +foreach my $Lin (sort {$a<=>$b} keys %Code) { + if ($Mode eq "trace") { print "==> $Lin $Code{$Lin}\n"; } + my $Ret= &PROCLINE($Code{$Lin}); + if ($Mode eq "trace") { print " $Ret\n"; } + $Code{$Lin}= $Ret; + } + + +if ($Mode eq "convert") { + $Code{'0.1'}= "#!/usr/bin/perl"; + $Code{'0.2'}= "#use strict;"; + $Code{'0.3'}= "# Automatic converted by bas2perl.pl"; + $Code{'0.4'}= ""; + foreach my $Lin (sort {$a<=>$b} keys %Code) { + print "$Code{$Lin}\n"; + } + } + + if (@Data) { &DATAIL(); } + print "\n\n\n"; + + +exit; + + + +#print @Lines; + +sub PROCLINE { + my ($Line)= @_; + #my @Sente= split(/:/, $Line); + #my @Sente= split(/\:(?=([^"]*"[^"]*")*[^"]*$)/g, $Line); + my @Sente= split(/:(?=(?:[^"]*"[^"]*")*[^"]*$)/g, $Line); + + my $Perl; + foreach my $Sen (@Sente) { + #if ($Sen eq "") { next; } # Somehow the regex gives empty items between. + my $Flag=0; + $Sen= &TRIM($Sen); + if ($Sen>0) { $Sen= "GOTO $Sen"; } #The birth of spaguetti code! + if ($Sen=~ /^DATA\b/) { $Sen= &DATA($Sen); $Flag=1; } + if ($Sen=~ /^DIM\b/) { $Sen= &DIM($Sen); $Flag=1; } + if ($Sen=~ /^END\b/) { $Sen= &ENDD($Sen); $Flag=1; } + if ($Sen=~ /^FOR\b/) { $Sen= &FOR($Sen); $Flag=1; } + if ($Sen=~ /^GOTO\b/) { $Sen= &GOTO($Sen); $Flag=1; } + if ($Sen=~ /^GOSUB\b/) { $Sen= &GOSUB($Sen); $Flag=1; } + if ($Sen=~ /^IF\b/) { $Sen= &IF($Sen); $Flag=1; } + if ($Sen=~ /^INPUT\b/) { $Sen= &INPUT($Sen); $Flag=1; } + if ($Sen=~ /^NEXT\b/) { $Sen= &NEXT($Sen); $Flag=1; } + if ($Sen=~ /^ON\b/ && $Sen=~ / GOTO /) { $Sen= &ONGOTO($Sen); $Flag=1; } + if ($Sen=~ /^PRINT\b/) { $Sen= &PRINT($Sen); $Flag=1; } + if ($Sen=~ /^READ\b/) { $Sen= &READ($Sen); $Flag=1; } + if ($Sen=~ /^REM\b/) { $Sen= &REM($Sen); $Flag=1; } + if ($Sen=~ /^RETURN\b/) { $Sen= &RETURN($Sen); $Flag=1; } + if ($Sen=~ /^STOP\b/) { $Sen= &ENDD($Sen); $Flag=1; } + if ($Flag==0) { $Sen= &FORMULA($Sen); } + $Sen.=";"; + $Sen=~ s/\{;$/\{/g; + $Sen=~ s/\};$/\}/g; + $Perl.= "$Sen "; + } + $Perl= &TRIM($Perl); + return $Perl; + } + + + +#################### +# BASIC STATEMENTS # +#################### + +sub DATA { + my ($Str)= @_; + $Str=~ s/DATA //; + push @Data, $Str; + return "# TO DATA SEGMENT"; + } + +sub DIM { + my ($Str)= @_; + $Str=~ s/DIM //; + my @Parts= split(/\,(?![^\(]*\))/, $Str); + my $Out; + foreach my $Par (@Parts) { + $Par=~ s/\$//; + $Par=~ s/\(.*\)//; + $Out.= "my \@$Par; "; + $Vars{$Par}= "array"; + } + chop $Out; + chop $Out; + return $Out; + } + + +sub ENDD { + return "exit"; + } + + +sub FOR { + my ($Str)= @_; + $Str=~ s/= /=/g; + my @Parts= split(" ", $Str); + $Parts[1]= &FORMULA($Parts[1]); + my $Var=substr($Parts[1],0,index($Parts[1],"=")); + $Parts[3]= "$Var<=".&FORMULA($Parts[3]); + if ($Parts[5]<0) { $Parts[3]=~ s//; } + $Parts[5]= $Parts[5] eq "" ? "$Var++" : "$Var+=".&FORMULA($Parts[5]); + $Str= "for ($Parts[1]; $Parts[3]; $Parts[5]) {"; + return $Str; + } + + +sub GOTO { + my ($Str)= @_; + my @Parts= split(" ", $Str); + my $Label= "$LN$Parts[1]"; + $Str= lc($Parts[0])." $Label"; + $Code{($Parts[1]-.2)}=""; + $Code{($Parts[1]-.1)}="$Label:"; + return $Str; + } + + +sub GOSUB { + my ($Str)= @_; + my @Parts= split(" ", $Str); + my $Label= "$LN$Parts[1]"; + $Str= "\&$Label()"; + $Code{($Parts[1]-.2)}=""; + $Code{($Parts[1]-.1)}="sub $Label {"; + return $Str; + } + + +sub IF { + my ($Str)= @_; + $Str=~ s/^IF //g; + my @Parts= split(" THEN ", $Str); + $Parts[0]= &FORMULA($Parts[0], 1); + $Parts[1]= &PROCLINE($Parts[1]); + my $Str= "if ($Parts[0]) { $Parts[1] }"; + return $Str; + } + + +sub INPUT { + my ($Str)= @_; + $Str=~ s/INPUT //; + $Str=~ s/(".*")//g; + my $Ques; + if ($1) { + $Ques= $1; + $Ques=~ s/"//g; + } + + $Str=~ s/\$//g; + $Str=~ s/;//g; + $Str=~ s/\(/\[/g; + $Str=~ s/\)/\]/g; + my $Inp; + if ($Str=~ /,/) { + $Str= "\$$Str"; + $Str=~ s/,/,\$/g; + $Inp= "; ($Str)= split(/,/, \$Inp)"; + $Str= "Inp"; + } + $Str= "print \"$Ques? \"; chomp(\$$Str = uc())"; + return $Str.$Inp; + } + + +sub NEXT { + return "}"; + } + + +sub ONGOTO { + # Base 1, if not match it will be skipped. + my ($Str)= @_; + my @Parts= split(" ", $Str); + my $Var= $Parts[1]; + my @Lines= split(",", $Parts[3]); + my $Count=0; + my $Text; + foreach my $Lin (@Lines) { + $Count++; + my $This= "\telsif (\$$Var==$Count) "; + if ($Count==1) { $This= "if (\$$Var==1) "; } + + my $Goto= &GOTO("GOTO $Lin"); + $This.="{ $Goto; }\n"; + $Text.= $This; + } + return $Text; + } + + +sub PRINT { + my ($Str)= @_; + if ($Str eq "PRINT") { return 'print "\n"' }; + $Str=~ s/^PRINT //; + + my $Enter= 1; + if ($Str=~ /;$/) { $Enter= 0; } + + my $Out; + #my @Parts= split(/;/, $Str); + my @Parts= split(/;(?=(?;[^"]*"[^"]*")*[^"]*$)/g, $Str); + + foreach my $Par (@Parts) { + if ($Par=~ / TAB\((.*?)\);/) { + my $Num= &FORMULA($1); + $Par=~ s/ TAB\(.*\);/' 'x$Num . /; + } + if ($Par=~ /^[A-Z]/) { + $Par= &FIXVAR($Par); + } + $Out.= $Par.". "; + } + chop $Out; + chop $Out; + #$Str=~ s/"$/\\n"/; + #$Str=~ s/;$//; + #$Str=~ s/;/\./g; + #$Str=~ s/"$/\\n"/g; + #$Str=~ s/\.$//g; + if ($Enter) { $Out.= qq|. "\\n"|; } + return "print ".$Out; + } + + +sub READ { + my ($Str)= @_; + $Str=~ s/READ //; + $Str.="= "; + return $Str; + } + + +sub REM { + my ($Str)= @_; + return "#".$Str; + } + + +sub RETURN { + return "return; }"; + } + + +########### +# HELPERS # +########### + +sub TRIM { + my ($Str)= @_; + #$Str=~ s/\s+/ /g; + $Str=~ s/^\s+//; + $Str=~ s/\s+$//; + return $Str; + } + + +sub DATAIL { + print "\n\n\n"; + print "__DATA__\n"; + foreach my $Dat (@Data) { + $Dat=~ s/"//g; + $Dat=~ s/,/\n/g; + print "$Dat\n"; + } + } + + +sub FORMULA { + my ($Str, $Cond)= @_; + $Str=~ s/\$//g; + $Str=~ s/ABS\(/abs\(/; + $Str=~ s/COS\(/cos\(/; + $Str=~ s/LEN\(/length\(/; + $Str=~ s/INT\(/int\(/; + $Str=~ s/MID\$?\(/substr\(/; + $Str=~ s/RND\(/rand\(/; + $Str=~ s/SIN\(/sin\(/; + $Str=~ s/(\b[A-Z][0-9]?\b)/\$$&/g; + if ($Cond==1) { + $Str=~ s/<>/ ne /g; + $Str=~ s/=/ eq /g; + } + return $Str; + } + + +sub FIXVAR { + my ($Str)= @_; + $Str=~ s/\$//g; + $Str=~ s/(\w+)/\$$1/g; + $Str=~ s/\(/\[/g; + $Str=~ s/\)/\]/g; + $Str=~ s/,/\]\[/g; + return $Str; + } + + + From 6738ef25e1bbdf4d4edd49da138e025b67368208 Mon Sep 17 00:00:00 2001 From: Alex Gomez Date: Wed, 26 Jan 2022 18:44:56 -0600 Subject: [PATCH 2/3] Automatic converted with bas2perl.pl --- 69_Pizza/perl/pizza.pl | 113 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 113 insertions(+) create mode 100755 69_Pizza/perl/pizza.pl diff --git a/69_Pizza/perl/pizza.pl b/69_Pizza/perl/pizza.pl new file mode 100755 index 00000000..7147ad49 --- /dev/null +++ b/69_Pizza/perl/pizza.pl @@ -0,0 +1,113 @@ +#!/usr/bin/perl +#use strict; +# Automatic converted by bas2perl.pl + +print ' 'x33 . "PIZZA". "\n"; +print ' 'x15 . "CREATIVE COMPUTING MORRISTOWN, NEW JERSEY". "\n"; +print "\n"; print "\n"; print "\n"; +my @S; my @M; +print "PIZZA DELIVERY GAME". "\n"; print "\n"; +print "WHAT IS YOUR FIRST NAME? "; chomp($N = uc()); print "\n"; +print "HI, ". $N. ". IN THIS GAME YOU ARE TO TAKE ORDERS". "\n"; +print "FOR PIZZAS. THEN YOU ARE TO TELL A DELIVERY BOY". "\n"; +print "WHERE TO DELIVER THE ORDERED PIZZAS.". "\n"; print "\n"; print "\n"; +for ($I=1; $I<=16; $I++) { +$S[$I]= ; chomp($S[$I]);; +} +for ($I=1; $I<=4; $I++) { +$M[$I]= ; chomp($M[$I]);; +} +# TO DATA SEGMENT; +# TO DATA SEGMENT; +print "MAP OF THE CITY OF HYATTSVILLE". "\n"; print "\n"; +print " -----1-----2-----3-----4-----". "\n"; +$K=4; +for ($I=1; $I<=4; $I++) { +print "-". "\n"; print "-". "\n"; print "-". "\n"; print "-". "\n"; +print $M[$K]; +$S1=16-4*$I+1; +print " ". $S[$S1]. " ". $S[$S1+1]. " ". $S[$S1+2]. " "; +print $S[$S1+3]. " ". $M[$K]. "\n"; +$K=$K-1; +} +print "-". "\n"; print "-". "\n"; print "-". "\n"; print "-". "\n"; +print " -----1-----2-----3-----4-----". "\n"; print "\n"; +print "THE OUTPUT IS A MAP OF THE HOMES WHERE". "\n"; +print "YOU ARE TO SEND PIZZAS.". "\n"; print "\n"; +print "YOUR JOB IS TO GIVE A TRUCK DRIVER". "\n"; +print "THE LOCATION OR COORDINATES OF THE". "\n"; +print "HOME ORDERING THE PIZZA.". "\n"; print "\n"; + +Line520: +print "DO YOU NEED MORE DIRECTIONS? "; chomp($A = uc()); +if ($A eq "YES") { goto Line590; } +if ($A eq "NO") { goto Line750; } +print "'YES' OR 'NO' PLEASE, NOW THEN,". "\n"; goto Line520; + +Line590: +print "\n"; print "SOMEBODY WILL ASK FOR A PIZZA TO BE". "\n"; +print "DELIVERED. THEN A DELIVERY BOY WILL". "\n"; +print "ASK YOU FOR THE LOCATION.". "\n"; print " EXAMPLE:". "\n"; +print "THIS IS J. PLEASE SEND A PIZZA.". "\n"; +print "DRIVER TO ". $N. ". WHERE DOES J LIVE?". "\n"; +print "YOUR ANSWER WOULD BE 2,3". "\n"; print "\n"; +print "UNDERSTAND? "; chomp($A = uc()); +if ($A eq "YES") { goto Line690; } +print "THIS JOB IS DEFINITELY TOO DIFFICULT FOR YOU. THANKS ANYWAY". "\n"; +goto Line999; + +Line690: +print "GOOD. YOU ARE NOW READY TO START TAKING ORDERS.". "\n"; print "\n"; +print "GOOD LUCK!!". "\n"; print "\n"; + +Line750: +for ($I=1; $I<=5; $I++) { +$S=int(rand(1)*16+1); print "\n"; +print "HELLO ". $N. "'S PIZZA. THIS IS ". $S[$S]. "."; +print " PLEASE SEND A PIZZA.". "\n"; + +Line780: +print " DRIVER TO ". $N. ": WHERE DOES ". $S[$S]. " LIVE"; +print "? "; chomp($Inp_ = uc()); ($A[1],$A[2])= split(/,/, $Inp_); +$T=$A[1]+($A[2]-1)*4; +if ($T eq $S) { goto Line920; } +print "THIS IS ". $S[$T]. ". I DID NOT ORDER A PIZZA.". "\n"; +print "I LIVE AT ". $A[1]. ",". $A[2]. "\n"; +goto Line780; + +Line920: +print "HELLO ". $N. ". THIS IS ". $S[$S]. ", THANKS FOR THE PIZZA.". "\n"; +} +print "\n"; print "DO YOU WANT TO DELIVER MORE PIZZAS? "; chomp($A = uc()); +if ($A eq "YES") { goto Line750; } +print "\n"; print "O.K. ". $N. ", SEE YOU LATER!". "\n"; print "\n"; + +Line999: +exit; + + + +__DATA__ +A +B +C +D +E +F +G +H +I +J +K +L +M +N +O +P +1 +2 +3 +4 + + + From 24a9655b24af86c6d70d9b4db016cc59c33820b6 Mon Sep 17 00:00:00 2001 From: Alex Gomez Date: Wed, 26 Jan 2022 18:48:28 -0600 Subject: [PATCH 3/3] Simple tool to convert BASIC file to Perl code. --- 00_Utilities/bas2perl.pl | 330 +-------------------------------------- 1 file changed, 1 insertion(+), 329 deletions(-) mode change 100755 => 120000 00_Utilities/bas2perl.pl diff --git a/00_Utilities/bas2perl.pl b/00_Utilities/bas2perl.pl deleted file mode 100755 index 2df1b5dc..00000000 --- a/00_Utilities/bas2perl.pl +++ /dev/null @@ -1,329 +0,0 @@ -#!/usr/bin/perl -use strict; - - -my $Mode= lc($ARGV[0]); #trace #convert -my $File= $ARGV[1]; -my $LN= "Line"; - -my %Vars; -my @Data; -my %Code; -open(FH, $File); -while (my $Line = ) { - chomp $Line; - my $Space= index($Line, " "); - my $Key= substr($Line, 0, $Space); - my $Code= substr($Line, $Space+1); - $Code{$Key}=$Code; - } -close(FH); - - -foreach my $Lin (sort {$a<=>$b} keys %Code) { - if ($Mode eq "trace") { print "==> $Lin $Code{$Lin}\n"; } - my $Ret= &PROCLINE($Code{$Lin}); - if ($Mode eq "trace") { print " $Ret\n"; } - $Code{$Lin}= $Ret; - } - - -if ($Mode eq "convert") { - $Code{'0.1'}= "#!/usr/bin/perl"; - $Code{'0.2'}= "#use strict;"; - $Code{'0.3'}= "# Automatic converted by bas2perl.pl"; - $Code{'0.4'}= ""; - foreach my $Lin (sort {$a<=>$b} keys %Code) { - print "$Code{$Lin}\n"; - } - } - - if (@Data) { &DATAIL(); } - print "\n\n\n"; - - -exit; - - - -#print @Lines; - -sub PROCLINE { - my ($Line)= @_; - #my @Sente= split(/:/, $Line); - #my @Sente= split(/\:(?=([^"]*"[^"]*")*[^"]*$)/g, $Line); - my @Sente= split(/:(?=(?:[^"]*"[^"]*")*[^"]*$)/g, $Line); - - my $Perl; - foreach my $Sen (@Sente) { - #if ($Sen eq "") { next; } # Somehow the regex gives empty items between. - my $Flag=0; - $Sen= &TRIM($Sen); - if ($Sen>0) { $Sen= "GOTO $Sen"; } #The birth of spaguetti code! - if ($Sen=~ /^DATA\b/) { $Sen= &DATA($Sen); $Flag=1; } - if ($Sen=~ /^DIM\b/) { $Sen= &DIM($Sen); $Flag=1; } - if ($Sen=~ /^END\b/) { $Sen= &ENDD($Sen); $Flag=1; } - if ($Sen=~ /^FOR\b/) { $Sen= &FOR($Sen); $Flag=1; } - if ($Sen=~ /^GOTO\b/) { $Sen= &GOTO($Sen); $Flag=1; } - if ($Sen=~ /^GOSUB\b/) { $Sen= &GOSUB($Sen); $Flag=1; } - if ($Sen=~ /^IF\b/) { $Sen= &IF($Sen); $Flag=1; } - if ($Sen=~ /^INPUT\b/) { $Sen= &INPUT($Sen); $Flag=1; } - if ($Sen=~ /^NEXT\b/) { $Sen= &NEXT($Sen); $Flag=1; } - if ($Sen=~ /^ON\b/ && $Sen=~ / GOTO /) { $Sen= &ONGOTO($Sen); $Flag=1; } - if ($Sen=~ /^PRINT\b/) { $Sen= &PRINT($Sen); $Flag=1; } - if ($Sen=~ /^READ\b/) { $Sen= &READ($Sen); $Flag=1; } - if ($Sen=~ /^REM\b/) { $Sen= &REM($Sen); $Flag=1; } - if ($Sen=~ /^RETURN\b/) { $Sen= &RETURN($Sen); $Flag=1; } - if ($Sen=~ /^STOP\b/) { $Sen= &ENDD($Sen); $Flag=1; } - if ($Flag==0) { $Sen= &FORMULA($Sen); } - $Sen.=";"; - $Sen=~ s/\{;$/\{/g; - $Sen=~ s/\};$/\}/g; - $Perl.= "$Sen "; - } - $Perl= &TRIM($Perl); - return $Perl; - } - - - -#################### -# BASIC STATEMENTS # -#################### - -sub DATA { - my ($Str)= @_; - $Str=~ s/DATA //; - push @Data, $Str; - return "# TO DATA SEGMENT"; - } - -sub DIM { - my ($Str)= @_; - $Str=~ s/DIM //; - my @Parts= split(/\,(?![^\(]*\))/, $Str); - my $Out; - foreach my $Par (@Parts) { - $Par=~ s/\$//; - $Par=~ s/\(.*\)//; - $Out.= "my \@$Par; "; - $Vars{$Par}= "array"; - } - chop $Out; - chop $Out; - return $Out; - } - - -sub ENDD { - return "exit"; - } - - -sub FOR { - my ($Str)= @_; - $Str=~ s/= /=/g; - my @Parts= split(" ", $Str); - $Parts[1]= &FORMULA($Parts[1]); - my $Var=substr($Parts[1],0,index($Parts[1],"=")); - $Parts[3]= "$Var<=".&FORMULA($Parts[3]); - if ($Parts[5]<0) { $Parts[3]=~ s//; } - $Parts[5]= $Parts[5] eq "" ? "$Var++" : "$Var+=".&FORMULA($Parts[5]); - $Str= "for ($Parts[1]; $Parts[3]; $Parts[5]) {"; - return $Str; - } - - -sub GOTO { - my ($Str)= @_; - my @Parts= split(" ", $Str); - my $Label= "$LN$Parts[1]"; - $Str= lc($Parts[0])." $Label"; - $Code{($Parts[1]-.2)}=""; - $Code{($Parts[1]-.1)}="$Label:"; - return $Str; - } - - -sub GOSUB { - my ($Str)= @_; - my @Parts= split(" ", $Str); - my $Label= "$LN$Parts[1]"; - $Str= "\&$Label()"; - $Code{($Parts[1]-.2)}=""; - $Code{($Parts[1]-.1)}="sub $Label {"; - return $Str; - } - - -sub IF { - my ($Str)= @_; - $Str=~ s/^IF //g; - my @Parts= split(" THEN ", $Str); - $Parts[0]= &FORMULA($Parts[0], 1); - $Parts[1]= &PROCLINE($Parts[1]); - my $Str= "if ($Parts[0]) { $Parts[1] }"; - return $Str; - } - - -sub INPUT { - my ($Str)= @_; - $Str=~ s/INPUT //; - $Str=~ s/(".*")//g; - my $Ques; - if ($1) { - $Ques= $1; - $Ques=~ s/"//g; - } - - $Str=~ s/\$//g; - $Str=~ s/;//g; - $Str=~ s/\(/\[/g; - $Str=~ s/\)/\]/g; - my $Inp; - if ($Str=~ /,/) { - $Str= "\$$Str"; - $Str=~ s/,/,\$/g; - $Inp= "; ($Str)= split(/,/, \$Inp)"; - $Str= "Inp"; - } - $Str= "print \"$Ques? \"; chomp(\$$Str = uc())"; - return $Str.$Inp; - } - - -sub NEXT { - return "}"; - } - - -sub ONGOTO { - # Base 1, if not match it will be skipped. - my ($Str)= @_; - my @Parts= split(" ", $Str); - my $Var= $Parts[1]; - my @Lines= split(",", $Parts[3]); - my $Count=0; - my $Text; - foreach my $Lin (@Lines) { - $Count++; - my $This= "\telsif (\$$Var==$Count) "; - if ($Count==1) { $This= "if (\$$Var==1) "; } - - my $Goto= &GOTO("GOTO $Lin"); - $This.="{ $Goto; }\n"; - $Text.= $This; - } - return $Text; - } - - -sub PRINT { - my ($Str)= @_; - if ($Str eq "PRINT") { return 'print "\n"' }; - $Str=~ s/^PRINT //; - - my $Enter= 1; - if ($Str=~ /;$/) { $Enter= 0; } - - my $Out; - #my @Parts= split(/;/, $Str); - my @Parts= split(/;(?=(?;[^"]*"[^"]*")*[^"]*$)/g, $Str); - - foreach my $Par (@Parts) { - if ($Par=~ / TAB\((.*?)\);/) { - my $Num= &FORMULA($1); - $Par=~ s/ TAB\(.*\);/' 'x$Num . /; - } - if ($Par=~ /^[A-Z]/) { - $Par= &FIXVAR($Par); - } - $Out.= $Par.". "; - } - chop $Out; - chop $Out; - #$Str=~ s/"$/\\n"/; - #$Str=~ s/;$//; - #$Str=~ s/;/\./g; - #$Str=~ s/"$/\\n"/g; - #$Str=~ s/\.$//g; - if ($Enter) { $Out.= qq|. "\\n"|; } - return "print ".$Out; - } - - -sub READ { - my ($Str)= @_; - $Str=~ s/READ //; - $Str.="= "; - return $Str; - } - - -sub REM { - my ($Str)= @_; - return "#".$Str; - } - - -sub RETURN { - return "return; }"; - } - - -########### -# HELPERS # -########### - -sub TRIM { - my ($Str)= @_; - #$Str=~ s/\s+/ /g; - $Str=~ s/^\s+//; - $Str=~ s/\s+$//; - return $Str; - } - - -sub DATAIL { - print "\n\n\n"; - print "__DATA__\n"; - foreach my $Dat (@Data) { - $Dat=~ s/"//g; - $Dat=~ s/,/\n/g; - print "$Dat\n"; - } - } - - -sub FORMULA { - my ($Str, $Cond)= @_; - $Str=~ s/\$//g; - $Str=~ s/ABS\(/abs\(/; - $Str=~ s/COS\(/cos\(/; - $Str=~ s/LEN\(/length\(/; - $Str=~ s/INT\(/int\(/; - $Str=~ s/MID\$?\(/substr\(/; - $Str=~ s/RND\(/rand\(/; - $Str=~ s/SIN\(/sin\(/; - $Str=~ s/(\b[A-Z][0-9]?\b)/\$$&/g; - if ($Cond==1) { - $Str=~ s/<>/ ne /g; - $Str=~ s/=/ eq /g; - } - return $Str; - } - - -sub FIXVAR { - my ($Str)= @_; - $Str=~ s/\$//g; - $Str=~ s/(\w+)/\$$1/g; - $Str=~ s/\(/\[/g; - $Str=~ s/\)/\]/g; - $Str=~ s/,/\]\[/g; - return $Str; - } - - - diff --git a/00_Utilities/bas2perl.pl b/00_Utilities/bas2perl.pl new file mode 120000 index 00000000..5f21f3db --- /dev/null +++ b/00_Utilities/bas2perl.pl @@ -0,0 +1 @@ +/home/nezumi/bin/bas2perl.pl \ No newline at end of file