Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
#!/usr/bin/perl use warnings; use strict; use Gtk2 -init; use Gnome2::Canvas; use Glib qw(TRUE FALSE); # load a background image if desired my $arg1 = shift || ''; if( ! length $arg1){ warn "No image loaded\n"} my $size = 1; my $color = '#000000'; my $resize_flag = 0; # mouse off if you load an image, then expand the mainwindow # to where borders are created around canvas, # but detecting a resize corrects it my $draw_flag = 0; my %lines; # way to store multiple continuous lines my $count = 0; my $window = Gtk2::Window->new; $window->signal_connect( destroy => sub { exit } ); $window->set_size_request( 500, 500 ); my $vbox = Gtk2::VBox->new; $vbox->set_border_width(4); $vbox->show; my $hbox = Gtk2::HBox->new(FALSE, 4); $vbox->pack_start($hbox, FALSE, FALSE, 0); $hbox->show; my $hbox1 = Gtk2::HBox->new(FALSE, 4); $vbox->pack_start($hbox1, FALSE, FALSE, 0); $hbox1->show; $window->add($vbox); my $scroller = Gtk2::ScrolledWindow->new; my $canvas = Gnome2::Canvas->new(); my $white = Gtk2::Gdk::Color->new (0xFFFF,0xFFFF,0xFFFF); $canvas->modify_bg('normal',$white); $scroller->add( $canvas ); $vbox->pack_start($scroller, 1, 1, 0); my $root = $canvas->root; #add an image if(length $arg1){ my $im = Gtk2::Gdk::Pixbuf->new_from_file( $arg1 ); my $image = Gnome2::Canvas::Item->new ($root, 'Gnome2::Canvas::Pixbuf', pixbuf => $im, x => 0.0, y => 0.0, width => $im->get_width, height => $im->get_height, anchor => 'nw', ); $canvas->set_scroll_region( 0, 0, $im->get_width,$im->get_height); }else{ $canvas->set_scroll_region( 0, 0, 600, 600); } # drawing detection $canvas->signal_connect (event => \&event_handler); #to detect resizing $window->signal_connect (event_after => \&event_after); # Zoom my $z = Gtk2::Label->new(" Zoom:"); $hbox->pack_start($z, FALSE, FALSE, 0); $z->show; my $adj = Gtk2::Adjustment->new(1, 0.05, 100, 0.05, 0.5, 0.5); my $sb = Gtk2::SpinButton->new($adj, 0, 2); $adj->signal_connect("value-changed", \&zoom_changed, $canvas); $sb->set_size_request(60, -1); $hbox->pack_start($sb, FALSE, FALSE, 10); $sb->show; my $button1 = Gtk2::Button->new('Screenshot'); $hbox->pack_start( $button1, FALSE, FALSE, 0 ); $button1->signal_connect( clicked => \&screenshot ); # brush size my $bs = Gtk2::Label->new("Brush Size:"); $hbox1->pack_start($bs, FALSE, FALSE, 0); $bs->show; my $badj = Gtk2::Adjustment->new(1, 0.05, 100, 0.05, 0.5, 0.5); my $bsb = Gtk2::SpinButton->new($badj, 0, 2); $badj->signal_connect("value-changed", \&size_changed); $bsb->set_size_request(60, -1); $hbox1->pack_start($bsb, FALSE, FALSE, 10); $bsb->show; my $button2 = Gtk2::Button->new('Color'); $hbox1->pack_start( $button2, FALSE, FALSE, 5 ); $button2->signal_connect( clicked => \&get_color ); my $button3 = Gtk2::Button->new('Clear'); $hbox1->pack_start( $button3, FALSE, FALSE, 5 ); $button3->signal_connect( clicked => \&clear ); my $label_w_markup = Gtk2::Label->new(); $label_w_markup->set_markup( "<span foreground=\"black\" size=\"15000\"><i> Button1 Drag to draw </ +i></span>"); $hbox->pack_start($label_w_markup,FALSE,FALSE,4); $window->show_all(); Gtk2->main; ############################## sub event_handler{ my ( $widget, $event ) = @_; #print $widget ,' ',$event->type,"\n"; my $scale = $adj->get_value; # print "scale->$scale\n"; if ( $event->type eq "button-press" ) { $draw_flag = 1; #start a new line curve $count++; my ($x,$y) = ($event->x,$event->y); #print "$x $y\n"; $lines{$count}{'points'} = [$x/$scale,$y/$scale,$x/$scale,$y/$ +scale]; #need at least 2 points $lines{$count}{'line'} = Gnome2::Canvas::Item->new ($root, 'Gnome2::Canvas::Line', points => $lines{$count}{'points'}, fill_color => $color, width_units => $size, cap_style => 'projecting', join_style => 'miter', ); } if ( $event->type eq "button-release" ) { $draw_flag = 0; } if ( $event->type eq "focus-change" ) { return 0; } if ( $event->type eq "expose" ) { return 0; } if($draw_flag){ #left with motion-notify if ( $event->type eq "motion-notify"){ my ($x,$y) = ($event->x,$event->y); # print "$x $y\n"; push @{$lines{$count}{'points'}},$x/$scale,$y/$scale; $lines{$count}{'line'}->set(points=>$lines{$count}{'points'}); } } return 0; } sub zoom_changed { my ($adj, $canvas) = @_; $canvas->set_pixels_per_unit($adj->get_value); } sub screenshot{ #we are going to save the visible canvas my ($width, $height) = $canvas->window->get_size; # create blank pixbuf to hold the image my $gdkpixbuf = Gtk2::Gdk::Pixbuf->new ('rgb', 0, 8, $width, $height); $gdkpixbuf->get_from_drawable ($canvas->window, undef, 0, 0, 0, 0, $width, $height); #only jpeg and png is supported !!!! it's 'jpeg', not 'jpg' $gdkpixbuf->save ("$0.jpg", 'jpeg', quality => 100); return FALSE; } ##################################################################### sub event_after { my ($mw, $event) = @_; # print $event->type,"\n"; if( ($event->type eq 'configure') or ($event->type eq 'expose' ) ){ $resize_flag = 1 }else{ $resize_flag = 0 } return FALSE if $resize_flag; my ($x, $y) = $mw->get_size; # print "$x $y\n"; $canvas->set_scroll_region( 0, 0, $x,$y); return FALSE; } sub get_color{ my $dialog = Gtk2::ColorSelectionDialog->new ('pick a color'); my $c = Gtk2::Gdk::Color->new (0x0000,0x0000,0x0000); $dialog->colorsel->set_current_color($c); if ('ok' eq $dialog->run) { $color = $dialog->colorsel->get_current_color->to_string; } $dialog->destroy; } sub size_changed{ my ($adj) = @_; # print $adj->get_value,"\n"; $size = $adj->get_value; } sub clear{ foreach my $key(keys %lines){ $lines{$key}{'line'}->destroy; } $count = 0; } __END__

In reply to Gnome2::Canvas Scribble with Image by zentara

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others chanting in the Monastery: (5)
    As of 2020-10-30 01:22 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      My favourite web site is:












      Results (276 votes). Check out past polls.

      Notices?