App-GUI-Cellgraph

 view release on metacpan or  search on metacpan

lib/App/GUI/Cellgraph/Compute/Grid.pm  view on Meta::CPAN

                    ') ? '.$next_result.' : $cell_states[$_] ' if $state->{'global'}{'action_rules_apply'};


    my $code =     'for my $row_nr (1 .. '.($compute_rows - 1).') {'."\n".
                   (($state->{'global'}{'action_spread'}) ? '  my @action_spread = @init_spread;'."\n" :'').
                   '  @prev_states = @cell_states;'."\n";


    my $code_end = '  @cell_states = map { $subrule_occur[ $subrule_nr[$_] ]++;'.$next_result.' } 0 .. '.($grid_size-1).";\n\n".
                   '  $state_grid->[$row_nr] = [@cell_states];'."\n".'}';

    if ($state->{'global'}{'action_rules_apply'}){
        $code .=    '  @prev_action = @cell_action;'."\n";
        my $calc_action = '  @cell_action = map { $action_result_from_subrule[$_] } @subrule_nr'.";\n".
                          '  @cell_action = map { $cell_action[$_] + $prev_action[$_] + '.$state->{'global'}{'action_change'}.' } 0 .. '.($grid_size-1).";\n";
        $calc_action.= '  for my $x ( 0 .. '.($grid_size-1).' ) { '."\n".
                       '    my $real_pos = $x + '.$state->{'global'}{'action_spread'}.";\n".
                       '    my $action = $cell_action[$x];'."\n".
                       '    my $delta = my $decrease = $action_spread_decrease[ $subrule_nr[$x] ];'."\n".
                       '    for my $d (1..'.$state->{'global'}{'action_spread'}.') { '."\n".
                       '      $action_spread[$real_pos + $d ] += $action + $delta;'."\n".
                       '      $action_spread[$real_pos - $d ] += $action - $delta;'."\n".
                       '      $delta += $decrease'."\n".
                       '  }}'."\n".
                       '  @cell_action = map { $cell_action[$_] + $action_spread[$_+'.$state->{'global'}{'action_spread'}.'] } 0 .. '.($grid_size-1).";\n"
                          if $state->{'global'}{'action_spread'};

        $calc_action   .= '  @cell_action = map { ($_ < 0) ? 0 : ($_ > 1) ? 1 : $_ } @cell_action'.";\n";
        $code_end = $calc_action . $code_end;
    }

    my $wrap_overhang = 'join("", @prev_states[-'.$input_overhang.' .. -1])';
    my $right_overhang = 'join("", @prev_states[0 .. '.$input_overhang.'-1])';

    if ($self_input) {
        my $eval_pattern = '$subrule_from_pattern{ $pattern }';
        $code .= '  my $pattern = "0".'
              .($grid_circular ? $wrap_overhang : $row_start).'.'.$right_overhang.";\n"
              .'  for my $x_pos (0 .. '.$compute_right_stop.'){'."\n"
              .'  '.move_pattern_string('$pattern','$x_pos+'.$input_overhang)
              .'    $subrule_nr[$x_pos] = '.$eval_pattern.";\n  }\n"
              .'  for my $x_pos ('.($compute_right_stop + 1).' .. '.($grid_size - 1).'){'."\n"
              .'  '.move_pattern_string('$pattern', ($grid_circular ? '$x_pos+'.($input_overhang - $grid_size) : undef ))
              .'    $subrule_nr[$x_pos] = '.$eval_pattern.";\n  }\n\n";
    } else {
        my $eval_pattern = '$subrule_from_pattern{ $left_pattern.$right_pattern }';
        $code .= '  my $left_pattern = '.($grid_circular ? $wrap_overhang : $row_start).";\n"
              .  '  my $right_pattern = join("", @prev_states[1 .. '.$input_overhang.']);'."\n"
              .  '  $subrule_nr[0] = '.$eval_pattern.";\n\n"
              .  '  for my $x_pos (1 .. '.$compute_right_stop.'){'."\n"
              .  '  '.move_pattern_string('$left_pattern','$x_pos-1')
              .  '  '.move_pattern_string('$right_pattern','$x_pos+'.$input_overhang)
              .  '    $subrule_nr[$x_pos] = '.$eval_pattern.";\n  }\n"
              .  '  for my $x_pos ('.($compute_right_stop+1).' .. '.($grid_size - 1).'){'."\n"
              .  '  '.move_pattern_string('$left_pattern','$x_pos-1')
              .  '  '.move_pattern_string('$right_pattern', ($grid_circular ? '$x_pos+'.($input_overhang - $grid_size) : undef) )
              .  '    $subrule_nr[$x_pos] = '.$eval_pattern.";\n  }\n\n";
    }


    my $result = eval( $code . $code_end); # say $code . $code_end;
    say "compile in code:\n$code\n\n error: $@" if $@;
    # say "got grid in:",timestr( timediff(Benchmark->new, $t0) );
    $rules_tab->update_subrule_occurance( @subrule_occur );

    if ($sketch_length){
        $state_grid->[$_] = [@empty_row] for $compute_rows .. $grid_size - 1;
        return $state_grid;
    }
    return $state_grid if $grow_direction eq 'top_down';

    # implementing paint directions
    if ($grow_direction eq 'inside_out') {
        $paint_grid->[$half_grid_size][$half_grid_size]
            = $state_grid->[0][$half_grid_size] if $odd_grid_size;      # center cell state

        for my $y_pos ($odd_grid_size .. $half_grid_size - 1 + $odd_grid_size){
            my $cy_pos = $half_grid_size - $y_pos - 1 + $odd_grid_size; # mirror on Center pos
            my $dy_pos = $half_grid_size + $y_pos;
            for my $x_pos ($half_grid_size - $y_pos .. $half_grid_size + $y_pos){
                my $bx_pos = $grid_size - 1 - $x_pos;
                $paint_grid->[$cy_pos][$bx_pos] = $paint_grid->[$bx_pos][$dy_pos] =
                $paint_grid->[$dy_pos] [$x_pos] = $paint_grid-> [$x_pos][$cy_pos] = $state_grid->[$y_pos][$x_pos];
            }
        }
    }
    if ($grow_direction eq 'outside_in') {
        $paint_grid->[$half_grid_size][$half_grid_size]
            = $state_grid->[$half_grid_size][$half_grid_size] if $odd_grid_size; # center cell state

        for my $y_pos (0 .. $half_grid_size - 1){
            my $by_pos = $grid_size - 1 - $y_pos;
            for my $x_pos ($y_pos .. $by_pos - 1){
                my $bx_pos = $grid_size - 1 - $x_pos;
                $paint_grid->[$y_pos] [$x_pos]  = $paint_grid->[$x_pos] [$by_pos] =
                $paint_grid->[$by_pos][$bx_pos] = $paint_grid->[$bx_pos][$y_pos]  = $state_grid->[$y_pos][$x_pos];
            }
        }
    }
    $paint_grid;
}

sub move_pattern_string {
    my ($var, $index) = @_;
    my $str = '  '.$var.' = substr('.$var.',1).';
    $str .= (defined $index) ? '$prev_states['.$index.']': "'0'";
    return $str.";\n";
}

1;
__END__



( run in 2.022 seconds using v1.01-cache-2.11-cpan-d7a12ab2c7f )