view release on metacpan or  search on metacpan

lib/Games/Sudoku/Preset.pm  view on Meta::CPAN

        # delete old digit
        $cell->cellvalue('');
        $valuecount--;
    }

    return;
}

sub show_initial_count {
    $valuecount = shift;
    return;
}

# ====================================================================
# clickfield stuff
# ====================================================================

sub _create_clickfield {
    my $mw = shift;

    $clickfield = $mw->Toplevel( -width => $fieldsize, -height => $fieldsize );
    $clickfield->overrideredirect(1);    # suppress window frame
    foreach my $i ( 0 .. 2 ) {
        foreach my $j ( 0 .. 2 ) {
            _create_tinysquare( $j, $i );
        }
    }
    $clickfield->withdraw;               # make clickfield invisible
    # make clickfield invisible when the window gets moved
    $mw->bind( '<Configure>' => sub {$clickfield->withdraw} );
    return;
}

sub _create_tinysquare {
    my ( $w, $h ) = my ( $w_num, $h_num ) = @_;    # pos. num.s of tiny square
    $w *= $tinysize + 1;                           # pos. of tiny square
    $h *= $tinysize + 1;                           #

    # first create a square Frame to force a square Button in it
    my $space = $clickfield->Frame( -width => $tinysize, -height => $tinysize )
      ->place( -x => $w, -y => $h );
    $space->packPropagate(0);                      # prevent resizing the frame
    my $tiny = $space->Button(
                      -relief     => 'flat',
                      -background => 'black',
                      -command => [\&_change_my_digit, $w_num + 3 * $h_num + 1],
    )->pack( -fill => 'both', -expand => 1 );
    push( @tiny_fields, $tiny );
    return;
}

# position the clickfield over the entered sudoku field
# callback of the <Enter> event
#
sub _move_clickfield {
    my ($fieldID) = shift;    # ID of button to be covered

    # ignore re-entering the active field
    # (this happens when withdrawing the clickfield)

    # Color change and popup required when returning from the bottom row,
    # so no return to caller in this case
    return
      if (     $fieldID == ( 'Cell'->activefield() || 0 )
           and $clickfield->state eq 'normal' );

    'Cell'->activefield($fieldID);
    $clickfield->withdraw;    # make clickfield invisible

    # mark the tiny square of the current digit by a different color
    foreach my $tiny ( @tiny_fields[1 .. 9] ) {
        $tiny->configure( -background       => 'black',
                          -activebackground => 'black' );
    }
    if ( my $digit = ${ $fieldID->cget('-textvariable') } ) {
        $tiny_fields[$digit]->configure( -background       => 'red',
                                         -activebackground => 'orange' );
    }
    $clickfield->configure( -popover => $fieldID );
    $clickfield->Popup();     # make clickfield visible
    return;
}

# delete resp. replace old digit of the active sudoku field
# callback of the tiny squares
#
sub _change_my_digit {
    my $digit_num = shift;                   # digit of the clicked tiny square
    my $actfield  = 'Cell'->activefield();
    my $olddigit = ${ $actfield->cget('-textvariable') };
    if ( $olddigit eq $digit_num ) {$digit_num = undef}
    _change_digit( $actfield, $digit_num );
    return;
}

# ====================================================================

# show problem cells in red on the board.
#
sub mark_problem_cells {
    my $err_ref = shift;
    my ( $errtxt, $errcells_ref ) = @$err_ref;
    $status_lb->configure( -text => $errtxt, -fg => 'red' );
    foreach my $errcell (@$errcells_ref) {
        my $fieldID = $errcell->property('Button');
        if ( $errcell->property('Value') ) {
            $fieldID->configure( -fg => 'red' );
        } else {
            $fieldID->configure( -bg => 'red' );
        }
        $errcell->is_errcell(1);
    }
    return;
}

# reset the default colors of the problem cells
# on the 1st digit change after the error display
#
sub _reset_colors {
    my @errcells = grep {$_->is_errcell} @cells;
    return unless @errcells;