diff options
Diffstat (limited to 'ktouch/extras/training-gen/perl/ktouch-gen.pl')
| -rwxr-xr-x | ktouch/extras/training-gen/perl/ktouch-gen.pl | 180 |
1 files changed, 180 insertions, 0 deletions
diff --git a/ktouch/extras/training-gen/perl/ktouch-gen.pl b/ktouch/extras/training-gen/perl/ktouch-gen.pl new file mode 100755 index 00000000..901df6e0 --- /dev/null +++ b/ktouch/extras/training-gen/perl/ktouch-gen.pl @@ -0,0 +1,180 @@ +#!/usr/bin/perl -w --strict + +# default values +$length_of_line = 60; +$number_of_line = 30; + + +# genword( accumulated, core ) +# This function will generate a random sequens of character +# containing only characters from accum or core and all words +# generated will contain at lest on character from core +sub genword +{ + (my $accum, my $core) = @_; + + my $all=$accum.$core; + my $res=""; + + for(my $i=0;$i<=rand(5);$i++) + { + my $ran_pos=int(rand(length($all))); + $res=$res.substr($all,$ran_pos,1); + } + + # check if we have generated a walid word, containig some characters from $core + if ($res =~ m/[$core]/) + { + return $res; + } + else + { + return genword($accum,$core); + } +} + +# This function will return a list of words containing only characters from +# accum or core. And all words will contain at lest on echaracter from core. +# If we can't find enough words, we will use genword to generate enough words +# to fill the list. +sub genlist +{ + ($accum, $core) = @_; + my @res; + + my $all=$accum.$core; + + + #print "$core\n"; + + foreach(@word_list) + { + chomp($_); + if (m/[$core]/ && m/^[($all)][$all]*$/) + { + push @res,$_; + } + } + + for(my $i=@res;$i<30;$i++) + { + push @res,genword($accum,$core); + } + + return @res; +} + + +# Genlevel will generate a level +sub genlevel +{ + ($accum, $core) = @_; + my $res = ""; + my @list = genlist($accum,$core); + my $max_lines = $number_of_line; + my $max_length = $length_of_line; + while($max_lines >0) + { + my $tmp=$list[rand(@list)-1]; + $res = $res.$tmp; # first word on line should not have space + while($max_length >0) + { + my $tmp=$list[rand(@list)-1]; + $res = $res." ".$tmp; + $max_length = $max_length - (length($tmp) + 1); # +1 is for counting one extra space for each word + } + $res = $res."\n"; + $max_length = $length_of_line; + $max_lines = $max_lines - 1; + } + return $res; +} + +sub rrr +{ + print "."; + s/\\/\\\\/g; #remove escape character... + s/-/\\-/g; #remove any - since this will mean range + s/ //g; + return $_; +} + +sub heading +{ + return + "######################################################################\n". + "##\n". + "# KTouch training file generated ".localtime(time())."\n". + "#\n". + "# Perl Script written by Steinar Theigmann & Håvard Frøiland.\n". + "#\n"; +} + +sub usage +{ + return + "\n". + "usage: ktouch-gen config_file\n". + " Example: ./ktouch-gen english-conf < english-word-file\n". + "\n"; +} + +# --------------------- START ---------------------------- + +if(@ARGV == 0) # exit if there is no config_file specified +{ + die usage; +} + +open(CONFIG,$ARGV[0]) # First argument should be config file + or die "\ nCan't find config_file: $ARGV[0]\n\n"; + +# Read in all elements in config file +while (<CONFIG>) +{ + chomp($_); + + if(s/length\-of\-line//) + { + $length_of_line = $_; + } + elsif(s/number\-of\-line//) + { + $number_of_line = $_; + } + elsif($_) # Add to config if not empty + { + push @config,$_; + } +} + +#foreach(@config) +#{ +# print "$_\n"; +#} +#exit 0; + +# Read in all words +while (<STDIN>) +{ + chomp($_); + if(length($_)>0) + { + push @word_list, $_; + } +} + +print heading; + +$accum=""; +$count=0; +foreach(@config) +{ + $count++; + print "# Level $count\n"; + print "$_\n"; + print genlevel($accum,$_); + $accum=$accum.$_; + print "\n\n"; +} + |