view release on metacpan or  search on metacpan

lib/App/GUI/Juliagraph/Compute/Image.pm  view on Meta::CPAN

    my $metric_code = {
        '|var|' => '$zqa + $zqb',      '|x*y|' => 'abs($za * $zb)',
          '|x|' => 'abs($za)',           '|y|' => 'abs($zb)',
        '|x+y|' => 'abs($za + $zb)', '|x|+|y|' => 'abs($za) + abs($zb)',
         'x+y'  => '$za + $zb',         'x*y'  => '$za * $zb',
         'x-y'  => '$za - $zb',         'y-x'  => '$za - $zb'}->{ $set->{'constraint'}{'stop_metric'} };

    my @bailout_code = (
        '      $metrik = '.$metric_code,
    ($set->{'mapping'}{'use_subgradient'})
     ? ('      $metrik = $color_index_max - 1 if $metrik >= $color_index_max',
        '      $color = $colors->[ $i ][$metrik-$schranke], last if $metrik >= $schranke' )
     :  '      $color = $colors->[ $i ], last if $metrik >= $schranke'
    );

    my @paint_code;
    if ($sketch_factor){
        push @paint_code, '    $px = $pixel_x * '.$sketch_factor, '    $py = $pixel_y * '.$sketch_factor;
        for my $x (0 .. $sketch_factor -1){
            for my $y (0 .. $sketch_factor -1){
                push @paint_code, '    $img->SetRGB( $px+'.$x.', $py+'.$y.', @$color)';
            }
        }
    } else {
        push @paint_code, '    $img->SetRGB( $pixel_x, $pixel_y, @$color)';
    }

    my (@z, $za, $zb, $zqa, $zqb, $color, $px, $py, $metrik);
    my $x = $offset_x;
    my @code = (
        'for my $pixel_x (0 .. $max_pixel_x){',
        '  my $y = $offset_y',
        '  for my $pixel_y (0 .. $max_pixel_y){',
       ($set->{'constraint'}{'coor_as_start'} ?
        '    ($za, $zb) = ($start_a + $x, $start_b + $y)' :
        '    ($za, $zb) = ($start_a, $start_b)' ),
        '    $zqa = $za * $za',
        '    $zqb = $zb * $zb',
        '    $color = $background_color',
        '    for my $i (0 .. $max_iter - 1){',
        '      ($z[2][0], $z[2][1]) = ($zqa - $zqb, 2 * $za * $zb)',
        @monomial_code,
        ($set->{'constraint'}{'coor_as_const'} ?
       ('      $za += $x + '.$const_a,
        '      $zb += $y + '.$const_b) :
       ('      $za += '.$const_a,
        '      $zb += '.$const_b,    ) ),
        '      $zqa = $za * $za',
        '      $zqb = $zb * $zb',
        @bailout_code,
        '    }', @paint_code,
        '    $y += $delta_y',
        '  }',
        '  $x += $delta_x',
        '}',
    );

    my $code = join '', map { $_ . ";\n"} @code;
    eval $code;
    die "bad iter code - $@ :\n$code" if $@; # say $code;
    #say "compile:",timestr(timediff(Benchmark->new, $t0));

    return $img;
}

1;