require Tk::Canvas; require Tk::Font; use strict; use warnings; sub Tk::Canvas::postscript_overstrike{ my $self = shift; my $start = time(); my @items = $self->find('all'); for my $item (@items){ next unless ($self->type($item) eq 'text'); my $font = $self->itemcget($item,'-font'); next unless($font->actual('-overstrike')); my @bb = $self->bbox($item); my $color = $self->itemcget($item, '-fill'); my $line = $self->createLine( $bb[0], ($bb[3] + $bb[1]) / 2, $bb[2], ($bb[3] + $bb[1]) / 2, -fill => $color, -tags => ['overstrike'], ); } my $ps = $self->postscript(@_); $self->delete('overstrike'); return $ps; } 1;