# Salmon.pm 
#
# Copyright 2015 David Meyer <papa@sdf.org> +JMJ
# 
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
# 
#     http://www.apache.org/licenses/LICENSE-2.0
# 
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.

package Salmon;

#use strict; 
use warnings;

my @tcsoz = ('12345', 'qwert', 'asdfgzxcvb', '67890', 'yuiop', 'hjklnm', '-^\\', '@[', ';:],./', '!"#$%', 'QWERT', 'ASDFGZXCVB', '&\'()', 'YUIOP', 'HJKLNM', '=~|', '`{', '+*}<>?_' );

my %hizoc = ('1' => 0, '2' => 0, '3' => 0, '4' => 0, '5' => 0,
	     'q' => 1, 'w' => 1, 'e' => 1, 'r' => 1, 't' => 1,
	     'a' => 2, 's' => 2, 'd' => 2, 'f' => 2, 'g' => 2, 'z' => 2, 'x' => 2, 'c' => 2, 'v' => 2, 'b' => 2,
	     '6' => 3, '7' => 3, '8' => 3, '9' => 3, '0' => 3,
	     'y' => 4, 'u' => 4, 'i' => 4, 'o' => 4, 'p' => 4,
	     'h' => 5, 'j' => 5, 'k' => 5, 'l' => 5, 'n' => 5, 'm' => 5,
	     '-' => 6, '^' => 6, '\\' => 6,
	     '@' => 7, '[' => 7,
	     ';' => 8, ':' => 8, ']' => 8, ',' => 8, '.' => 8, '/' => 8,
	     '!' => 9, '"' => 9, '#' => 9, '$' => 9, '%' => 9,
	     'Q' => 10, 'W' => 10, 'E' => 10, 'R' => 10, 'T' => 10,
	     'A' => 11, 'S' => 11, 'D' => 11, 'F' => 11, 'G' => 11, 'Z' => 11, 'X' => 11, 'C' => 11, 'V' => 11, 'B' => 11,
	     '&' => 12, "'" => 12, '(' => 12, ')' => 12,
	     'Y' => 13, 'U' => 13, 'I' => 13, 'O' => 13, 'P' => 13,
	     'H' => 14, 'J' => 14, 'K' => 14, 'L' => 14, 'N' => 14, 'M' => 14,
	     '=' => 15, '~' => 15, '|' => 15,
	     '`' => 16, '{' => 16,
	     '+' => 17, '*' => 17, '}' => 17, '<' => 17, '>' => 17, '?' => 17, '_' => 17); 

my @uanzoz = ([3,4,5,6,7,8],
	      [3,4,5,6,7,8],
	      [3,4,5,6,7,8,12,13,14,15,16,17],
	      [0,1,2],
	      [0,1,2],
	      [0,1,2,9,10,11],
	      [0,1,2],
	      [0,1,2],
	      [0,1,2,9,10,11],
	      [5,8],
	      [5,8],
	      [5,8,14,17],
	      [2],
	      [2],
	      [2,11],
	      [2],
	      [2],
	      [2,11]);

my @uapzoz = ([4,5], 
	      [4,5],
	      [4,5,13,14],
	      [1,2],
	      [1,2],
	      [1,2,10,11],
	      [1,2],
	      [1,2],
	      [1,2,10,11],
	      [5],
	      [5],
	      [5,14],
	      [2],
	      [2],
	      [11],
	      [2],
	      [2],
	      [2,11]);

sub crpos
{
    my $s = shift @_;
    return substr ($s, int (rand (length $s)), 1);
}

sub scatcsoz
{
    my $s = '';
    for my $z (@_)
    {
	$s .= $tcsoz[$z];
    }
    return $s;
}

sub spawn
{
    my $nc = shift @_;
    # Raise error if $nc < 4?

    my $s;
    our $cond1 = our $cond2 = our $cond3 = our $cond4 = 0;
    while (!$cond1 || $cond2 != 1 || $cond3 != 1 || $cond4 != 1)
    {
	$cond1 = $cond2 = $cond3 = $cond4 = 0;
	# Generate first character ...
	if (int (rand 2))
	{
	    $s = crpos (scatcsoz 0, 1, 2, 9, 10, 11);
	}
	else
	{
	    $s = crpos (scatcsoz 3, 4, 5, 6, 7, 8, 12, 13, 14, 15, 16, 17);
	}
	test (substr $s, 0, 1);

	# Generate character sequence ...
	foreach (0 .. $nc-2)
	{
#print "debug #120: /$s/ length:",length $s," last:",substr ($s, length ($s)-1, 1),"\n";
	    $s .= crpos (scatcsoz @{$uanzoz[$hizoc{substr $s, -1}]});
	    test (substr $s, length ($s)-1, 1);
	}
#	print STDERR "debug: s=$s 1=$cond1 2=$cond2 3=$cond3 4=$cond4\n";

    }
    return $s;
}

sub test
{
    my $c = shift @_;
    my $z = $hizoc{$c};
#    print "debug: test c=$c z=$z\n";
    if (grep "$_" eq "$z", (1, 2, 4, 5))
    {
	our $cond1 ++;
    }
    elsif (grep "$_" eq "$z", (10, 11, 13, 14))
    {
	our $cond2 ++;
    }
    elsif (grep "$_" eq "$z", (0, 3))
    {
	our $cond3 ++;
    }
    elsif (grep "$_" eq "$z", (6, 7, 8, 9, 12, 15, 16, 17))
    {
	our $cond4 ++;
    }
}

1;

# Emacs control #####################################################
#Local variables:
#mode: perl
#End: